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

@RickBrun · Регистрация: 14.03.2015

Author24 — интернет-сервис помощи студентам

Delphi

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.

Вернуться к обсуждению:
Как сделать сохранение в игре пазлы Delphi

Следующий ответ

Другие темы раздела
Delphi В установленной Delphi 10.3 нет компонентов BDE, как их установить? В установленной программе Delphi 10.3 нет компонентов BDE как их установить? https://www.cyberforum.ru/ delphi-beginners/ thread2505776.html	Количество точек в квадрате. Delphi Здравствуйте! Нужно решить одно задание, никак не получается разобраться. Само задание: Вычислить количество точек графика функции (y=x+2), лежащих внутри квадрата с вершинами: (-a;0), (0;a), (a;0), (0;-a). Шаг задать с помощью q. На форуме уже задавали подобный вопрос, но графика указано не было, поэтому я решил "перезадать". Как мне кажется, у меня путаница с while, на выходе всегда...
Delphi Как установить в XE-4 компоненты CPortLib? https://www.cyberforum.ru/ delphi-beginners/ thread2505613.html Хотелось бы попробовать поработать с Com-портом не через WinApi, а через готовые бесплатные компоненты. Если можно, скиньте ссылку на гайд по установке компонентов сторонних производителей.	Delphi Как взять из файла данные Есть текстовый файл, который содержит информацию о людях. Фамилия, имя, отчество, город, адрес. Как можно взять их фамилию, имя, отчество и адрес? https://www.cyberforum.ru/ delphi-beginners/ thread2505572.html
Общий вес непустых папок Delphi Доброго времени суток! Знаю что подобных тем очень много, но никак не могу сделать более менее удобный/нормальный код для проверки общего веса определенных папок в локальной сети. Всё же кое какой инфы нарыл и вот что из этого вышло. var fso, K1,K2,K3,K4,K5,K6,K7,K8,K9,K10,K11,K12,K13: OleVariant; kk1,kk2,kk3,kk4,kk5,kk6,kk7,kk8,kk9,kk10,kk11,kk:integer; kks:string; begin if...	Delphi Быстрое комментирование кода в XE-4 Возможно ли быстрое комментирование блока кода в Delphi XE-4? Например, в C++Builder это <Ctrl + />. https://www.cyberforum.ru/ delphi-beginners/ thread2505498.html
Delphi Копируем картинку рабочего стола во временный Bitmap https://www.cyberforum.ru/ delphi-beginners/ thread2505439.html Всем здравствуйте. Непонятно назначение константы $40000000 в выражении: var bmp_tmp:Tbitmap; dc:HDC; BitBlt(bmp_tmp.Canvas.Handle,0,0,bmp_tmp.Width,bmp_tmp.Height, dc,0,0,SrcCopy or $40000000);	Delphi Ошибка Deburgger Exception Notification Произошла ошибка у меня в одном из Form-ов Указывает на форму №4 а что в ней так и не понимаю unit Unit4; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
Delphi RAD XE7 как выровнять строки в виде ячеек в memo? https://www.cyberforum.ru/ delphi-beginners/ thread2505361.html здравствуйте может кто знает как выровнять строки в виде ячеек в memo? вот добавил список карт строки после пробела стоять очень КРИВО не как не совподают другими строками =(	Delphi Шифр Железнодорожная изгородь https://www.cyberforum.ru/ delphi-beginners/ thread2505327.html у меня работает только для ключа два и три, подскажите как сделать и для других ключей step:= key + key -1; step:= round((step + key)/2); if (step mod 2 <> 0) then step:=step +1; a2: resul:=strinn; da:=i; while(a<len) do begin i:=i+step; if (i> len) then
Delphi Статический и динамический стек Помогите пожалуйста Нужно удалить каждый второй элемент стека Реализовать как статических, так и динамических структур данных	Delphi Передача содержимого из Edit-ов через интернет Доброго времени суток, господа программисты! Решил для удобства работы написать программу для своих коллег. Суть программы чтобы обмениваться списком водителей, чтобы знать кто на каком позывном сейчас работает. Сама программа находиться у нас в на сервере в облаке, поэтому обмен списком водителей я реализовал через считывания ini-файла. А теперь хочу реализовать чтобы список передавался не через... https://www.cyberforum.ru/ delphi-beginners/ thread2504820.html

	29.09.2019, 13:25