Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
0 / 0 / 0
Регистрация: 14.03.2015
Сообщений: 6
1

Как сделать сохранение в игре пазлы

29.09.2019, 13:25. Показов 303. Ответов 1
Метки нет (Все метки)

Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, jpeg, ExtCtrls, ComCtrls, Grids,Shellapi;
 
type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet2: TTabSheet;
    Button2: TButton;
    Image2: TImage;
    Button3: TButton;
    StringGrid1: TStringGrid;
    StatusBar1: TStatusBar;
    Button1: TButton;
    Button4: TButton;
    ScrollBox1: TScrollBox;
    Image1: TImage;
    TabSheet1: TTabSheet;
    Image3: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BNew(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Label2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 TMassivImage = record
    x,y:integer;
    w,h:Integer;
    Bit:Tbitmap;
 end;
var
  Form1: TForm1;
  ImMas:array of TMassivImage;
  ImMasCount:integer;
    rm,rx,ry:integer;
   r:Trect;
   MashtabX:integer;
   MashtabY :integer;
   cx,cy:integer;
   dvig:boolean=false;
   ci:integer;
   dx,dy:integer;
   DvigBit:Tbitmap;
   tx,ty:integer;
 
   CountX,CountY:integer;
implementation
 
{$R *.dfm}
 
  // пропорциональное изменение размеров
   Function GetImageWH(thumbnail:Timage;maxWidth,maxHeight:integer):Trect;
   begin
   result.Left:=0;result.top:=0;
    if thumbnail.Width > thumbnail.Height then
    begin
      result.Right := maxWidth-2;
      result.Bottom := (maxWidth * thumbnail.Height) div thumbnail.Width;
    end
    else
    begin
      result.Bottom := maxHeight-2;
      result.Right := (maxHeight * thumbnail.Width) div thumbnail.Height;
    end;
    end;
 
procedure TForm1.Button1Click(Sender: TObject);
var x,y:integer;
begin
  form1.Image2.Canvas.Pen.Color:=clred;
  form1.Image2.Canvas.Rectangle(form1.Image2.Canvas.ClipRect);
  rx:=GetImageWH(form1.Image1,form1.Image1.Width,form1.Image1.Height).Right div (CountX+1);
  ry:=GetImageWH(form1.Image1,form1.Image1.Width,form1.Image1.Height).Bottom div (CountY+1);
  DvigBit:=Tbitmap.Create;
  DvigBit.Width:=rx+1;
  DvigBit.Height:=ry+1;
  r:=GetImageWH(form1.Image1,form1.Image1.Width,form1.Image1.Height);
 
  MashtabX:=1;
  MashtabY:=1;
 
  ImMasCount:=0;
  Setlength(ImMas,ImMasCount);
  form1.Image2.Canvas.pen.Color:=clred;
  form1.Image2.Canvas.pen.Width:=1;
  for X:=0 to CountX do
  for y:=0 to CountY do begin
      ImMasCount:=ImMasCount+1;
      Setlength(ImMas,ImMasCount);
      ImMas[ImMasCount-1].x:=x;
      ImMas[ImMasCount-1].y:=y;
      ImMas[ImMasCount-1].Bit:=Tbitmap.Create;
      ImMas[ImMasCount-1].Bit.Width:=rx*MashtabX;
      ImMas[ImMasCount-1].Bit.height:=ry*MashtabY;
      ImMas[ImMasCount-1].Bit.canvas.CopyRect(rect(0,0,rx,ry),
      image1.Canvas,
      rect(rx*x*MashtabX,ry*y*MashtabY,(rx*x+rx)*MashtabX,(ry*y+ry)*MashtabY));
      form1.Image2.Canvas.Rectangle(rect(rx*x*MashtabX,ry*y*MashtabY,(rx*x+rx)*MashtabX,(ry*y+ry)*MashtabY));
      form1.Image2.Canvas.CopyRect(rect(rx*x*MashtabX+1,ry*y*MashtabY+1,(rx*x+rx)*MashtabX-1,(ry*y+ry)*MashtabY-1),ImMas[ImMasCount-1].Bit.canvas,rect(0,0,rx*MashtabX-1,ry*MashtabY-1));
  end;
 
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
CountX:=3;
CountY:=3;
   form1.Image1.Picture.LoadFromFile('din2.bmp');
   Button1Click(nil);
   Button3Click(nil);
end;
 
procedure TForm1.Button3Click(Sender: TObject);
label loop;
var i,x,y:integer;
 
begin
 
  for X:=0 to CountX do
  for y:=0 to CountY do begin
     form1.StringGrid1.Cells[x,y]:='-1';
  end;
 
  for I:=0 to ImMasCount-1 do begin
  loop:
    x:=random(CountX+1);
    y:=random(CountY+1);
    if form1.StringGrid1.Cells[x,y]='-1' then begin
    form1.StringGrid1.Cells[x,y]:=inttostr(i);
       ImMas[i].x:=x;
       ImMas[i].y:=y;
    end
    else goto loop;
    application.ProcessMessages;
  end;
 
 
for X:=0 to CountX do
  for y:=0 to CountY do begin
  for I:=0 to ImMasCount-1 do begin
      if ImMas[i].x=x then
      if ImMas[i].y=y then begin
      form1.Image2.Canvas.Rectangle(rect(rx*x*MashtabX,ry*y*MashtabY,(rx*x+rx)*MashtabX,(ry*y+ry)*MashtabY));
      form1.Image2.Canvas.CopyRect(rect(rx*x*MashtabX+1,ry*y*MashtabY+1,(rx*x+rx)*MashtabX-1,(ry*y+ry)*MashtabY-1),ImMas[i].Bit.canvas,rect(0,0,rx*MashtabX-1,ry*MashtabY-1));
      end;end;
  end;
  end;
procedure TForm1.Image2MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var
  t2,t:Trect;
begin
  if dvig then begin
 
    t:=rect(0,0,rx,ry);
    t2:=rect(cx,cy,cx+rx,cy+ry);
    form1.Image2.Canvas.CopyRect(t2,dvigbit.Canvas,t);
    cY:=y-ty;
    cx:=x-ty;
    t2:=rect(cx,cy,cx+rx,cy+ry);
    dvigBit.Canvas.CopyRect(t,form1.Image2.Canvas,t2);
    form1.Image2.Canvas.CopyRect(t2,ImMas[cI].Bit.Canvas,t);
  end;
 
 
   form1.StatusBar1.Panels[0].Text:='X = '+Inttostr(x)+' : '+'Y = '+Inttostr(y)+'  '+inttostr(x div rx)+':'+inttostr(y div ry);
 
end;
Function GetCI(cx,cy:integer):integer;
var i:integer;
begin
result:=-1;
  for i:=0 to ImMasCount-1 do
  if (ImMas[i].x=cx) and (ImMas[i].y=cy) then begin
    result:=i;
    exit;
  end;
end;
//Procedure Copy
 
procedure TForm1.Image2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var t,t2:Trect;
   i,Ym,Xm:integer;
begin
dvig:=false;
  i:=GetCI(x div rx,y div ry);
  if i>-1 then begin
  xm:=ImMas[i].x;
  ym:=ImMas[i].y;
  cx:=x;
  cY:=y;
  tx:=cx-xm*rx;
  ty:=cy-ym*ry;
  cY:=y-ty;
  cx:=x-ty;
    t:=rect(0,0,rx,ry);
    t2:=rect(cx,cy,cx+rx,cy+ry);
    dvigBit.Canvas.CopyRect(t,form1.Image2.Canvas,t2);
 //form1.Image3.Canvas.Draw(0,0,dvigBit);
    dvig:=true;
    cI:=i;
    end;
 
 
end;
 
procedure TForm1.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var t2,t:Trect;
  ci2:integer;
  TempX,TempY:integer;
begin
if dvig then begin
dvig:=false;
 
    t:=rect(0,0,rx,ry);
    t2:=rect(cx,cy,cx+rx,cy+ry);
    form1.Image2.Canvas.CopyRect(t2,dvigbit.Canvas,t);
 
 
    ci2:=GetCI(x div rx ,y div ry);
    if (ci2>-1) and (ci>-1) then begin
 
      TempX:=ImMas[ci].x;
      TempY:=ImMas[ci].y;
      ImMas[ci].x:=ImMas[ci2].x;
      ImMas[ci].y:=ImMas[ci2].y;
      ImMas[ci2].x:=TempX;
      ImMas[ci2].y:=TempY;
 
      cx:=ImMas[ci].x*rx;
      cy:=ImMas[ci].y*ry;
      t:=rect(0,0,rx,ry);
      t2:=rect(cx,cy,cx+rx,cy+ry);
      form1.Image2.Canvas.Rectangle(t2.Left-1,t2.top-1,t2.Right+1,t2.Bottom+1);
      form1.Image2.Canvas.CopyRect(t2,ImMas[cI].Bit.Canvas,t);
 
      cx:=ImMas[ci2].x*rx;
      cy:=ImMas[ci2].y*ry;
      t:=rect(0,0,rx,ry);
      t2:=rect(cx,cy,cx+rx,cy+ry);
      form1.Image2.Canvas.Rectangle(t2.Left-1,t2.top-1,t2.Right+1,t2.Bottom+1);
      form1.Image2.Canvas.CopyRect(t2,ImMas[cI2].Bit.Canvas,t);
    end;
      for X:=0 to CountX do
       for y:=0 to CountY do begin
         form1.StringGrid1.Cells[x,y]:=inttostr(GetCI(x,y));
      end;
 end;
 
 
end;
 
procedure TForm1.BNew(Sender: TObject);
begin
CountX:=3;
CountY:=3;
   form1.Image1.Picture.LoadFromFile('din1.bmp');
   Button1Click(nil);
   Showmessage('Дин1');
   Button3Click(nil);
 
end;
 
procedure TForm1.Button4Click(Sender: TObject);
begin
   form1.Image1.Picture.LoadFromFile('din2.bmp');
   Button1Click(nil);
   Showmessage('Дин 2 ');
   Button3Click(nil);
 
end;
 
procedure TForm1.Label2Click(Sender: TObject);
begin
   Shellapi.ShellExecute(application.Handle,'open','http://netsoftware.ucoz.ru/','','',5);
end;
 
end.
0
Вложения
Тип файла: zip din2.zip (881.3 Кб, 6 просмотров)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
29.09.2019, 13:25
Ответы с готовыми решениями:

Как сделать сохранение в игре?
Недавно я решился попробовать создать RPG игру на C++ поскольку с языком у меня особых проблем...

Как сделать сохранение результатов в игре ?
import java.io.IOException; public class game { public static void PrintField() { for...

Как сделать передвижение квадрата в Unity 2d Как сделать так что бы он двигался как в игре Read BAll 4
Помогите с передвижением квадрата в Unity 2d Как сделать так что бы он двигался как в игре Read...

Как сделать победу в игре?
Не знаю как сделать победу, суть игры мы ловим шарик когда его ловит один из игроков то выводиться...

1
D1973
29.09.2019, 15:11     Как сделать сохранение в игре пазлы
  #2

Не по теме:

RickBrun, Вы бы хоть ради приличия адрес сайта спрятали, откуда код содрали...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
29.09.2019, 15:11
Привет! Вот еще темы с ответами:

Как сделать Game over в игре
Здравствуйте, разрабатываю змейку через OpenGL на с++ и в принципе игра работает , но хотелось бы...

Как сделать очки в игре?
Добрый день. У меня есть простая игра сквош (скриншот выше), я уже час пытаюсь сделать такую фишку:...

Как сделать рейтинг в игре?
Есть игра "Найди элементы на картинке" есть две разных картинки,где нужно искать элементы. ...

Как сделать регистрацию в игре
Как сделать регистрацию в игре???


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
2
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.