|
Registriert seit: 10. Mai 2004 Ort: Hartha 9 Beiträge Delphi 6 Personal |
#1
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:
[edit=MrSpock]Code tags korrigiert. Mfg, MrSpock[/edit]
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. |
Zitat |
Ansicht |
Linear-Darstellung |
Zur Hybrid-Darstellung wechseln |
Zur Baum-Darstellung wechseln |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
LinkBack URL |
About LinkBacks |