Почему в слоты добавляется повторяющиеся элементы?

[Katerina1993]

Делаю поиск предметов, у меня несколько массивов для хранения элементов

1. Item1 – здесь содержится список всех элементов.
2. slot1 – создается ячейки где будут хранится стартовые элементы (подсказки какие элементы требуется найти). При нахождении одного элемента он будет удален из слота и заменен другим случайным элементом который на холсте.
3. tmpItem – временный массив, включает в себя только те элементы которые размещены на холсте, нужно для того чтобы когда закончатся все элементы, вывести сообщение о прохождении уровня. Также tmpItem нужен для эффективного получения случайного элемента. В него включены только оставшиеся предметы, остальные выбыли. Это гарантирует выбор случайного элемента без повторов и замена его в слотах на место выбывшего.

Программа у меня работает, можно ориентироваться по списку слотов который находится внизу и убирать элементы. Здесь в любом случае пользователь придет к победе.

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

Прикреплённый файлScreenshot1.jpg (53,77 Кбайт, скачиваний: 12)
Потом следующее, если на холсте остается меньше 6 предметов, то в этом случае слоты должны освобождаться и быть пустыми, а вместо этого предметы никуда не деваются они также по прежнему заполнены в слотах. Также после завершения игры мы получаем сообщение о победе и слоты опять заполнены.
Прикреплённый файлScreenshot2.jpg (46,15 Кбайт, скачиваний: 17)
Как исправить проблему повторов и наполненности слотов под конец игры, вот мой код?

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 - 21.06.22, 18:06

[macomics]

         //Создается временный массив куда заносятся оставшиеся элементы которые
         //еще не выбыли с холста.
         //Перед созданием 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;

[Katerina1993]

Не понятно изначально tmpItem идет как строка.
Поэтому ошибки будут здесь(потому, что встречается число вместо строки):

tmpItem[t1]:=b; // Зачем копировать строки, когда достаточно скопировать индексы

и здесь

tt := tmpItem[ti];
tmpItem[ti] := tmpItem[ii];
tmpItem[ii] := tt;

Сообщение отредактировано: Katerina1993 - 21.06.22, 21:59

[macomics]

Так измените тип массива на числовой.
У меня смысл кода в том, что вам надо изменять на empty не Item1[i], а Item1[tmpItem[ii]]. Но если сохранять строки, тогда индексы в Item1 потеряются. Понадобится составлять массив ассоциаций tempIndex и массив строк tempItem. Можно обойтись без этого. Достаточно изменить массив tmpItem на числовой и сохранять в нем индексы из Item1.

Сообщение отредактировано: macomics - 21.06.22, 23:05

[Katerina1993]

Я изменила код теперь завершения игры не возможна, так как некоторые элементы отсутствуют, а при щелчке на предмете почему-то удаляются не тот предмет.

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.

[macomics]

Тогда будем разбираться с самого начала.
1)

    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;

Зачем заполнять массив констант при перерисовке. Достаточно заполнить его в объявлении переменной.

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)При перерисовке вы не просто рисуете структуру, а еще и реинициализируете ее

    //Отрисовываем все предметы на холсте
    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) Вот этот код так же расположен не в том месте.

    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 и изменяете структуру, но еще и перерисовываете окно напрямую.

    //Таймер для прорисовки предметов на холсте
    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 и им подобных.

[Katerina1993]

Переписывать я не собираюсь программа почти готова, нужно просто придумать как подправить ошибки, слишком хлопотно заново все начинать. Сначало надо запустить эту программу потом уже думать как переписать более оптимально. Для того чтобы был стимул, дальше двигаться, а если моя первая программа не доработана, то и стимула, что-то делать нет.

[macomics]

Все вышеописанное это ошибки. Их надо исправлять. Но они настолько большие, что проще все переписать.
Например: Используя TRect.Create(...) вы изменяете все свойства элемента, а в исходном конструкторе inherited Create; может еще и память динамически выделяться. Потом вы не освобождая созданный экземпляр просто перезаписываете его новым, что приводит к утечке памяти. Это уже фундаментальная ошибка.

[RusSun]

Цитата Katerina1993 @ 22.06.22, 12:56

Переписывать я не собираюсь программа почти готова, нужно просто придумать как подправить ошибки, слишком хлопотно заново все начинать. Сначало надо запустить эту программу потом уже думать как переписать более оптимально. Для того чтобы был стимул, дальше двигаться, а если моя первая программа не доработана, то и стимула, что-то делать нет.

Это Ваше "заднее" слово?) "Заднее слово"

-> "а если моя первая программа не доработана, то и стимула, что-то делать нет." ... Сразу хотите, "Летать"

Скрытый текст

А как же ... шаг за шагом, легкие пробежки, более быстрый бег, скоростные забеги, ... чемпионат мира.

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

-> "слишком хлопотно заново все начинать. " -> "Это же не значит всё выбросить и с сызнова написать",

Скрытый текст

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

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

Написав данное сообщение, я не хотел Вас обидеть, или как уязвить. Лишь подбодрить ...

Сообщение отредактировано: RusSun - 27.06.22, 07:34

[RusSun]

Играю так !
Прикреплённый файлTestKaterina1993_2_.zip (57,03 Кбайт, скачиваний: 44)

[macomics]

А если еще избавиться от ApplicationEvents, то и под Linux в Lazarus будет компилироваться. Там же даже не нужно такого костыля. Достаточно Form1MouseDown и Form1MouseUp

[RusSun]

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, AppEvnts;
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button3: TButton;
    Memo1: TMemo;
    Memo2: TMemo;
    Memo3: TMemo;
    Button2: TButton;
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
//    procedure Button2Click(Sender: TObject);
    procedure FormClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(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
    constructor Create(_x0, _y0, _width, _height:Integer);
    procedure DrawSlot(Cs:TCanvas;x,y,MapX,MapY:Integer); //Прорисовка
    procedure DrawItem(Cs:TCanvas;rect:TRect); //Прорисовка
  end;
    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));
var
  Form1: TForm;
  rightb, leftb, upb, downb : Boolean;
  OldX, OldY : integer;
 
  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;
 
  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}
 
constructor TSlot.Create(_x0, _y0, _width, _height:Integer);
begin
  inherited Create;
  x0 := _x0;
  y0 := _y0;
  width:= _width;
  height:= _height;
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
  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);
 
   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;
//Таймер для прорисовки предметов на холсте
 
procedure TForm1.FormPaint(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, чтобы определить
  //остались предметы на холссте. Выводим сообщение, что предметы найдены.
 
    //  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].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.Button1Click(Sender: TObject);
var
i:Integer; S:String;
begin
s:='';
for i:= 0 to 5 do
begin
s:=s+intTostr(i)+') '+slot1[i]+#13#10;
end;
ShowMessage(S);
end;
 
//procedure TForm1.Button2Click(Sender: TObject);
////var s:string;
//begin
//  Form1.Caption:='lengthMemo2 '+IntToStr(length(Memo2.Text))+' ->'+Memo2.Text+'<- '+'Memo2.Lines.Count '+IntToStr(Memo2.Lines.Count);
//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.FormClick(Sender: TObject);
var P : TPoint;
   i,ii,b,t1,ti,tt: Integer;
begin
P:=Form1.ScreenToClient(Mouse.CursorPos);
   t1 := 0;
   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 не было пустым
 
         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];
             //tmpItem[t1]:=b; // Зачем копировать строки, когда достаточно скопировать индексы
            inc(t1); // Вместо Length(tmpItem) достаточно использовать t1
 
        end;
       // Form1.Caption:='t1 is '+intToStr(t1);
        //При нажатии происходит сравнение всех предметов которые на холсте,
        //с теми что в слотах и если совпадение найдено, предмет удаляется, а
        //в массиве мы получаем пустое значение
        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];
                                             Form1.Caption:='ii is '+intToStr(ii)+' Item1[tt] '+Item1[tt];
                                            //slot1[ii]:=tmpItem[Random(Length(tmpItem))];
                                            Item1[ii]:='empty';
                                        end;
 
             end;
 
 
     end;
  end;
 
 Form1.Repaint();
 if (Memo2.Lines.Count =1) and (trim(Memo2.Text) = '0') then  Form1.Caption:='Вы нашли все предметы!';
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var i,k1,j:Integer; s:String;
begin
Randomize;
 
//Создаем новый массив с шестью слотами
setLength(slot1,6);
for j:=0 to 5 do slt[j]:=TSlot.Create(10+j*60,370,50,50);
// slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
  //Перемещиваем предметы случайным образом и добавляем их в слоты
  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]+' '+intTostr(k1))
  end;
 
//slot1[0]:='Goblet';
//slot1[1]:='Vase';
//slot1[2]:='Thread';
//slot1[3]:='Stick';
//slot1[4]:='Handbell';
//slot1[5]:='Whisk';
// Timer1.Enabled:=True;
 
 
for i := 0 to 19 do
 rect[i] := TRect.Create(Position2[i,1],Position2[i,2],0,0,40,40,i,ItemColor[i],Item1[i],false);
 
end;
 
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
var i:integer;
begin
  for i := 0 to 9 do rect[i].dragok:=false;
end;
 
end.

1) Это конечно не полностью доделанный код. Скорее местами поправки.
2) В свою очередь, теперь программа запускается, и можно ..."просто придумать как подправить ошибки" потому, что есть то, что ещё делать дальше;
3) В большей степени, я не программирую, потому, что правильный ответ "Я не знаю, лишь на практике, что-то поправляю, и это как правило работает";
4) Не нужно стесняться упрощать некоторые моменты в программе, для понимания -> "как это работает, или не работает";
5) Когда не понимаю, то начинаю поверять так сказать "математику + логику" -> "Что дано"->"Что происходит или должно меняться или не меняться "->"И что в сухом остатке";
6) Также я думаю, не стоит пренебрегать -> "Showmessage('Info')"," Form1.Caption:='Info' ",и "// или (**) или {}" чтобы анализировать "код";
7) Всегда нужно пользоваться интернетом для поиска информации, кодов, реализации. Не нужно верить на слово, сделайте тест для проверки "верности", "направления и мысли";
... Ну и вишенка на торте, это то понимание, "что же вы хотите сделать?" и "Ваше понимание как это должно быть исполнено".

Цвет можно также задавать

Скрытый текст

в том числе так

Color:=$E8BB99

Сообщение отредактировано: RusSun - 27.06.22, 06:34

[macomics]

Появилось свободное время и набросал вот такой код. Думаю так будет интереснее.
Немного изменил принцип. Цветные прямоугольники надо перетаскивать на прямоугольники сверху (на те, которые с подписями).
Когда угадываешь, то прямоугольник остается на своем месте. Когда угадываешь все - Win и по клику в любом месте новая игра.

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
 
  THiddenObj = packed record
    Name: LongInt;
    Brush: packed record
      case Byte of
        0: (Color: TColor);
        1: (b, g, r: Byte);
    end;
    Position: TPoint;
  end;
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: char);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseLeave(Sender: TObject);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormPaint(Sender: TObject);
    procedure Regenerate;
    procedure Timer1Timer(Sender: TObject);
  private
    Item: array of THiddenObj;
    DragIndex: LongInt;
    DragHand: TPoint;
    Highlight: LongInt;
    GenerateNew: Boolean;
    StartTime: Comp;
    ItemFound: LongInt;
  public
 
  end;
 
const
  Form1Caption: String = 'Game';
  HorizontalSpace: LongInt = 4;
  MaxUsedOnScreen: LongInt = 10;
  MaxItemOnScreen: LongInt = 25;
  RectWidth: LongInt = 75;
  RectHeight: LongInt = 24;
  VerticalSpace: LongInt = 8;
 
var
  Form1: TForm1;
  Items: array of String = ('Thread','Goblet','Stick','Doorknob','Loupe',
    'Statuette','Ring','Crown','Vase','Gripsack','Book','Glove','Salver',
    'Brush','Handbell','Cigarcase','Lantern','Card','Candy','Whisk');
 
implementation
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Randomize;
  ClientWidth := MaxUsedOnScreen * (VerticalSpace + RectWidth) + VerticalSpace;
  Regenerate;
end;
 
procedure TForm1.FormKeyPress(Sender: TObject; var Key: char);
begin
  if GenerateNew then begin
    Regenerate;
    Repaint;
  end;
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: LongInt;
begin
  if GenerateNew then Regenerate else begin
    if not Timer1.Enabled then begin
      StartTime := TimeStampToMSecs(DateTimeToTimeStamp(Now));
      Timer1.Enabled := True;
    end;
    for i := Low(Item) to High(Item) do begin
      if (X >= Item[i].Position.x) and (X <= Item[i].Position.x + RectWidth)
      and (Y >= Item[i].Position.y) and (Y <= Item[i].Position.y + RectHeight)
      then begin
        DragIndex := i;
        DragHand := Point(X - Item[i].Position.x, Y - Item[i].Position.y);
        Repaint;
        break;
      end;
    end;
  end;
end;
 
procedure TForm1.FormMouseLeave(Sender: TObject);
var
  i, j, k: LongInt;
begin
  if DragIndex >= Low(Item) then begin
    i := Item[DragIndex].Position.y;
    j := 3 * HorizontalSpace div 2 + RectHeight + 1;
    k := Highlight + Low(Item);
    if (i <= j) and (Highlight >= 0) then begin
      if k = Item[DragIndex].Name
      then Item[DragIndex].Position := Point(VerticalSpace + Highlight
               * (VerticalSpace + RectWidth), HorizontalSpace)
      else Item[DragIndex].Position.y := j;
    end else if i <= j then Item[DragIndex].Position.y := j;
  end;
  DragIndex := Low(Item) - 1;
  Highlight := -1;
  Repaint;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  i: LongInt;
  p, q: TPoint;
  function MinMax(Min: LongInt; Aim: LongInt; Max: LongInt): LongInt;
  begin
    if Aim < Min then MinMax := Min
    else if Aim > Max then MinMax := Max
    else MinMax := Aim;
  end;
begin
  if DragIndex >= Low(Item) then begin
    Item[DragIndex].Position := Point(MinMax(0, X - DragHand.x, ClientWidth
        - RectWidth), MinMax(0, Y - DragHand.y, ClientHeight - RectHeight));
    Highlight := -1;
    for i := 0 to MaxUsedOnScreen - 1 do begin
      p := Point(VerticalSpace + i * (RectWidth + VerticalSpace), HorizontalSpace);
      q := Point(p.x + RectWidth, p.y + RectHeight);
      if (X - DragHand.x >= p.x) and (X - DragHand.x <= q.x)
      and (Y - DragHand.y >= p.y) and (Y - DragHand.y <= q.y) then begin
        Highlight := i;
        break;
      end;
    end;
    Repaint;
  end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FormMouseLeave(Sender);
end;
 
procedure TForm1.FormPaint(Sender: TObject);
const
  msg: String = 'You are win!';
var
  i, j, k: LongInt;
  p: TPoint;
begin
  with Canvas do begin
    for i := 0 to MaxUsedOnScreen - 1 do begin
      p := Point(VerticalSpace + i * (RectWidth + VerticalSpace), HorizontalSpace);
      if Highlight = i then begin
        Pen.Color := clRed;
        Pen.Style := psDash;
        if Item[DragIndex].Name = i
        then Brush.Color := clLime
        else Brush.Color := clWhite;
      end else begin
        Pen.Color := clBlack;
        Pen.Style := psSolid;
        Brush.Color := clLtGray;
      end;
      Rectangle(p.x, p.y, p.x + RectWidth, p.y + RectHeight);
      TextOut(p.x + 2, p.y + 2, Items[Low(Items) + i]);
    end;
    Pen.Color := clBlack;
    Pen.Style := psDot;
    Brush.Color := clWhite;
    j := 3 * HorizontalSpace div 2 + RectHeight;
    k := 0;
    Line(0, j, ClientWidth + 1, j);
    Pen.Style := psSolid;
    for i := Low(Item) to High(Item) do if (DragIndex >= Low(Item)) and (DragIndex <> i)
    or (DragIndex < Low(Item)) then begin
      Brush.Color := Item[i].Brush.Color;
      p := Item[i].Position;
      Rectangle(p.x, p.y, p.x + RectWidth, p.y + RectHeight);
      if (p.y < j) then inc(k);
    end;
    if DragIndex >= Low(Item) then begin
      Pen.Style := psDashDotDot;
      Pen.Color := clYellow;
      Brush.Color := clAqua;
      p := Item[DragIndex].Position;
      Rectangle(p.x, p.y, p.x + RectWidth, p.y + RectHeight);
      Pen.Style := psSolid;
      Pen.Color := clBlack;
      Brush.Color := clWhite;
    end;
    if k = MaxUsedOnScreen then begin
      Timer1.Enabled := False;
      Caption := Form1Caption + '(' + msg + ')';
      Pen.Color := clBlack;
      Brush.Color := clWhite;
      i := (ClientWidth - TextWidth(msg)) div 2;
      j := (ClientHeight - TextHeight(msg)) div 2;
      FillRect(0, 0, ClientWidth, ClientHeight);
      TextOut(i, j, msg);
      GenerateNew := True;
    end;
    ItemFound := k;
  end;
end;
 
procedure TForm1.Regenerate;
var
  i, j, l, m, n: LongInt;
  o, p, q, r: TPoint;
  t: String;
begin
  Caption := Form1Caption;
  GenerateNew := False;
  Highlight := -1;
  ItemFound := 0;
  DragIndex := Low(Item) - 1;
  l := ClientWidth - RectWidth - 2 * VerticalSpace;
  n := 2 * HorizontalSpace + RectHeight;
  m := ClientHeight - 2 * n;
  SetLength(Item, MaxItemOnScreen);
  for i := Low(Item) to High(Item) do begin
    repeat p := Point(VerticalSpace + Random(l), HorizontalSpace + n + Random(m));
      r := Point(p.x + RectWidth, p.y + RectHeight);
      j := Low(Item);
      while j < i do begin
        q := Item[j].Position;
        o := Point(q.x + RectWidth + VerticalSpace,
                   q.y + RectHeight + HorizontalSpace);
        q := Point(q.x - VerticalSpace, q.y - HorizontalSpace);
        if ((p.x >= q.x) and (p.x <= o.x) and (p.y >= q.y) and (p.y <= o.y))
        or ((p.x >= q.x) and (p.x <= o.x) and (r.y >= q.y) and (r.y <= o.y))
        or ((r.x >= q.x) and (r.x <= o.x) and (r.y >= q.y) and (r.y <= o.y))
        or ((r.x >= q.x) and (r.x <= o.x) and (p.y >= q.y) and (p.y <= o.y))
        then break;
        inc(j);
      end;
    until j = i;
    if i - Low(Item) < MaxUsedOnScreen then begin
      j := Low(Items) + Random(Length(Items) + Low(Item) - Low(Items) - i);
      if j <> i then begin
        t := Items[i];
        Items[i] := Items[j];
        Items[j] := t;
        j := i;
      end;
    end else j := Low(Item) - 1;
    Item[i].Name := j;
    Item[i].Brush.r := 64 + Random(164);
    Item[i].Brush.g := 64 + Random(192);
    Item[i].Brush.b := 64 + Random(164);
    Item[i].Position := p;
  end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var
  i, j: LongInt;
  m, s, u: String;
begin
  i := LongInt(Int64(TimeStampToMSecs(DateTimeToTimeStamp(Now)) - StartTime) mod 3600000);
  u := IntToStr((i mod 1000) div 100);
  j := (i div 1000) mod 60;
  i := i div 60000;
  if j < 10 then s := '0' + IntToStr(j) else s := IntToStr(j);
  if i < 10 then m := '0' + IntToStr(i) else m := IntToStr(i);
  i := ItemFound;
  j := MaxUsedOnScreen;
  Caption := Format('%s [%d / %d] %s:%s:%s', [Form1Caption, i, j, m, s, u]);
end;
 
initialization
  {$I unit1.lrs}
 
end.

Писал в Lazarus под Linux, некоторые модули в Delphi могут быть лишними, а каких-то может не хватать. Но код без использования системных функций - при желании можно переносить функции обработчики и все сработает.

Сообщение отредактировано: macomics - 03.07.22, 17:00

[Katerina1993]

Все, я тоже решила, мой вариант, может не совсем правильный зато работает. От Timer пришлось отказаться, потому что мерцание происходит при прорисовки и высокая нагрузка. Вместо таймера я просто вызываю при щелчке OnPaint (Repaint;).

В коде находятся комментарии. Программа сделана на Delphi7.

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, AppEvnts;
type
  TForm1 = class(TForm)
    ApplicationEvents1: TApplicationEvents;
    Memo1: TMemo;
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure RePaintObj;
  end;
  TRect = class
  private
      x0, y0: Integer;
      width, height: Integer;
      str:String;
      color : TColor;
      bool : Boolean;
      Map_X, Map_Y: Integer;
      id1:Integer;
  public
    constructor Create(_x0, _y0, _MapX, _MapY, w1, h1,_id1: Integer; _Color:TColor; _str:String; _bool:Boolean);
    Procedure Draw(Cs:TCanvas;x,y,id2,MapX,MapY:Integer); //Прорисовка
  end;
  TSlot = class
  private
    x0,y0:Integer;
    str2:String;
    width, height:Integer;
  public
 // ; _slot:TRect
    constructor Create(_x0, _y0, _width, _height:Integer;_str2:String);
    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;
  rect3 : Array [0..5] 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);
  count1:Integer;
  count2:Integer = 0;
  var
  tmpItem: array of TRect;
  tmpItem2: array of TRect;
 
implementation
 
{$R *.dfm}
// _slot:TRect
constructor TSlot.Create(_x0, _y0, _width, _height:Integer;_str2:String);
begin
  inherited Create;
  x0 := _x0;
  y0 := _y0;
  width:= _width;
  height:= _height;
  str2:=_str2;
 // 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; _bool:Boolean);
begin
  inherited Create;
  x0 := _x0;
  y0 := _y0;
  str := _str;
  width := w1;
  height := h1;
  color := _Color;
  bool := _bool;
  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;
 
 
 
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
  var
  
   P : TPoint;
   i,t2,ii,a,rand,kk: 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
         //Здесь подошли к следующему решение, ЕСЛИ (IF) предметов на холсте больше
         //чем в слотах то происходит один цикл, если на холсте
         //предметов меньше чем в слотах, ТОГДА (THEN)
         //произойдет другое действие
         //Чтобы посчитать сколько предметов существуют на холсте, используем
         //переменную tmpItem2, в котором происходит условие на пустоту (EMPTY) и
         //на флаг bool - который отвечает, что предмет находится в слоте.
         //Всем предметам на холсте присвоен bool false.
         //Те которые попадают в слоты присвоен bool true.
        
         if count1 > 0 then
         begin
           for ii:=0 to High(rect3) do
           begin
            if rect[i].id1 = rect3[ii].id1 then
            begin
            
             Item1[i]:='empty';
 
             t2 := 1;
            
             for a:=low(rect2) to High(rect2) do
             begin
  
              
              if (Item1[a] <> 'empty') and (rect2[a].bool = false) then
               begin
                 setLength(tmpItem2, t2);
                 tmpItem2[t2-1]:=rect2[a];
                 inc(t2);
               end;
              end;
              //Делаем случайный выбор из тех элементов которые не выбыли из
              //игры и не получили статус empty, а также те которые не
              //находятся в слотах и у которых значение bool = false
              rand:=Trunc(Random(High(tmpItem2)));
              //Создаем новый класс для слота
              rect3[ii] := rect2[tmpItem2[rand].id1];
              //Присваиваем случайно добавленному в слот элементу значение true
              rect2[tmpItem2[rand].id1].bool:=true;
              //Заносим количество оставшихся элементов на холсте
              //в новую переменную
              count1 := High(tmpItem2);
              //************************************************
              //Пришлось отказаться от компонента Timer по причине, что
              //происходит мерцание и нагрузка из-за постоянных прорисовок
              //Поэтому при нажатии кнопки делаем прорисовку всего один раз
              //************************************************
              Repaint;
              
            end;
 
            
           end;
         end
         else
         begin
          //Когда предметов на холсте становится меньше чем в слотах
          //выполняем это условие
          //Здесь через цикл сравниваем на какой предмет был произведен щелчок
          //и просто значениям присваиваем empty
          //Дальше объекты перерисуются и слоты станут пустыми
 
          //переменная count2 - ведет заключительный подсчет.
          //Каждый раз когда слот пустеет прибавляется единица
          for kk:=0 to High(rect3) do
           begin
 
           if rect[i].id1 = rect3[kk].id1 then
            begin
             Item1[i]:='empty';
             slt[kk].str2 := 'empty';
             count2:=count2+1;
            end
          end;
          Repaint;
          //Сравниваем если count2 равен 6 то выводим сообщение о победе
          if count2 = 6 then
          begin
            ShowMessage('Все предметы найдены!');
          end;
        end;
 
        // for i2 := 0 to 19 do
        // begin
         //if Item1[i2] <> 'empty'
        // then
         //  begin
             // rect[i2].Draw(Form1.Canvas,Position2[i2,1],Position2[i2,2],i2,0,0);
         //  end;
        // end;
      
 
      
     end;
  end;
      
        
    end;
  
 
    
 
end;
 
procedure TForm1.FormPaint(Sender: TObject);
 
 
begin
RePaintObj;
 
 
 
 
end;
//*******************************************
//Для работы было принято решения создавать классы при показе формы FormShow
//а отрисовку предметов делать FormPaint.
//*******************************************
 
procedure TForm1.FormShow(Sender: TObject);
var k1,i,i1,a,t1:Integer;
begin
 
//setLength(slot1,6);
//Стартовые позиции всех предметов
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 i1 := 0 to 19 do
begin
  
  rect[i1] := TRect.Create(Position2[i1,1],Position2[i1,2],0,0,40,40,i1,ItemColor[i1],Item1[i1],false);
 
  rect2[i1]:=rect[i1];
 
end;
 
//Создаем новый массив с шестью слотами
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;
 // ShowMessage(IntToStr(High(slot1)));
  //Слоты которые нужно заполнить
  for k1:=0 to High(slot1) do
  begin
 
     rect2[k1].bool:=true;
 
     slt[k1]:=TSlot.Create(10+k1*60,370,50,50,Item1[k1]);
     //Создаем дополнительный класс используя уже существующий
     rect3[k1]:=rect[k1];
     //присваиваем название предмета, чтобы потом делать
     //проверку существует предмет или нет
     slot1[k1]:=Item1[k1];
    
  end;
 
 
   //Создаем дополнительные временной массив где будем хранить данные, это
   //нужно чтобы убирать найденные предметы и заполнять их новыми
   //так мы избежим повторов в дальнейшем
  t1 := 1;
  for a:=low(rect2) to High(rect2) do
  begin
    //Item1[a] - если значение не пустое значит предмет еще не найден
    //rect2[a].bool - проверяем добавлен предмет в слот, если да то это значение
    //будет true, в данном случае false, так как здесь обозначен список предметов
    //над которыми не производилось действие.
    if (Item1[a] <> 'empty') and (rect2[a].bool = false) then
    begin
      setLength(tmpItem, t1);
      tmpItem[t1-1]:=rect2[a];
      inc(t1);
    end;
    
 
  end;
  count1 := High(tmpItem);
 
end;
//Процедура рисования предметовы
procedure TForm1.RePaintObj;
var i,j: Integer;
begin
//Размещаем объекты на холсте
 for i := 0 to 19 do
         begin
         if Item1[i] <> 'empty'
         then
           begin
              rect[i].Draw(Form1.Canvas,Position2[i,1],Position2[i,2],i,0,0);
           end;
         end;
 
 
