На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
  
> Почему в слоты добавляется повторяющиеся элементы?
    Делаю поиск предметов, у меня несколько массивов для хранения элементов
    1. Item1 – здесь содержится список всех элементов.
    2. slot1 – создается ячейки где будут хранится стартовые элементы (подсказки какие элементы требуется найти). При нахождении одного элемента он будет удален из слота и заменен другим случайным элементом который на холсте.
    3. tmpItem – временный массив, включает в себя только те элементы которые размещены на холсте, нужно для того чтобы когда закончатся все элементы, вывести сообщение о прохождении уровня. Также tmpItem нужен для эффективного получения случайного элемента. В него включены только оставшиеся предметы, остальные выбыли. Это гарантирует выбор случайного элемента без повторов и замена его в слотах на место выбывшего.
    Программа у меня работает, можно ориентироваться по списку слотов который находится внизу и убирать элементы. Здесь в любом случае пользователь придет к победе.

    Вначале генерируются предметы случайным образом без повторов, но когда начинаешь щелкать на предметах на холсте мышкой, чтобы убрать их. Ново-созданные предметы в слотах начинают повторяться. Пример на картинке в прикрепленном файле.

    Прикреплённый файлПрикреплённый файлScreenshot1.jpg (53,77 Кбайт, скачиваний: 6)
    Потом следующее, если на холсте остается меньше 6 предметов, то в этом случае слоты должны освобождаться и быть пустыми, а вместо этого предметы никуда не деваются они также по прежнему заполнены в слотах. Также после завершения игры мы получаем сообщение о победе и слоты опять заполнены.
    Прикреплённый файлПрикреплённый файлScreenshot2.jpg (46,15 Кбайт, скачиваний: 8)
    Как исправить проблему повторов и наполненности слотов под конец игры, вот мой код?
    ExpandedWrap disabled
      unit Unit1;
       
      interface
       
      uses
        Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
        Dialogs, StdCtrls, ExtCtrls, AppEvnts;
      type
        TForm1 = class(TForm)
          Button1: TButton;
          Timer1: TTimer;
          Label1: TLabel;
          Label2: TLabel;
          ApplicationEvents1: TApplicationEvents;
          Label3: TLabel;
          Memo1: TMemo;
          Button2: TButton;
          Label4: TLabel;
          Button3: TButton;
          Memo2: TMemo;
          Memo3: TMemo;
          procedure Timer1Timer(Sender: TObject);
          procedure ApplicationEvents1Message(var Msg: tagMSG;
            var Handled: Boolean);
          procedure FormPaint(Sender: TObject);
          procedure Button1Click(Sender: TObject);
          procedure Button3Click(Sender: TObject);
          procedure FormShow(Sender: TObject);
          procedure FormCreate(Sender: TObject);
        private
          { Private declarations }
        public
          { Public declarations }
        end;
        TRect = class
        private
            x0, y0: Integer;
            width, height: Integer;
            str:String;
            color : TColor;
            dragok : Boolean;
            Map_X, Map_Y: Integer;
            id1:Integer;
        public
          constructor Create(_x0, _y0, _MapX, _MapY, w1, h1,_id1: Integer; _Color:TColor; _str:String; _dragok:Boolean);
          Procedure Draw(Cs:TCanvas;x,y,id2,MapX,MapY:Integer); //Прорисовка
        end;
        TSlot = class
        private
          x0,y0:Integer;
          width, height:Integer;
        public
       // ; _slot:TRect
          constructor Create(_x0, _y0, _width, _height:Integer);
          procedure DrawSlot(Cs:TCanvas;x,y,MapX,MapY:Integer); //Прорисовка
          procedure DrawItem(Cs:TCanvas;rect:TRect); //Прорисовка
        end;
       
      var
        Form1: TForm;
        rightb, leftb, upb, downb : Boolean;
        OldX, OldY : integer;
        //dragok : Boolean;
        dragok:Integer;
        StartX:Integer;
        StartY:Integer;
        H1, W1,jj : Integer;
        rect2: Array [0..19] Of TRect;
        rect : Array [0..19] Of TRect;
        slt: Array[0..5] of TSlot;
        //12:45
        //x , y
        Position2: Array[0..19,1..2] of Integer;
        Item1: Array[0..19] of String = ('Thread','Goblet','Stick','Doorknob','Loupe','Statuette','Ring',
        'Crown','Vase','Gripsack','Book','Glove','Salver','Brush','Handbell','Cigarcase','Lantern','Card','Candy',
        'Whisk');
        //slot1:Array[0..5] of String = ('Goblet','Vase','Thread','Whisk','Stick','Handbell');
        slot1:Array of String;
        ItemColor: Array[0..19] of TColor = (clMaroon,clGreen,clOlive,clNavy,clPurple,clTeal,clGray,
        clSilver,clRed,clLime,clYellow,clBlue,clFuchsia,clAqua,
        //ЗАКОНЧИЛИСЬ ЦВЕТА ПРИШЛОСЬ ИСПОЛЬЗОВАТЬ СИСТЕМНЫЕ
        clInactiveCaption,clActiveCaption,clBackground,
        clInactiveCaptionText,clBtnShadow,clBtnFace);
       
        var
        tmpItem: array of String;
       
      implementation
       
      {$R *.dfm}
      // _slot:TRect
      constructor TSlot.Create(_x0, _y0, _width, _height:Integer);
      begin
        inherited Create;
        x0 := _x0;
        y0 := _y0;
        width:= _width;
        height:= _height;
       // slot:=_slot;
      end;
       
       
      procedure SaveToFile(file1:string;str:string);
      var
       f:TextFile;
       FileDir:String;
      begin
       FileDir:='c:\docum\'+file1;
      AssignFile(f,FileDir);
      if not FileExists(FileDir) then
       begin
        Rewrite(f);
        CloseFile(f);
       end;
      Append(f);
      Writeln(f,str);
      Flush(f);
      CloseFile(f);
      end;
      //Создание ячеек для слотов
      procedure TSlot.DrawSlot(Cs:TCanvas;x,y,MapX,MapY:Integer);
      begin
         Form1.Canvas.Brush.Color:=clGray;
         Cs.Rectangle(x0+MapX,y0+MapY,x0+width+MapX,y0+height+MapY);
      end;
      //Добавляем в слоты предметы
      procedure TSlot.DrawItem(Cs:TCanvas;rect:TRect);
      var newX,newY:Integer;
      begin
        newX := x0+5;
        newY := y0+5;
        rect.Draw(Form1.Canvas,newX,newY,rect.id1,0,0);
       
        
      end;
       
      constructor TRect.Create(_x0,_y0,_MapX,_MapY,w1,h1,_id1: Integer; _Color: TColor; _str:String; _dragok:Boolean);
      begin
        inherited Create;
        x0 := _x0;
        y0 := _y0;
        str := _str;
        width := w1;
        height := h1;
        color := _Color;
        dragok := _dragok;
        Map_X := _MapX;
        Map_Y := _MapY;
        id1:=_id1;
      end;
       
      //Создаем на холст предметы и пронумеруем их.
      procedure TRect.Draw(Cs: TCanvas; x, y, id2, MapX, MapY: Integer);
      begin
        //x0 := x;
        //y0 := y;
        Map_X := MapX;
        Map_Y := MapY;
        Form1.Canvas.Brush.Color:=color;
        Cs.Rectangle(x+Map_X,y+Map_Y,x+width+Map_X,y+height+Map_Y);
          
       // with Form1.Canvas do
       // begin
         Cs.Font.Name:= 'Numeration';
         Cs.Font.Size:= 18;
         Cs.Font.Style:= [fsBold,fsItalic];
         Cs.Font.Color:= clBlack;
         //clWindowText
         Cs.TextOut(x0, y0, IntToStr(id1));
         Cs.Font.Color:= clBlack;
         Cs.TextOut(x0, y0, IntToStr(id1));
        
       
        //end;
        
      end;
      //Таймер для прорисовки предметов на холсте
      procedure TForm1.Timer1Timer(Sender: TObject);
      var i,j,k,aa:Integer;
      begin
        OldX := 0;
        OldY := 0;
        Form1.Canvas.Brush.Color:=clWhite;
        Form1.Canvas.FillRect(Form1.ClientRect);
         Memo1.Lines.Clear;
         //Рисуем на холсте предметы, выбираем их из массива и только те у которых
         //значение не равно empty.
        for i := 0 to 19 do
        begin
         if Item1[i] <> 'empty' then
         begin
          rect[i].x0:=rect[i].x0;
          rect[i].y0:=rect[i].y0;
          rect[i].Draw(Form1.Canvas,Position2[i,1],Position2[i,2],i,0,0);
          
         end;
          
        end;
        //Делаем проверку массива tmpItem, чтобы определить
        //остались предметы на холссте. Выводим сообщение, что предметы найдены.
       
        if High(tmpItem)=0 then
        begin
          Timer1.Enabled:=false;
          ShowMessage('Вы нашли все предметы!');
        end;
          //  tmpItem[aa]
        Memo1.Clear;
      for aa:=low(tmpItem) to high(tmpItem) do Memo1.Lines.Add(IntToStr(High(tmpItem)));
       Memo2.Clear;
      for j:=0 to 5 do
      begin
       
       
       slt[j]:=TSlot.Create(10+j*60,370,50,50);
       slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
        //Сравниваем элементы
        for k:=0 to 19 do
        begin
          //slot1 - где в слоты добавляются предметы
          //rect[k].str - все элементы массива которые находятся на хостле
          //Происходит сравнение двух массивов и если находятся совпадения
          //то эти предметы добавляются в слот
         if rect[k].str = slot1[j] then
         begin
           Memo2.Lines.Add(IntToStr(k));
           rect2[j] := TRect.Create(10+j*60,370,0,0,40,40,k,ItemColor[k],Item1[j],false);
           slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
           slt[j].DrawItem(Form1.Canvas,rect2[j]);
         end;
        // ShowMessage(rect[k].str);
        end;
      end;
       
       
      end;
       
      procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
        var Handled: Boolean);
        var
        
         P : TPoint;
         i,ii,b,t1: Integer;
      begin
         if Msg.message = WM_LBUTTONDOWN then
         begin
         jj:=0;
        
         P:=Form1.ScreenToClient(Mouse.CursorPos);
         for i := 0 to 19 do
           begin
             if (rect[i].x0 < P.X) and
             (rect[i].x0+rect[i].width > P.X)
             and (rect[i].y0 < P.Y) and
             (rect[i].y0+rect[i].height > P.Y)
              then
              begin
               t1:=1;
               //Создается временный массив куда заносятся оставшиеся элементы которые
               //еще не выбыли с холста.
               //Перед созданием tmpItem проверяется, чтобы значение Item1 не было пустым
               for b:=low(Item1) to high(Item1) do
               if Item1[b]<>'empty' then begin
                
                   setLength(tmpItem, t1);
                   tmpItem[t1-1]:=Item1[b];
                   inc(t1);
                  
              end;
              //При нажатии происходит сравнение всех предметов которые на холсте,
              //с теми что в слотах и если совпадение найдено, предмет удаляется, а
              //в массиве мы получаем пустое значение
              for ii:=0 to 5 do
                   begin
                    if rect[i].str = slot1[ii] then
                    begin
                        slot1[ii]:=tmpItem[Random(Length(tmpItem))];
                        Item1[i]:='empty';
                    end;
                   end;
       
            
           end;
        end;
            
              
          end;
          if Msg.message = WM_LBUTTONUP then
          begin
              for i := 1 to 10 do
              begin
                rect[i].dragok:=false;
              end;
          end;
       
          
       
      end;
       
      procedure TForm1.FormPaint(Sender: TObject);
      var i,j,k: Integer;
       
      begin
      //Стартовые позиции всех предметов
      Position2[0,1]:=280;
      Position2[1,1]:=420;
      Position2[2,1]:=11;
      Position2[3,1]:=85;
      Position2[4,1]:=255;
      Position2[5,1]:=180;
      Position2[6,1]:=350;
      Position2[7,1]:=120;
      Position2[8,1]:=240;
      Position2[9,1]:=170;
      Position2[10,1]:=350;
      Position2[11,1]:=120;
      Position2[12,1]:=170;
      Position2[13,1]:=50;
      Position2[14,1]:=20;
      Position2[15,1]:=300;
      Position2[16,1]:=180;
      Position2[17,1]:=80;
      Position2[18,1]:=230;
      Position2[19,1]:=50;
       
      Position2[0,2]:=110;
      Position2[1,2]:=44;
      Position2[2,2]:=274;
      Position2[3,2]:=300;
      Position2[4,2]:=200;
      Position2[5,2]:=200;
      Position2[6,2]:=100;
      Position2[7,2]:=150;
      Position2[8,2]:=270;
      Position2[9,2]:=300;
      Position2[10,2]:=20;
      Position2[11,2]:=210;
      Position2[12,2]:=50;
      Position2[13,2]:=100;
      Position2[14,2]:=30;
      Position2[15,2]:=270;
      Position2[16,2]:=120;
      Position2[17,2]:=40;
      Position2[18,2]:=50;
      Position2[19,2]:=170;
       
       
      //Отрисовываем все предметы на холсте
      for i := 0 to 19 do
      begin
       rect[i] := TRect.Create(Position2[i,1],Position2[i,2],0,0,40,40,i,ItemColor[i],Item1[i],false);
       rect[i].Draw(Form1.Canvas,Position2[i,1],Position2[i,2],i,0,0);
      end;
      Memo1.Clear;
      for j:=0 to 5 do
      begin
       
      slt[j]:=TSlot.Create(10+j*60,370,50,50);
      slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
        //Сравниваем значение массивов со слотами, если название предметов совпадает рисуем их.
        for k:=0 to 19 do
        begin
         if rect[k].str = slot1[j] then
         begin
          
           rect2[j] := TRect.Create(10+j*60,370,0,0,40,40,k,ItemColor[k],Item1[j],false);
           //Создаем слоты
           slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
           //Рисуем предметы
           slt[j].DrawItem(Form1.Canvas,rect2[j]);
         end;
       
        end;
      end;
       
       
       
      end;
       
      procedure TForm1.Button1Click(Sender: TObject);
      var
      i:Integer;
      begin
      for i:= 0 to 5 do
      begin
      //ShowMessage(slot1[i]);
      end;
      end;
       
      procedure TForm1.Button3Click(Sender: TObject);
      var aa:Integer;
      begin
      for aa:=0 to High(slot1) do
        begin
           slot1[aa]:=Item1[aa];
           Memo1.Lines.Add(slot1[aa])
        end;
      end;
       
      procedure TForm1.FormShow(Sender: TObject);
      var i,k1,j:Integer; s:String;
      begin
       
      //Создаем новый массив с шестью слотами
      setLength(slot1,6);
       
       
        //Перемещиваем предметы случайным образом и добавляем их в слоты
        for i := High(Item1) downto 0 do
        begin
          j := Random(i + 1);
          s := Item1[i];
          Item1[i] := Item1[j];
          Item1[j] := s;
        
        end;
       
        for k1:=0 to High(slot1) do
        begin
           slot1[k1]:=Item1[k1];
           Memo3.Lines.Add(Item1[k1])
        end;
       
      slot1[0]:='Goblet';
      slot1[1]:='Vase';
      slot1[2]:='Thread';
      slot1[3]:='Stick';
      slot1[4]:='Handbell';
      slot1[5]:='Whisk';
       
      Timer1.Enabled:=True;
      end;
       
      procedure TForm1.FormCreate(Sender: TObject);
      begin
      Randomize;
      end;
       
      end.
    Сообщение отредактировано: Katerina1993 -
      ExpandedWrap disabled
                 //Создается временный массив куда заносятся оставшиеся элементы которые
                 //еще не выбыли с холста.
                 //Перед созданием tmpItem проверяется, чтобы значение Item1 не было пустым
                 t1 := 0;
                 SetLength(tmpItem, Length(Item1)); // Достаточно задать размер массива сразу ...
                 for b:=low(Item1) to high(Item1) do
                 if Item1[b]<>'empty' then begin
         
        //           setLength(tmpItem, t1); // ... а не изменять размер массива в цикле
                     tmpItem[t1]:=b; // Зачем копировать строки, когда достаточно скопировать индексы
                     inc(t1); // Вместо Length(tmpItem) достаточно использовать t1
         
                end;
         
                for ii:=0 to 5 do begin
                  // Выбрали заранее случайный индекс
                  ti := ii + Random(t1 - ii);
                  tt := tmpItem[ti];
                  tmpItem[ti] := tmpItem[ii];
                  tmpItem[ii] := tt;
                  if rect[i].str = slot1[ii] then // Проверяем и меняем
                  begin
                      slot1[ii] := Item1[tt];
                      Item1[tt] := 'empty'; // только я не понял почему у вас тут Item1[i] было, а не выбранный элемент
                  end;
               end;
        Не понятно изначально tmpItem идет как строка.
        Поэтому ошибки будут здесь(потому, что встречается число вместо строки):
        ExpandedWrap disabled
          tmpItem[t1]:=b; // Зачем копировать строки, когда достаточно скопировать индексы


        и здесь
        ExpandedWrap disabled
          tt := tmpItem[ti];
          tmpItem[ti] := tmpItem[ii];
          tmpItem[ii] := tt;
        Сообщение отредактировано: Katerina1993 -
          Так измените тип массива на числовой.
          У меня смысл кода в том, что вам надо изменять на empty не Item1[i], а Item1[tmpItem[ii]]. Но если сохранять строки, тогда индексы в Item1 потеряются. Понадобится составлять массив ассоциаций tempIndex и массив строк tempItem. Можно обойтись без этого. Достаточно изменить массив tmpItem на числовой и сохранять в нем индексы из Item1.
          Сообщение отредактировано: macomics -
            Я изменила код теперь завершения игры не возможна, так как некоторые элементы отсутствуют, а при щелчке на предмете почему-то удаляются не тот предмет.
            ExpandedWrap disabled
              unit Unit1;
               
              interface
               
              uses
                Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
                Dialogs, StdCtrls, ExtCtrls, AppEvnts;
              type
                TForm1 = class(TForm)
                  Button1: TButton;
                  Timer1: TTimer;
                  Label1: TLabel;
                  Label2: TLabel;
                  ApplicationEvents1: TApplicationEvents;
                  Label3: TLabel;
                  Memo1: TMemo;
                  Button2: TButton;
                  Label4: TLabel;
                  Button3: TButton;
                  Memo2: TMemo;
                  Memo3: TMemo;
                  procedure Timer1Timer(Sender: TObject);
                  procedure ApplicationEvents1Message(var Msg: tagMSG;
                    var Handled: Boolean);
                  procedure FormPaint(Sender: TObject);
                  procedure Button1Click(Sender: TObject);
                  procedure Button3Click(Sender: TObject);
                  procedure FormShow(Sender: TObject);
                  procedure FormCreate(Sender: TObject);
                private
                  { Private declarations }
                public
                  { Public declarations }
                end;
                TRect = class
                private
                    x0, y0: Integer;
                    width, height: Integer;
                    str:String;
                    color : TColor;
                    dragok : Boolean;
                    Map_X, Map_Y: Integer;
                    id1:Integer;
                public
                  constructor Create(_x0, _y0, _MapX, _MapY, w1, h1,_id1: Integer; _Color:TColor; _str:String; _dragok:Boolean);
                  Procedure Draw(Cs:TCanvas;x,y,id2,MapX,MapY:Integer); //Прорисовка
                end;
                TSlot = class
                private
                  x0,y0:Integer;
                  width, height:Integer;
                public
               // ; _slot:TRect
                  constructor Create(_x0, _y0, _width, _height:Integer);
                  procedure DrawSlot(Cs:TCanvas;x,y,MapX,MapY:Integer); //Прорисовка
                  procedure DrawItem(Cs:TCanvas;rect:TRect); //Прорисовка
                end;
               
              var
                Form1: TForm;
                rightb, leftb, upb, downb : Boolean;
                OldX, OldY : integer;
                //dragok : Boolean;
                dragok:Integer;
                StartX:Integer;
                StartY:Integer;
                H1, W1,jj : Integer;
                rect2: Array [0..19] Of TRect;
                rect : Array [0..19] Of TRect;
                slt: Array[0..5] of TSlot;
                //12:45
                //x , y
                Position2: Array[0..19,1..2] of Integer;
                Item1: Array[0..19] of String = ('Thread','Goblet','Stick','Doorknob','Loupe','Statuette','Ring',
                'Crown','Vase','Gripsack','Book','Glove','Salver','Brush','Handbell','Cigarcase','Lantern','Card','Candy',
                'Whisk');
                //slot1:Array[0..5] of String = ('Goblet','Vase','Thread','Whisk','Stick','Handbell');
                slot1:Array of String;
                ItemColor: Array[0..19] of TColor = (clMaroon,clGreen,clOlive,clNavy,clPurple,clTeal,clGray,
                clSilver,clRed,clLime,clYellow,clBlue,clFuchsia,clAqua,
                //ЗАКОНЧИЛИСЬ ЦВЕТА ПРИШЛОСЬ ИСПОЛЬЗОВАТЬ СИСТЕМНЫЕ
                clInactiveCaption,clActiveCaption,clBackground,
                clInactiveCaptionText,clBtnShadow,clBtnFace);
               
                var
                tmpItem: array of Integer;
               
              implementation
               
              {$R *.dfm}
              // _slot:TRect
              constructor TSlot.Create(_x0, _y0, _width, _height:Integer);
              begin
                inherited Create;
                x0 := _x0;
                y0 := _y0;
                width:= _width;
                height:= _height;
               // slot:=_slot;
              end;
               
               
              //Создание ячеек для слотов
              procedure TSlot.DrawSlot(Cs:TCanvas;x,y,MapX,MapY:Integer);
              begin
                 Form1.Canvas.Brush.Color:=clGray;
                 Cs.Rectangle(x0+MapX,y0+MapY,x0+width+MapX,y0+height+MapY);
              end;
              //Добавляем в слоты предметы
              procedure TSlot.DrawItem(Cs:TCanvas;rect:TRect);
              var newX,newY:Integer;
              begin
                newX := x0+5;
                newY := y0+5;
                rect.Draw(Form1.Canvas,newX,newY,rect.id1,0,0);
               
                
              end;
               
              constructor TRect.Create(_x0,_y0,_MapX,_MapY,w1,h1,_id1: Integer; _Color: TColor; _str:String; _dragok:Boolean);
              begin
                inherited Create;
                x0 := _x0;
                y0 := _y0;
                str := _str;
                width := w1;
                height := h1;
                color := _Color;
                dragok := _dragok;
                Map_X := _MapX;
                Map_Y := _MapY;
                id1:=_id1;
              end;
               
              //Создаем на холст предметы и пронумеруем их.
              procedure TRect.Draw(Cs: TCanvas; x, y, id2, MapX, MapY: Integer);
              begin
                //x0 := x;
                //y0 := y;
                Map_X := MapX;
                Map_Y := MapY;
                Form1.Canvas.Brush.Color:=color;
                Cs.Rectangle(x+Map_X,y+Map_Y,x+width+Map_X,y+height+Map_Y);
                  
               // with Form1.Canvas do
               // begin
                 Cs.Font.Name:= 'Numeration';
                 Cs.Font.Size:= 18;
                 Cs.Font.Style:= [fsBold,fsItalic];
                 Cs.Font.Color:= clBlack;
                 //clWindowText
                 Cs.TextOut(x0, y0, IntToStr(id1));
                 Cs.Font.Color:= clBlack;
                 Cs.TextOut(x0, y0, IntToStr(id1));
                
               
                //end;
                
              end;
              //Таймер для прорисовки предметов на холсте
              procedure TForm1.Timer1Timer(Sender: TObject);
              var i,j,k,aa:Integer;
              begin
                OldX := 0;
                OldY := 0;
                Form1.Canvas.Brush.Color:=clWhite;
                Form1.Canvas.FillRect(Form1.ClientRect);
                 Memo1.Lines.Clear;
                 //Рисуем на холсте предметы, выбираем их из массива и только те у которых
                 //значение не равно empty.
                for i := 0 to 19 do
                begin
                 if Item1[i] <> 'empty' then
                 begin
                  rect[i].x0:=rect[i].x0;
                  rect[i].y0:=rect[i].y0;
                  rect[i].Draw(Form1.Canvas,Position2[i,1],Position2[i,2],i,0,0);
                  
                 end;
                  
                end;
                //Делаем проверку массива tmpItem, чтобы определить
                //остались предметы на холссте. Выводим сообщение, что предметы найдены.
               
                if High(tmpItem)=0 then
                begin
                  Timer1.Enabled:=false;
                  ShowMessage('Вы нашли все предметы!');
                end;
                  //  tmpItem[aa]
                Memo1.Clear;
              for aa:=low(tmpItem) to high(tmpItem) do Memo1.Lines.Add(IntToStr(High(tmpItem)));
               Memo2.Clear;
              for j:=0 to 5 do
              begin
               
               
               slt[j]:=TSlot.Create(10+j*60,370,50,50);
               slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
                //Сравниваем элементы
                for k:=0 to 19 do
                begin
                  //slot1 - где в слоты добавляются предметы
                  //rect[k].str - все элементы массива которые находятся на хостле
                  //Происходит сравнение двух массивов и если находятся совпадения
                  //то эти предметы добавляются в слот
                 if rect[k].str = slot1[j] then
                 begin
                   Memo2.Lines.Add(IntToStr(k));
                   rect2[j] := TRect.Create(10+j*60,370,0,0,40,40,k,ItemColor[k],Item1[j],false);
                   slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
                   slt[j].DrawItem(Form1.Canvas,rect2[j]);
                 end;
                // ShowMessage(rect[k].str);
                end;
              end;
               
               
              end;
               
              procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
                var Handled: Boolean);
                var
                
                 P : TPoint;
                 i,ii,b,t1,ti,tt: Integer;
              begin
                 if Msg.message = WM_LBUTTONDOWN then
                 begin
                 jj:=0;
                
                 P:=Form1.ScreenToClient(Mouse.CursorPos);
                 for i := 0 to 19 do
                   begin
                     if (rect[i].x0 < P.X) and
                     (rect[i].x0+rect[i].width > P.X)
                     and (rect[i].y0 < P.Y) and
                     (rect[i].y0+rect[i].height > P.Y)
                      then
                      begin
                       //t1:=1;
                       //Создается временный массив куда заносятся оставшиеся элементы которые
                       //еще не выбыли с холста.
                       //Перед созданием tmpItem проверяется, чтобы значение Item1 не было пустым
                       t1 := 0;
                       SetLength(tmpItem, Length(Item1));
                       // Достаточно задать размер массива сразу ...
               
                       for b:=low(Item1) to high(Item1) do
                       if Item1[b]<>'empty' then begin
                        
                           //setLength(tmpItem, t1);
                           //tmpItem[t1-1]:=Item1[b];
                           //inc(t1);
                           tmpItem[t1]:=b; // Зачем копировать строки, когда достаточно скопировать индексы
                           inc(t1); // Вместо Length(tmpItem) достаточно использовать t1
                          
                      end;
                      //При нажатии происходит сравнение всех предметов которые на холсте,
                      //с теми что в слотах и если совпадение найдено, предмет удаляется, а
                      //в массиве мы получаем пустое значение
                      for ii:=0 to 5 do
                           begin
                             ti := ii + Random(t1 - ii);
                             tt := tmpItem[ti];
                             tmpItem[ti] := tmpItem[ii];
                             tmpItem[ii] := tt;
                            if rect[i].str = slot1[ii] then
                            begin
                                slot1[ii] := Item1[tt];
                                //slot1[ii]:=tmpItem[Random(Length(tmpItem))];
                                Item1[tt]:='empty';
                            end;
                           end;
               
                    
                   end;
                end;
                    
                      
                  end;
                  if Msg.message = WM_LBUTTONUP then
                  begin
                      for i := 1 to 10 do
                      begin
                        rect[i].dragok:=false;
                      end;
                  end;
               
                  
               
              end;
               
              procedure TForm1.FormPaint(Sender: TObject);
              var i,j,k: Integer;
               
              begin
              //Стартовые позиции всех предметов
              Position2[0,1]:=280;
              Position2[1,1]:=420;
              Position2[2,1]:=11;
              Position2[3,1]:=85;
              Position2[4,1]:=255;
              Position2[5,1]:=180;
              Position2[6,1]:=350;
              Position2[7,1]:=120;
              Position2[8,1]:=240;
              Position2[9,1]:=170;
              Position2[10,1]:=350;
              Position2[11,1]:=120;
              Position2[12,1]:=170;
              Position2[13,1]:=50;
              Position2[14,1]:=20;
              Position2[15,1]:=300;
              Position2[16,1]:=180;
              Position2[17,1]:=80;
              Position2[18,1]:=230;
              Position2[19,1]:=50;
               
              Position2[0,2]:=110;
              Position2[1,2]:=44;
              Position2[2,2]:=274;
              Position2[3,2]:=300;
              Position2[4,2]:=200;
              Position2[5,2]:=200;
              Position2[6,2]:=100;
              Position2[7,2]:=150;
              Position2[8,2]:=270;
              Position2[9,2]:=300;
              Position2[10,2]:=20;
              Position2[11,2]:=210;
              Position2[12,2]:=50;
              Position2[13,2]:=100;
              Position2[14,2]:=30;
              Position2[15,2]:=270;
              Position2[16,2]:=120;
              Position2[17,2]:=40;
              Position2[18,2]:=50;
              Position2[19,2]:=170;
               
               
              //Отрисовываем все предметы на холсте
              for i := 0 to 19 do
              begin
               rect[i] := TRect.Create(Position2[i,1],Position2[i,2],0,0,40,40,i,ItemColor[i],Item1[i],false);
               rect[i].Draw(Form1.Canvas,Position2[i,1],Position2[i,2],i,0,0);
              end;
              Memo1.Clear;
              for j:=0 to 5 do
              begin
               
              slt[j]:=TSlot.Create(10+j*60,370,50,50);
              slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
                //Сравниваем значение массивов со слотами, если название предметов совпадает рисуем их.
                for k:=0 to 19 do
                begin
                 if rect[k].str = slot1[j] then
                 begin
                  
                   rect2[j] := TRect.Create(10+j*60,370,0,0,40,40,k,ItemColor[k],Item1[j],false);
                   //Создаем слоты
                   slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
                   //Рисуем предметы
                   slt[j].DrawItem(Form1.Canvas,rect2[j]);
                 end;
               
                end;
              end;
               
               
               
              end;
               
              procedure TForm1.Button1Click(Sender: TObject);
              var
              i:Integer;
              begin
              for i:= 0 to 5 do
              begin
              //ShowMessage(slot1[i]);
              end;
              end;
               
              procedure TForm1.Button3Click(Sender: TObject);
              var aa:Integer;
              begin
              for aa:=0 to High(slot1) do
                begin
                   slot1[aa]:=Item1[aa];
                   Memo1.Lines.Add(slot1[aa])
                end;
              end;
               
              procedure TForm1.FormShow(Sender: TObject);
              var i,k1,j:Integer; s:String;
              begin
               
              //Создаем новый массив с шестью слотами
              setLength(slot1,6);
               
               
                //Перемещиваем предметы случайным образом и добавляем их в слоты
                for i := High(Item1) downto 0 do
                begin
                  j := Random(i + 1);
                  s := Item1[i];
                  Item1[i] := Item1[j];
                  Item1[j] := s;
                
                end;
               
                for k1:=0 to High(slot1) do
                begin
                   slot1[k1]:=Item1[k1];
                   Memo3.Lines.Add(Item1[k1])
                end;
               
              slot1[0]:='Goblet';
              slot1[1]:='Vase';
              slot1[2]:='Thread';
              slot1[3]:='Stick';
              slot1[4]:='Handbell';
              slot1[5]:='Whisk';
              //
              Timer1.Enabled:=True;
              end;
               
              procedure TForm1.FormCreate(Sender: TObject);
              begin
              Randomize;
              end;
               
              end.
              Тогда будем разбираться с самого начала.
              1)
              ExpandedWrap disabled
                    Position2[0,1]:=280;
                    Position2[1,1]:=420;
                    Position2[2,1]:=11;
                    Position2[3,1]:=85;
                    Position2[4,1]:=255;
                    Position2[5,1]:=180;
                    Position2[6,1]:=350;
                    Position2[7,1]:=120;
                    Position2[8,1]:=240;
                    Position2[9,1]:=170;
                    Position2[10,1]:=350;
                    Position2[11,1]:=120;
                    Position2[12,1]:=170;
                    Position2[13,1]:=50;
                    Position2[14,1]:=20;
                    Position2[15,1]:=300;
                    Position2[16,1]:=180;
                    Position2[17,1]:=80;
                    Position2[18,1]:=230;
                    Position2[19,1]:=50;
                    
                    Position2[0,2]:=110;
                    Position2[1,2]:=44;
                    Position2[2,2]:=274;
                    Position2[3,2]:=300;
                    Position2[4,2]:=200;
                    Position2[5,2]:=200;
                    Position2[6,2]:=100;
                    Position2[7,2]:=150;
                    Position2[8,2]:=270;
                    Position2[9,2]:=300;
                    Position2[10,2]:=20;
                    Position2[11,2]:=210;
                    Position2[12,2]:=50;
                    Position2[13,2]:=100;
                    Position2[14,2]:=30;
                    Position2[15,2]:=270;
                    Position2[16,2]:=120;
                    Position2[17,2]:=40;
                    Position2[18,2]:=50;
                    Position2[19,2]:=170;
              Зачем заполнять массив констант при перерисовке. Достаточно заполнить его в объявлении переменной.
              ExpandedWrap disabled
                const Position2: Array[0..19,1..2] of Integer = ((280, 110), (420, 44), (11, 274), (85, 300), (255, 200), (180, 200), (350, 100), (120, 150), (240, 270), (170, 300), (350, 20), (120, 210), (170, 50), (50, 100), (20, 30), (300, 270), (180, 120), (80, 40), (230, 50), (50, 170));


              2)При перерисовке вы не просто рисуете структуру, а еще и реинициализируете ее
              ExpandedWrap disabled
                    //Отрисовываем все предметы на холсте
                    for i := 0 to 19 do
                    begin
                     rect[i] := TRect.Create(Position2[i,1],Position2[i,2],0,0,40,40,i,ItemColor[i],Item1[i],false);
                     rect[i].Draw(Form1.Canvas,Position2[i,1],Position2[i,2],i,0,0);
                    end;
                    Memo1.Clear;
                    for j:=0 to 5 do
                    begin
                    
                    slt[j]:=TSlot.Create(10+j*60,370,50,50);
                    slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
                      //Сравниваем значение массивов со слотами, если название предметов совпадает рисуем их.
                      for k:=0 to 19 do
                      begin
                       if rect[k].str = slot1[j] then
                       begin
                    
                         rect2[j] := TRect.Create(10+j*60,370,0,0,40,40,k,ItemColor[k],Item1[j],false);
                         //Создаем слоты
                         slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
                         //Рисуем предметы
                         slt[j].DrawItem(Form1.Canvas,rect2[j]);
                       end;
                    
                      end;
                    end;
              Строки TRect.Create и TSlot.Create. Лучше вынести из обработчика перерисовки. Он вызывается часто, и каждый раз будет создаваться различная структура (не говоря уже про неявные утечки памяти). Обычно вы должны полностью создать все элементы структуры в TForm1.FormCreate и в обработчике TForm1.FormPaint выполнять только перерисовку уже созданных элементов.

              3) Вот этот код так же расположен не в том месте.
              ExpandedWrap disabled
                    procedure TForm1.FormShow(Sender: TObject);
                    var i,k1,j:Integer; s:String;
                    begin
                    
                    //Создаем новый массив с шестью слотами
                    setLength(slot1,6);
                    
                    
                      //Перемещиваем предметы случайным образом и добавляем их в слоты
                      for i := High(Item1) downto 0 do
                      begin
                        j := Random(i + 1);
                        s := Item1[i];
                        Item1[i] := Item1[j];
                        Item1[j] := s;
                    
                      end;
                    
                      for k1:=0 to High(slot1) do
                      begin
                         slot1[k1]:=Item1[k1];
                         Memo3.Lines.Add(Item1[k1])
                      end;
                    
                    slot1[0]:='Goblet';
                    slot1[1]:='Vase';
                    slot1[2]:='Thread';
                    slot1[3]:='Stick';
                    slot1[4]:='Handbell';
                    slot1[5]:='Whisk';
                    //
                    Timer1.Enabled:=True;
                   end;
              TForm1.FormShow вызывается каждый раз при отображении формы на экране. Попробуйте создать отдельную форму и расположить на ней кнопку скрывающую и отображающую эту форму. Тогда этот код будет вызываться еще и еще раз. Это тоже не по плану. Он должен быть в TForm1.FormCreate.

              4) В периодически вызываемом событии вы вызываете не только Create и изменяете структуру, но еще и перерисовываете окно напрямую.
              ExpandedWrap disabled
                    //Таймер для прорисовки предметов на холсте
                    procedure TForm1.Timer1Timer(Sender: TObject);
                    var i,j,k,aa:Integer;
                    begin
                      OldX := 0;
                      OldY := 0;
                      Form1.Canvas.Brush.Color:=clWhite;
                      Form1.Canvas.FillRect(Form1.ClientRect);
                       Memo1.Lines.Clear;
                       //Рисуем на холсте предметы, выбираем их из массива и только те у которых
                       //значение не равно empty.
                      for i := 0 to 19 do
                      begin
                       if Item1[i] <> 'empty' then
                       begin
                        rect[i].x0:=rect[i].x0;
                        rect[i].y0:=rect[i].y0;
                        rect[i].Draw(Form1.Canvas,Position2[i,1],Position2[i,2],i,0,0);
                    
                       end;
                    
                      end;
                      //Делаем проверку массива tmpItem, чтобы определить
                      //остались предметы на холссте. Выводим сообщение, что предметы найдены.
                    
                      if High(tmpItem)=0 then
                      begin
                        Timer1.Enabled:=false;
                        ShowMessage('Вы нашли все предметы!');
                      end;
                        //  tmpItem[aa]
                      Memo1.Clear;
                    for aa:=low(tmpItem) to high(tmpItem) do Memo1.Lines.Add(IntToStr(High(tmpItem)));
                     Memo2.Clear;
                    for j:=0 to 5 do
                    begin
                    
                    
                     slt[j]:=TSlot.Create(10+j*60,370,50,50);
                     slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
                      //Сравниваем элементы
                      for k:=0 to 19 do
                      begin
                        //slot1 - где в слоты добавляются предметы
                        //rect[k].str - все элементы массива которые находятся на хостле
                        //Происходит сравнение двух массивов и если находятся совпадения
                        //то эти предметы добавляются в слот
                       if rect[k].str = slot1[j] then
                       begin
                         Memo2.Lines.Add(IntToStr(k));
                         rect2[j] := TRect.Create(10+j*60,370,0,0,40,40,k,ItemColor[k],Item1[j],false);
                         slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
                         slt[j].DrawItem(Form1.Canvas,rect2[j]);
                       end;
                      // ShowMessage(rect[k].str);
                      end;
                    end;
                    
                    
                    end;
              Опять же. Для рисования на окне существует обработчик TForm1.FormPaint, который перед вызовом подготавливается к выводу на форму графики, а после возврата применяет весь сделанный вывод одним блоком, что должно уменьшать мерцание. Рисовать на форме в любом месте кода не самая лучшая затея. По таймеру, если необходимо перерисовывать окно, достаточно вызвать Form1.Repaint(), а не вызывать функции рисования. Но кроме функций рисования вы еще и изменяете структуру, создавая новые элементы через TRect.Create и TSlot.Create

              Итог. Ничего удивительного, что вы получаете что-то непонятное. Если давать совет по работе программы. Лучше полностью перепишите. Сформулируйте структуру TItem, которая будет связывать название и координаты, номер слота и цвет. Однократно инициализируйте массив этих структур в TForm1.FormCreate, а отрисовывайте все необходимое в TForm1.FormPaint. При необходимости перерисовки по таймеру, в обработчике таймера помещается одна единственная команда TForm1.Repaint, перед которой в уже заполненные элементы TItem вносятся необходимые изменения. При этом не нужно ловить события WM_LBUTTONDOWN и другие через фильтр, а достаточно будет обработчиков TForm1.FormKeyDown или TForm1.FormClick и им подобных.
                Переписывать я не собираюсь программа почти готова, нужно просто придумать как подправить ошибки, слишком хлопотно заново все начинать. Сначало надо запустить эту программу потом уже думать как переписать более оптимально. Для того чтобы был стимул, дальше двигаться, а если моя первая программа не доработана, то и стимула, что-то делать нет.
                  Все вышеописанное это ошибки. Их надо исправлять. Но они настолько большие, что проще все переписать.
                  Например: Используя TRect.Create(...) вы изменяете все свойства элемента, а в исходном конструкторе inherited Create; может еще и память динамически выделяться. Потом вы не освобождая созданный экземпляр просто перезаписываете его новым, что приводит к утечке памяти. Это уже фундаментальная ошибка.
                    Цитата Katerina1993 @
                    Переписывать я не собираюсь программа почти готова, нужно просто придумать как подправить ошибки, слишком хлопотно заново все начинать. Сначало надо запустить эту программу потом уже думать как переписать более оптимально. Для того чтобы был стимул, дальше двигаться, а если моя первая программа не доработана, то и стимула, что-то делать нет.

                    ;) Это Ваше "заднее" слово?) :crazy: :blush: :-? "Заднее слово"

                    -> "а если моя первая программа не доработана, то и стимула, что-то делать нет." ... Сразу хотите, "Летать" :rose:
                    А как же ... шаг за шагом, легкие пробежки, более быстрый бег, скоростные забеги, ... чемпионат мира.

                    -> ", нужно просто придумать как подправить ошибки," :victory:

                    -> "слишком хлопотно заново все начинать. " -> "Это же не значит всё выбросить и с сызнова написать",
                    Вы используете, что уже наработали ( написали ) + то, что Вам подсказали на форуме, пробуете всё это соединить во что-то единое, верно структурированное и рабочее,
                    в следствии "верных действии", всё "правильно" заработает.

                    Можно и по другому посмотреть на это, просто взять и внести необходимые изменения, постепенно, в помощи Вам не отказывают?
                    "macomics" очень подробно и доходчиво объяснял Вам. :thanks: :scratch: :popcorn: :good:
                    Выбор за Вами конечно) :whistle:

                    Написав данное сообщение, я не хотел Вас обидеть, или как уязвить. Лишь подбодрить ... :blush:
                    Сообщение отредактировано: RusSun -
                    1 пользователей читают эту тему (1 гостей и 0 скрытых пользователей)
                    0 пользователей:


                    Рейтинг@Mail.ru
                    [ Script execution time: 0,0624 ]   [ 17 queries used ]   [ Generated: 24.06.22, 22:11 GMT ]