Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Mausgesteuerte Graphic (https://www.delphipraxis.net/35342-mausgesteuerte-graphic.html)

biochip 5. Dez 2004 19:24


Mausgesteuerte Graphic
 
Hi,
Ich habe eine url in dem graphic mausgesteuert bewegt wird
http://www.pro.or.jp/~fuji/java/puzz.../4x6-fj-1.html
Javaapplet
In meinen Progrämmschen habe ich speicher fressend jedem Puzzelteil ein object geopfert.Und kann nur im gegensatz zum obigen Beispiel-URL Quadr. b.z.w
rechteckige Puzzleteile mit den Objecten(left,top,right,buttom) darstellen.

Kann mir einer ein einziges einfarbiges Puzzelteil das auf der ZeichenFläche Tcanvas
mit der Maus bewegt wird coden das eine L-förmig einfarbige Fläche haben kann wie in dem URL-Puzzel.



Delphi-Quellcode:
unit Schiebepuzzel;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, Grids;
type
  Tmyarray=array[0..9]of integer;
  Tpuzzel = class(Tpanel)
   private
    FRelPosX,FRelPosY, faltleft,falttop: Integer;

    public
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;X, Y: Integer); override;
    constructor Create(AOwner: TComponent); override;
   end;
  Tform1 = class(TForm)
    Label1: TLabel;
    NeuerVersuch: TButton;
    LoesungZeigen: TButton;
    beenden: TButton;
    Edit1: TEdit;
    Speichern: TButton;
    Higscore: TButton;
    Memo1: TMemo;
    Edit2: TEdit;
    Label2: TLabel;
    Label3: TLabel;
    StringGrid1: TStringGrid;
    verlauf: TButton;
    procedure FormCreate(Sender: TObject);
    procedure NeuerVersuchClick(Sender: TObject);
    procedure BeendenClick(Sender: TObject);
    procedure LoesungZeigenClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SpeichernClick(Sender: TObject);
    procedure HigscoreClick(Sender: TObject);
   private
    schritte:integer;

   public
     puzzel: Tpuzzel;
  end;
const klotznr:array[1..59]of byte=(5,4,1,2,3,4,1,6,7,8,9,5,4,1,6,7,8,9,5,9,8,5,4,1,3,2,7,6,4,6,7,4,5,6,7,5,3,2,5,4,3,2,4,2,3,6,7,1,4,5,2,3,6,7,1,4,9,8,1);
      LageLeftTop:array[1..59,1..2]of byte=((150,100),(100,100),(0,50),(0,0),(100,0),(150,50),(50,50),(0,50),(0,150),(50,150),(50,200),(150,200),(150,150)
      ,(100,50),(50,50),(0,50),(0,150),(0,200),(100,150),(100,200),(0,200),(0,150),(50,150),(100,100),(100,50),(100,0),(0,0),(50,0),
       (0,100),(50,100),(50,0),(0,0),(0,50),(0,100),(50,100),(50,0),(0,50),(100,50),(150,0),(100,0),
       (0,0),(0,50),(150,50),(50,50),(50,0),(0,0),(0,100),(50,100),(150,150),(150,100),(100,50),(100,0),(50,0),(0,0),(0,100),(100,100),(100,150),(100,200),(0,150));
       var
  form1: Tform1;puzzle:array [0..9]of tpuzzel;nummer:byte; breite,Hoehe,links,
  oben:Tmyarray;
implementation
{$R *.dfm}
 procedure Tform1.FormCreate(Sender: TObject);
  var i:byte;
  begin

   nummer:=0;schritte:=0;edit1.Text:='1000';
   for i:=1 to 9 do breite[i]:=100;
   for i:=4 to 7 do breite[i]:=breite[1] div 2;
   for i:=2 to 9 do hoehe[i]:=breite[1] div 2;
   for i:=6 to 7 do hoehe[i]:=breite[1]; hoehe[1]:=breite[1];
   for i:=2 to 3 do links[i]:=breite[1];
   for i:=8 to 9 do links[i]:=breite[1];
   links[1]:=0;links[4]:=0;links[6]:=0;links[5]:=breite[1] div 2;
   links[7]:=links[5];oben[1]:=0;
   for i:=2 to 3 do oben[i]:=(breite[1]div 2)*(i-2);
   for i:=4 to 5 do oben[i]:=breite[1];
   for i:=6 to 7 do oben[i]:=breite[1]+ breite[1]div 2;
   oben[8]:=oben[6];oben[9]:=oben[6]+ breite[1]div 2;
   for i:=1 to 9 do puzzle[i]:=Tpuzzel.Create(self);
  end;