//Заполняем слоты если значение не пустое
Memo1.Clear;
for j:=0 to 5 do
begin
  
 
  slt[j].DrawSlot(Form1.Canvas,0,0,0,0);
  Memo1.Lines.Add(slt[j].str2);
  if slt[j].str2 <> 'empty' then
   begin
    rect3[j].Draw(Form1.Canvas,15+j*60,375,rect3[j].id1,0,0);
  end;
 
  end;
 
 
end;
 
 
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
end;
 
end.

Только почему-то пропали цифры когда предмет попадает в слот.
Прикреплённый файлScreenshot1.jpg (50,73 Кбайт, скачиваний: 50)

Сообщение отредактировано: Katerina1993 - 04.07.22, 11:18

[RusSun]

Доброго времени суток)
1 Что будет, если сделать, так :

//Процедура рисования предметовы
procedure TForm1.RePaintObj;
var i,j: Integer;
begin
//Размещаем объекты на холсте
 for i := 0 to 19 do
 
         if Item1[i] <> 'empty'
         then
           begin
              //rect[i].Draw(Form1.Canvas,Position2[i,1],Position2[i,2],i,0,0);
           end;

Картинка в прикреплении. -> "Потерянная нумерация слотов"
2 А где это используется?

//Добавляем в слоты предметы
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;

Это вот TRect.Draw есть.

Прикреплённый файлlost_numbers.JPG (16,97 Кбайт, скачиваний: 46)

Сообщение отредактировано: RusSun - 06.07.22, 15:58

[macomics]

А в чем смысл оставлять вот это.

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;

Почему не заполнить массив сразу. Я уже написал как это сделать.

[Katerina1993]

Цитата

2 А где это используется?

Я код переписала, а не заново написала поэтому нигде, часть процедур сохранилось со старого примера.

Цитата

А в чем смысл оставлять вот это.

Код же прокоментирован и там написано.

Цитата

//Стартовые позиции всех предметов

Если убрать массивы то все предметы переместятся в угол экрана.

Цитата

Почему не заполнить массив сразу. Я уже написал как это сделать.

Я прочитала ваша сообщение в самом начале, но когда стала переписывать код, просто не вспомнила, что можно и так сделать и сделала как было.

Сообщение отредактировано: Katerina1993 - 07.07.22, 12:19

[RusSun]

Ответ: находится в Cs.TextOut передаются не те координаты. Хотя для рисования слотов идут "верные координаты".

Цитата

//Создаем на холст предметы и пронумеруем их.
в procedure TRect.Draw(Cs: TCanvas; x, y, id2, MapX, MapY: Integer);

Рисуется и область и выводится нумерация.
Если не точность идёт в расположении нумерации ( ), то ищем именно там.

Скрытый текст

procedure TRect.Draw(Cs: TCanvas; x, y, id2, MapX, MapY: Integer);
begin
 
  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(x+Map_X,y+Map_Y, IntToStr(id1));//<- Здесь вместо x0,y0

   Cs.Font.Color:= clBlack;
 
end;

Сообщение отредактировано: RusSun - 09.07.22, 06:59

[Katerina1993]

RusSun, все исправила.

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(x+Map_X,y+Map_Y, IntToStr(id1));
   Cs.Font.Color:= clBlack;
   Cs.TextOut(x+Map_X,y+Map_Y, IntToStr(id1));
end;

Теперь цифры добавляются и в слоты. Результат:

Прикреплённый файлscreenshot1.jpg (43,98 Кбайт, скачиваний: 45)

[macomics]

Прекрасно. А если еще к TextOut координатам добавить по единичке, тогда фон текста не будет стирать рамку.

    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(x+Map_X,y+Map_Y, IntToStr(id1));
       Cs.Font.Color:= clBlack;
       Cs.TextOut(x+Map_X + 1,y+Map_Y + 1, IntToStr(id1));
    end;