Форум на Исходниках.RU

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

macomics — Sat, 09 Jul 2022 14:18:00 +0000

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;

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

Katerina1993 — Sat, 09 Jul 2022 13:54:04 +0000

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 (, : 108)

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

RusSun — Sat, 09 Jul 2022 06:50:50 +0000

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

Цитата

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

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

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

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;

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

Katerina1993 — Thu, 07 Jul 2022 12:13:50 +0000

Katerina1993:

Цитата

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

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

Цитата

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

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

Цитата

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

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

Цитата

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

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

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

macomics — Wed, 06 Jul 2022 16:19:34 +0000

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;

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

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

RusSun — Wed, 06 Jul 2022 15:57:05 +0000

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 (, : 103)

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

Katerina1993 — Mon, 04 Jul 2022 11:11:48 +0000

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;

//Делаем случайный выбор из тех элементов которые не выбыли из

//игры и не получили статус 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

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;

// 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;

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;

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;

//Заполняем слоты если значение не пустое

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;

procedure TForm1.FormCreate(Sender: TObject);

begin

Randomize;

end;

end.

Только почему-то пропали цифры когда предмет попадает в слот.
Screenshot1.jpg (, : 114)

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

macomics — Sun, 03 Jul 2022 10:26:25 +0000

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;

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;

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;

Repaint;

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;

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;

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 могут быть лишними, а каких-то может не хватать. Но код без использования системных функций - при желании можно переносить функции обработчики и все сработает.

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

RusSun — Sun, 26 Jun 2022 19:30:05 +0000

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;

//Делаем проверку массива 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;

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;

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;

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

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

macomics — Sun, 26 Jun 2022 18:13:13 +0000

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

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

RusSun — Sun, 26 Jun 2022 17:18:12 +0000

RusSun: Играю так ;) !
TestKaterina1993_2_.zip (, : 97)

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

RusSun — Fri, 24 Jun 2022 04:15:32 +0000

RusSun:

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

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

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

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

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

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

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

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

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

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

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

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

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

macomics — Wed, 22 Jun 2022 13:24:58 +0000

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

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

Katerina1993 — Wed, 22 Jun 2022 12:56:00 +0000

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

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

macomics — Wed, 22 Jun 2022 11:13:54 +0000

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;

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

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;

Строки 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;

//Делаем проверку массива 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;

Опять же. Для рисования на окне существует обработчик TForm1.FormPaint, который перед вызовом подготавливается к выводу на форму графики, а после возврата применяет весь сделанный вывод одним блоком, что должно уменьшать мерцание. Рисовать на форме в любом месте кода не самая лучшая затея. По таймеру, если необходимо перерисовывать окно, достаточно вызвать Form1.Repaint(), а не вызывать функции рисования. Но кроме функций рисования вы еще и изменяете структуру, создавая новые элементы через TRect.Create и TSlot.Create

Итог. Ничего удивительного, что вы получаете что-то непонятное. Если давать совет по работе программы. Лучше полностью перепишите. Сформулируйте структуру TItem, которая будет связывать название и координаты, номер слота и цвет. Однократно инициализируйте массив этих структур в TForm1.FormCreate, а отрисовывайте все необходимое в TForm1.FormPaint. При необходимости перерисовки по таймеру, в обработчике таймера помещается одна единственная команда TForm1.Repaint, перед которой в уже заполненные элементы TItem вносятся необходимые изменения. При этом не нужно ловить события WM_LBUTTONDOWN и другие через фильтр, а достаточно будет обработчиков TForm1.FormKeyDown или TForm1.FormClick и им подобных.

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

Katerina1993 — Wed, 22 Jun 2022 08:30:07 +0000

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;

//Делаем проверку массива 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;

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;

if Msg.message = WM_LBUTTONUP then

begin

for i := 1 to 10 do

begin

rect[i].dragok:=false;

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;

procedure TForm1.Button1Click(Sender: TObject);

var

i:Integer;

begin

for i:= 0 to 5 do

begin

//ShowMessage(slot1[i]);

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;

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 — Tue, 21 Jun 2022 23:01:08 +0000

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

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

Katerina1993 — Tue, 21 Jun 2022 21:58:37 +0000

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

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

и здесь

tt := tmpItem[ti];

tmpItem[ti] := tmpItem[ii];

tmpItem[ii] := tt;

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

macomics — Tue, 21 Jun 2022 20:06:38 +0000

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;

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

Katerina1993 — Tue, 21 Jun 2022 18:00:46 +0000

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

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

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

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;

//Делаем проверку массива 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;

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;

if Msg.message = WM_LBUTTONUP then

begin

for i := 1 to 10 do

begin

rect[i].dragok:=false;

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;

procedure TForm1.Button1Click(Sender: TObject);

var

i:Integer;

begin

for i:= 0 to 5 do

begin

//ShowMessage(slot1[i]);

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;

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.