procedure Tpuzzel.MouseDown(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  var z,s:byte;
  begin
   inherited MouseDown(Button, Shift, X, Y);
  FRelPosX := X;FRelPosY := Y;
   faltleft:=left;falttop:=top;
   for z :=round(int(top/50)+1)to round(int((top+height)/50)) do
       for s:=round(int(left/50))+1 to round(int((left+width)/50)) do
   form1.stringgrid1.cells[s-1,z-1]:='';//format('%d %d %d %d',[round(int(left/50))+1,round(int(top/50))+1,round(int((left+width)/50)),round(int((top+height)/50))]);

  end;

  procedure Tpuzzel.MouseMove(Shift: TShiftState;X, Y: Integer);
  var spiel:integer;
  begin
   inherited MouseMove(Shift, X, Y);

    if (ssLeft in Shift)and (left>=-10)and ( top+height <=260)and (left+width<=210) and (top>=-10) then
    begin
    SetBounds(Left+X-FRelPosX, Top+Y-FRelPosY,Width, Height);bringtofront;
    end;
  end;

  procedure Tpuzzel.MouseUp(Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  var rasterx,s,z:integer;noregel:boolean;
  begin
  inherited MouseUp(Button, Shift, X, Y);
   rasterx:=50;inc(form1.schritte);
   form1.Label1.caption:=inttostr(form1.schritte);
   left:=round(left/rasterx)*rasterx;top:=round(top /rasterx)*rasterx;
   //showmessage(format('%d %d %d %d',[round(int(left/50))+1,round(int(top/50))+1,round(int((left+width)/50)),round(int((top+height)/50))]));
     noregel:=false;
     for z :=round(int(top/50)+1)to round(int((top+height)/50)) do
     for s:=round(int(left/50))+1 to round(int((left+width)/50)) do
     if form1.stringgrid1.cells[s-1,z-1]<>'' then begin noregel:=true;end;
      if noregel =false then
     for z :=round(int(top/50)+1)to round(int((top+height)/50)) do
     for s:=round(int(left/50))+1 to round(int((left+width)/50)) do
     begin
     form1.stringgrid1.cells[s-1,z-1]:=format('%d %d %d %d',[round(int(left/50))+1,round(int(top/50))+1,
     round(int((left+width)/50)),round(int((top+height)/50))]);
     SetBounds(Left, Top,width, Height);bringtofront;
     end
     else
      begin
      for z :=round(int(Falttop/50)+1)to round(int((Falttop+height)/50)) do
      for s:=round(int(Faltleft/50))+1 to round(int((Faltleft+width)/50)) do
      form1.stringgrid1.cells[s-1,z-1]:=format('%d %d %d %d',[round(int(Faltleft/50))+1,round(int(Falttop/50))+1,
      round(int((Faltleft+width)/50)),round(int((Falttop+height)/50))]);
      SetBounds(FaltLeft, FaltTop,width, Height);bringtofront;
      end;
        if form1.stringgrid1.cells[0,4]='1 4 2 5' then
      showmessage('Du hasst es in '+inttostr(form1.schritte)+' Schritten'+' geschaft');

   end;
    constructor Tpuzzel.Create(AOwner: TComponent);
  begin
   inherited Create(AOwner);
   if nummer>=9 then nummer:=0;inc(nummer);tag:=nummer;
   caption:=inttostr(tag);width:=breite[tag];height:=hoehe[tag];
   left:=links[tag];top:=oben[tag];cursor:=CrhandPoint;bevelwidth:=4;
   repeat color:=random($FFFFFF);until color <> clblack;
   self.parent:=form1;
  end;



procedure Tform1.NeuerVersuchClick(Sender: TObject);
  var i,z,s:byte;
  begin
  schritte:=0;form1.Label1.caption:='0 ';
  for i:=1 to 9 do begin puzzle[i].Free;puzzle[i]:=Tpuzzel.Create(self);end;
    for z:=0 to 4 do for s:=0 to 3 do
  stringgrid1.cells[s,z]:='**';
  stringgrid1.cells[3,2]:='';stringgrid1.cells[2,2]:='';
  end;

procedure Tform1.BeendenClick(Sender: TObject);
var i:byte;
begin for i:=1 to 9 do
puzzle[i].Free;
close;
end;

procedure Tform1.LoesungZeigenClick(Sender: TObject);
var i:byte;
begin
neuerVersuchClick(Sender);
for i:=1 to 59 do
begin
puzzle[klotznr[i]].Left:=lageLeftTop[i,1];
puzzle[klotznr[i]].top:=lageLeftTop[i,2];
label1.Caption:=inttostr(i);
application.ProcessMessages;
sleep(strtoint(edit1.text));
end;
end;

procedure Tform1.FormActivate(Sender: TObject);
var skizze:trect;s,z:integer;
begin

  refresh;
  skizze:=rect(220,0,420,250);
  canvas.Brush.Color:=clwhite;
  canvas.FillRect(skizze);
  skizze:=rect(220,150,320,250);
  canvas.Brush.Color:=clred;
  canvas.FillRect(skizze);
  canvas.TextOut(270,200,'1');
  for z:=0 to 4 do for s:=0 to 3 do
  stringgrid1.cells[s,z]:='**';
  stringgrid1.cells[3,2]:='';stringgrid1.cells[2,2]:='';
 end;

procedure Tform1.SpeichernClick(Sender: TObject);
var f:textfile;
begin
Name:=edit2.text;
assignfile(f,'Higscore');
append(f);
writeln(f,Name,'  ',datetimetostr(now),'    ',Label1.caption);
closefile(f);
end;

procedure Tform1.HigscoreClick(Sender: TObject);
begin

Memo1.lines.LoadFromFile('Higscore');

//showmessage(memo1.Lines[memo1.Lines.count-1]);

end;

end.
[edit=MrSpock]Code tags korrigiert. Mfg, MrSpock[/edit]


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:35 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz