Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[98.84.25.165] |
|
Сообщ.
#1
,
|
|
|
Делаю поиск предметов, у меня несколько массивов для хранения элементов
Программа у меня работает, можно ориентироваться по списку слотов который находится внизу и убирать элементы. Здесь в любом случае пользователь придет к победе.Вначале генерируются предметы случайным образом без повторов, но когда начинаешь щелкать на предметах на холсте мышкой, чтобы убрать их. Ново-созданные предметы в слотах начинают повторяться. Пример на картинке в прикрепленном файле. Прикреплённый файл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. |
Сообщ.
#2
,
|
|
|
//Создается временный массив куда заносятся оставшиеся элементы которые //еще не выбыли с холста. //Перед созданием 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; |
Сообщ.
#3
,
|
|
|
Не понятно изначально tmpItem идет как строка.
Поэтому ошибки будут здесь(потому, что встречается число вместо строки): tmpItem[t1]:=b; // Зачем копировать строки, когда достаточно скопировать индексы и здесь tt := tmpItem[ti]; tmpItem[ti] := tmpItem[ii]; tmpItem[ii] := tt; |
Сообщ.
#4
,
|
|
|
Так измените тип массива на числовой.
У меня смысл кода в том, что вам надо изменять на empty не Item1[i], а Item1[tmpItem[ii]]. Но если сохранять строки, тогда индексы в Item1 потеряются. Понадобится составлять массив ассоциаций tempIndex и массив строк tempItem. Можно обойтись без этого. Достаточно изменить массив tmpItem на числовой и сохранять в нем индексы из Item1. |
Сообщ.
#5
,
|
|
|
Я изменила код теперь завершения игры не возможна, так как некоторые элементы отсутствуют, а при щелчке на предмете почему-то удаляются не тот предмет.
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. |
Сообщ.
#6
,
|
|
|
Тогда будем разбираться с самого начала.
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; 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; 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; Итог. Ничего удивительного, что вы получаете что-то непонятное. Если давать совет по работе программы. Лучше полностью перепишите. Сформулируйте структуру TItem, которая будет связывать название и координаты, номер слота и цвет. Однократно инициализируйте массив этих структур в TForm1.FormCreate, а отрисовывайте все необходимое в TForm1.FormPaint. При необходимости перерисовки по таймеру, в обработчике таймера помещается одна единственная команда TForm1.Repaint, перед которой в уже заполненные элементы TItem вносятся необходимые изменения. При этом не нужно ловить события WM_LBUTTONDOWN и другие через фильтр, а достаточно будет обработчиков TForm1.FormKeyDown или TForm1.FormClick и им подобных. |
Сообщ.
#7
,
|
|
|
Переписывать я не собираюсь программа почти готова, нужно просто придумать как подправить ошибки, слишком хлопотно заново все начинать. Сначало надо запустить эту программу потом уже думать как переписать более оптимально. Для того чтобы был стимул, дальше двигаться, а если моя первая программа не доработана, то и стимула, что-то делать нет.
|
Сообщ.
#8
,
|
|
|
Все вышеописанное это ошибки. Их надо исправлять. Но они настолько большие, что проще все переписать.
Например: Используя TRect.Create(...) вы изменяете все свойства элемента, а в исходном конструкторе inherited Create; может еще и память динамически выделяться. Потом вы не освобождая созданный экземпляр просто перезаписываете его новым, что приводит к утечке памяти. Это уже фундаментальная ошибка. |
Сообщ.
#9
,
|
|
|
Цитата Katerina1993 @ Переписывать я не собираюсь программа почти готова, нужно просто придумать как подправить ошибки, слишком хлопотно заново все начинать. Сначало надо запустить эту программу потом уже думать как переписать более оптимально. Для того чтобы был стимул, дальше двигаться, а если моя первая программа не доработана, то и стимула, что-то делать нет. Это Ваше "заднее" слово?) "Заднее слово" -> "а если моя первая программа не доработана, то и стимула, что-то делать нет." ... Сразу хотите, "Летать" Скрытый текст А как же ... шаг за шагом, легкие пробежки, более быстрый бег, скоростные забеги, ... чемпионат мира. -> ", нужно просто придумать как подправить ошибки," -> "слишком хлопотно заново все начинать. " -> "Это же не значит всё выбросить и с сызнова написать", Скрытый текст Вы используете, что уже наработали ( написали ) + то, что Вам подсказали на форуме, пробуете всё это соединить во что-то единое, верно структурированное и рабочее, в следствии "верных действии", всё "правильно" заработает. Можно и по другому посмотреть на это, просто взять и внести необходимые изменения, постепенно, в помощи Вам не отказывают? "macomics" очень подробно и доходчиво объяснял Вам. Выбор за Вами конечно) Написав данное сообщение, я не хотел Вас обидеть, или как уязвить. Лишь подбодрить ... |
Сообщ.
#10
,
|
|
|
Играю так !
Прикреплённый файлTestKaterina1993_2_.zip (57,03 Кбайт, скачиваний: 56) |
Сообщ.
#11
,
|
|
|
А если еще избавиться от ApplicationEvents, то и под Linux в Lazarus будет компилироваться. Там же даже не нужно такого костыля. Достаточно Form1MouseDown и Form1MouseUp
|
Сообщ.
#12
,
|
|
|
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 |
Сообщ.
#13
,
|
|
|
Появилось свободное время и набросал вот такой код. Думаю так будет интереснее.
Немного изменил принцип. Цветные прямоугольники надо перетаскивать на прямоугольники сверху (на те, которые с подписями). Когда угадываешь, то прямоугольник остается на своем месте. Когда угадываешь все - 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. |
Сообщ.
#14
,
|
|
|
Все, я тоже решила, мой вариант, может не совсем правильный зато работает. От 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 Кбайт, скачиваний: 56) |
Сообщ.
#15
,
|
|
|
Доброго времени суток)
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 Кбайт, скачиваний: 54) |
Сообщ.
#16
,
|
|
|
А в чем смысл оставлять вот это.
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; |
Сообщ.
#17
,
|
|
|
Цитата 2 А где это используется? Я код переписала, а не заново написала поэтому нигде, часть процедур сохранилось со старого примера. Цитата А в чем смысл оставлять вот это. Код же прокоментирован и там написано. Цитата //Стартовые позиции всех предметов Если убрать массивы то все предметы переместятся в угол экрана. Цитата Почему не заполнить массив сразу. Я уже написал как это сделать. Я прочитала ваша сообщение в самом начале, но когда стала переписывать код, просто не вспомнила, что можно и так сделать и сделала как было. |
Сообщ.
#18
,
|
|
|
Ответ: находится в 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( // 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; |
Сообщ.
#19
,
|
|
|
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 Кбайт, скачиваний: 57) |
Сообщ.
#20
,
|
|
|
Прекрасно. А если еще к 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; |