|
Delphi-Version: 5
Tetris mit Canvas funktioniert nicht wie es soll
Liste der Anhänge anzeigen (Anzahl: 1)
Delphi-Quellcode:
unit Unit2;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls; type TBlock = class; THaupt = class; TForm2 = class(TForm) Spielfeld: TImage; Button1: TButton; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } Haupt : THaupt; end; THaupt = class(TObject) Block : array of TBlock; Anzahl : integer; procedure Neu(); procedure Neufallen(); // procedure Drehen(); // procedure Prufen(); // procedure Entfernen(); private public end; TBlock = class(TObject) private fFarbe : TColor; fPosition : TPoint; public procedure zeichen; property Farbe : TColor read fFarbe write fFarbe; property Position : Tpoint read fPosition write fPosition; end; var Form2: TForm2; implementation {$R *.dfm} //Code Block procedure TBlock.zeichen; begin form2.Spielfeld.Canvas.Brush.Color := fFarbe; form2.Spielfeld.Canvas.Brush.Style := bssolid; form2.Spielfeld.Canvas.Rectangle(fPosition.X*24, fPosition.Y*24, fPosition.X*24+24, fPosition.Y*24+24 ); end; //Code Haupt procedure THaupt.Neu; var zufall : integer; begin form2.Timer1.Enabled := false; repeat zufall := random(5); until zufall <> 0 ; case zufall of 1: begin // Quadrat setlength(Block, high(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clred ; Block[high(Block)-3].fPosition.X:= 4 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clred ; Block[high(Block)-2].fPosition.X:= 5 ; Block[high(Block)-2].fPosition.Y:= -2 ; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clred ; Block[high(Block)-1].fPosition.X:= 4 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clred ; Block[high(Block)].fPosition.X:= 5 ; Block[high(Block)].fPosition.Y:= -1 ; showmessage('Quadrat'); form2.Timer1.Enabled := true; end; 2: begin // Winkelrechts setlength(Block, high(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clyellow ; Block[high(Block)-3].fPosition.X:= 4 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clyellow ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clyellow ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clyellow ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; showmessage('Winkel'); form2.Timer1.Enabled := true; end; 3: begin //Winkellinks setlength(Block, high(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clblue ; Block[high(Block)-3].fPosition.X:= 6 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clblue ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clblue ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clblue ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; showmessage('Winkel'); form2.Timer1.Enabled := true; end; 4: begin //T setlength(Block, high(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := cllime ; Block[high(Block)-3].fPosition.X:= 5 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := cllime ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := cllime ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := cllime ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; showmessage('T'); form2.Timer1.Enabled := true; end; 5: begin // Rechteck setlength(Block, high(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clpurple ; Block[high(Block)-3].fPosition.X:= 5 ; Block[high(Block)-3].fPosition.Y:= -4 ; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clpurple ; Block[high(Block)-2].fPosition.X:= 5 ; Block[high(Block)-2].fPosition.Y:= -3 ; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clpurple ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -2 ; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clpurple ; Block[high(Block)].fPosition.X:= 5 ; Block[high(Block)].fPosition.Y:= -1 ; showmessage('REchteck'); form2.Timer1.Enabled := true; end; end; end; procedure THaupt.Neufallen; var i :integer; begin Form2.Spielfeld.Canvas.Brush.Color := clwhite; Form2.Spielfeld.Canvas.Brush.Style := bssolid; Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height); Block[high(Block)-3].fPosition.Y := Block[high(Block)-3].fPosition.Y +1 ; Block[high(Block)-2].fPosition.Y := Block[high(Block)-2].fPosition.Y +1 ; Block[high(Block)-1].fPosition.Y := Block[high(Block)-1].fPosition.Y +1 ; Block[high(Block)].fPosition.Y := Block[high(Block)].fPosition.Y +1 ; for i := 0 to high(Block) do begin Block[i].zeichen; end; if Block[high(Block)].fPosition.Y = 27 then Neu; end; //Fenster procedure TForm2.Button1Click(Sender: TObject); begin Haupt.Neu(); end; procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); var i : integer; begin for i := 1 to high(Haupt.Block) do begin Haupt.Block[i].Free; end; Haupt.Free; end; procedure TForm2.FormCreate(Sender: TObject); begin Haupt := THaupt.Create; setlength(Haupt.Block, 1); end; procedure TForm2.Timer1Timer(Sender: TObject); begin Haupt.Neufallen(); end; end. Hallo, ich hab ja vor einiger Zeit mal nach Projektvorschlägen gefragt zum Zeitvertreib und um in Delphi einigermaßen fit zu bleiben. Da wurde mir oft geraten ein Spiel zu programmieren. Ich hab jetzt mal bekonnen ein Tetris spiel zu programmieren das Grundgerüßt steht auch schon allerdings ist auch das erste Problem aufgetaucht. Jedes mal wenn eine neue Figur fallen soll wird bei der vorherigen ein Stein abgezogen. Warum? Was hab ich falsch gemacht? |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Delphi-Quellcode:
In Deinem Code ändert sich die Arraylänge folgendermassen:
procedure TForm2.FormCreate(Sender: TObject);
begin Haupt := THaupt.Create; setlength(Haupt.Block, 0); end; // und setlength(Block, High(Block)+4); // ersetzen durch: setlength(Block, Length(Block)+4); 1 // setlength(Haupt.Block, 0); 4 // setlength(Block, High(Block)+4); High(Block) ist 0 weil bereits ein Element enthalten ist 7 // setlength(Block, High(Block)+4); High(Block) ist 3 10 // High(Block) ist 6 |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Hab' mir den Code gründlich angeschaut. Zu dem Code gäbe es viel zu sagen. Hab' mal 'n bissel was gemacht. :wink:
Auf die einzelnen Blöcke kannst du mit der property Block zugreifen und die X und Y property brauchst du später. Der Fehler tritt jetzt auch nicht mehr auf. Gruß Thomas
Delphi-Quellcode:
type
TBlock = class private FFarbe: TColor; FPosition: TPoint; FBitmap: TBitmap; function GetX: integer; function GetY: integer; procedure SetX(const Value: integer); procedure SetY(const Value: integer); public procedure Zeichen; property Farbe: TColor read FFarbe write FFarbe; property Position: TPoint read FPosition write FPosition; property X: integer read GetX write SetX; property Y: integer read GetY write SetY; constructor Create(Bitmap: TBitmap); end; THaupt = class(TList) private FBitmap: TBitmap; function GetBlock(Index: integer): TBlock; public function BlockAdd(Bitmap: TBitmap; Farbe: TColor; X, Y: integer): TBlock; procedure DelBlock(Index: integer); procedure ClearList; procedure ClearArea; procedure Neu; procedure Neufallen; // procedure Drehen; // procedure Prufen; // procedure Entfernen; destructor Destroy; override; property Block[Index: integer]: TBlock read GetBlock; default; property Bitmap: TBitmap read FBitmap write FBitmap; end; TForm2 = class(TForm) Spielfeld: TImage; Button1: TButton; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); private FHaupt: THaupt; FBitmap: TBitmap; end; var Form2: TForm2; implementation {$R *.dfm} { TBlock } constructor TBlock.Create(Bitmap: TBitmap); begin inherited Create; FBitmap := Bitmap; end; function TBlock.GetX: integer; begin Result := FPosition.X; end; function TBlock.GetY: integer; begin Result := FPosition.Y; end; procedure TBlock.SetX(const Value: integer); begin FPosition.X := Value; end; procedure TBlock.SetY(const Value: integer); begin FPosition.Y := Value; end; procedure TBlock.Zeichen; begin FBitmap.Canvas.Brush.Color := FFarbe; FBitmap.Canvas.Brush.Style := bsSolid; FBitmap.Canvas.Rectangle(FPosition.X * 24, FPosition.Y * 24, FPosition.X * 24 + 24, FPosition.Y * 24 + 24); end; { THaupt } function THaupt.GetBlock(Index: integer): TBlock; begin Result := Items[Index]; end; function THaupt.BlockAdd(Bitmap: TBitmap; Farbe: TColor; X, Y: integer): TBlock; begin Result := TBlock.Create(Bitmap); Result.Farbe := Farbe; Result.X := X; Result.Y := Y; Add(Result); end; procedure THaupt.DelBlock(Index: integer); begin TBlock(Items[Index]).Free; Delete(Index); end; procedure THaupt.ClearList; begin while Count > 0 do DelBlock(Count - 1); end; destructor THaupt.Destroy; begin ClearList; inherited Destroy; end; procedure THaupt.Neu; var Zufall: integer; begin Zufall := Random(5) + 1; case Zufall of 1: begin // Quadrat BlockAdd(FBitmap, clRed, 4, -2); BlockAdd(FBitmap, clRed, 5, -2); BlockAdd(FBitmap, clRed, 4, -1); BlockAdd(FBitmap, clRed, 5, -1); end; 2: begin // Winkelrechts BlockAdd(FBitmap, clYellow, 4, -2); BlockAdd(FBitmap, clYellow, 4, -1); BlockAdd(FBitmap, clYellow, 5, -1); BlockAdd(FBitmap, clYellow, 6, -1); end; 3: begin //Winkellinks BlockAdd(FBitmap, clBlue, 6, -2); BlockAdd(FBitmap, clBlue, 4, -1); BlockAdd(FBitmap, clBlue, 5, -1); BlockAdd(FBitmap, clBlue, 6, -1); end; 4: begin //T BlockAdd(FBitmap, clLime, 5, -2); BlockAdd(FBitmap, clLime, 4, -1); BlockAdd(FBitmap, clLime, 5, -1); BlockAdd(FBitmap, clLime, 6, -1); end; 5: begin // Rechteck BlockAdd(FBitmap, clPurple, 5, -4); BlockAdd(FBitmap, clPurple, 5, -3); BlockAdd(FBitmap, clPurple, 5, -2); BlockAdd(FBitmap, clPurple, 5, -1); end; end; end; procedure THaupt.ClearArea; begin FBitmap.Canvas.Brush.Color := clWhite; FBitmap.Canvas.Brush.Style := bsSolid; FBitmap.Canvas.Rectangle(0, 0, FBitmap.Width, FBitmap.Height); end; procedure THaupt.Neufallen; var I: integer; begin ClearArea; for I := 0 to Count - 1 do Block[I].Y := Block[I].Y + 1; for I := 0 to Count - 1 do Block[I].Zeichen; if 24 * Block[Count - 1].Y > FBitmap.Height div 2 then // Test Neu; end; { TForm2 } procedure TForm2.Button1Click(Sender: TObject); begin FHaupt.Neu; Timer1.Enabled := true; end; procedure TForm2.FormCreate(Sender: TObject); begin Randomize; DoubleBuffered := true; FBitmap := TBitmap.Create; FBitmap.Width := SPielfeld.Width; FBitmap.Height := SPielfeld.Height; FHaupt := THaupt.Create; FHaupt.Bitmap := FBitmap; end; procedure TForm2.FormDestroy(Sender: TObject); begin FBitmap.Free; FHaupt.Free; end; procedure TForm2.Timer1Timer(Sender: TObject); begin Timer1.Enabled := false; FHaupt.Neufallen; Spielfeld.Picture.Assign(FBitmap); Application.ProcessMessages; Timer1.Enabled := true; end; end. |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Zitat:
ich kann mir gut vorstellen das es bei jedem Delphiprogrammierer die Nackenhaareaufstellt wenn er meinen Code sieht :P. Das liegt hauptsälich daran, dass ich(bis jetzt) Delphi nie wirklich gelernt habe sonder alles mir selber beigbracht durch ausprobieren im Internet suchen oder hier im Forum gefragt hab. Aber immer nur das was ich gerade gebraucht hat. Das merkt man bestimm. :-D Deshalb nehme ich gerne Verbesserungsvorschläge an aber mit Erklärung, damit ich auch was lerne :). EDIT: Hab gemrkt das ihr beide Thomas heißen ich meine den unteren :) Gruß Arni |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Hallo Arni,
war gestern Abend zu müde noch für Erklärungen. Sorry. Es gibt eigentlich nur 2 Änderungen, a) aus dem Array ist eine TList geworden (weil einfacheres Hinzufügen und Löschen von Blöcken) b) THaut und die Blöcke haben ein Canvas spendiert bekommen, damit z.B. so was nicht mehr vorkommt:
Delphi-Quellcode:
Falls dir das zu kompliziert ist, vergiss es einfach. Vielleicht war ich auch einfach etwas übermotiviert. Nochmals Sorry.
procedure TBlock.zeichen;
begin form2.Spielfeld.Canvas.Brush.Color := fFarbe; form2.Spielfeld.Canvas.Brush.Style := bssolid; form2.Spielfeld.Canvas.Rectangle(fPosition.X*24, fPosition.Y*24, fPosition.X*24+24, fPosition.Y*24+24 ); end; Den Code kann ich dir allerdings empfehlen. Ist fehlerfrei und m.E auch vergleichsweise elegant. Deine Idee mit den Blöcken fand ich übrigens ziemlich gut. Hast du schon eine Idee, wie du auf Collusion mit andern Blöcken prüfst, also ob der Stein noch "rein-passt"? Gruß Thomas |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Wieso eigentlich TList und nicht TObjectList, wo es sich doch um Objekte handelt? Da könnte man sich die selbstgestrickte Speicherverwaltung sparen.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Zitat:
Gruß Arni |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Hallo,
Jetzt hab ich ein neues sehr seltsames Problem. Delphi erkenn die Pfeiltasten nicht als eingabe unter onkeydown? Keypreview habe ich auf true gestetzt. Die Leertast nimmt delphi allerdings als Eingabe sehr komisch ihn meinen anderen Programmen funktioniert das Problemlos.
Delphi-Quellcode:
procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState); begin showmessage('nimmt an'); // normalerweise müsste diese Meldung erscheinen //wenn man eine Taste drückt aber bei den //Pfeiltasten klappt es nicht. if key = VK_Down then begin Haupt.Drehen; end; end; |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Hallo,
Zitat:
Gruß |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Zitat:
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Zitat:
Gruß Arni |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Mach aus dem Button ein Speedbutton.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Danke :thumb:
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Hallo
Es ist wieder ein Problem erschienn aber diesmal liegt es an mir ich erkenne den Felher nicht
Delphi-Quellcode:
Die Blöcke fallen nicht sondern werden sofort neu erzeugt?
procedure THaupt.Neufallen;
var i :integer; kannbewegen : boolean; begin Form2.Spielfeld.Canvas.Brush.Color := clwhite; Form2.Spielfeld.Canvas.Brush.Style := bssolid; Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height); kannbewegen:= false; for i := 0 to high(Block) do begin if (i<>high(block)-3) and (i<>high(block)-2) and (i<>high(block)-1) and (i<>high(block)-0) then begin if not (Block[high(Block)-3].fPosition.y +1 = Block[i].fPosition.y) and (Block[high(Block)-3].fPosition.y +1 <>0) then begin if not (Block[high(Block)-2].fPosition.y +1 = Block[i].fPosition.y) and (Block[high(Block)-2].fPosition.y +1 <>0) then begin if not (Block[high(Block)-1].fPosition.y +1 = Block[i].fPosition.y) and (Block[high(Block)-1].fPosition.y +1 <>0) then begin if not (Block[high(Block)-0].fPosition.y +1 = Block[i].fPosition.y) and (Block[high(Block)-0].fPosition.y +1 <>0) then begin kannbewegen:= true; end; end; end; end; end; end; if kannbewegen then begin Block[high(Block)-3].fPosition.Y := Block[high(Block)-3].fPosition.Y +1 ; Block[high(Block)-2].fPosition.Y := Block[high(Block)-2].fPosition.Y +1 ; Block[high(Block)-1].fPosition.Y := Block[high(Block)-1].fPosition.Y +1 ; Block[high(Block)].fPosition.Y := Block[high(Block)].fPosition.Y +1 ; end; for i := 0 to high(Block) do begin Block[i].zeichen; end; if not kannbewegen then neu; |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Kumpel, du machst mich echt fertig. :)
Delphi-Quellcode:
Das ist sehr unsauber (und geht auch nur, weil TBlock in der selben unit steht). Spendier' TBlock mal eine property X und Y, wie ich‘s dir letztens gezeigt habe.
Block[high(Block) - 3].fPosition.Y
Deine Schleife wird so auch etwas lesbarer. Was soll die eigentlich machen? :gruebel:
Delphi-Quellcode:
n := high(Block);
for i := 0 to n do if (i <> n - 3) and (i <> n - 2) and (i <> n - 1) and (i <> n - 0) then if (Block[n - 3].y + 1 <> Block[i].y) and (Block[n - 3].y + 1 <> 0) then if (Block[n - 2].y + 1 <> Block[i].y) and (Block[n - 2].y + 1 <> 0) then if (Block[n - 1].y + 1 <> Block[i].y) and (Block[n - 1].y + 1 <> 0) then if (Block[n - 0].y + 1 <> Block[i].y) and (Block[n - 0].y + 1 <> 0) then kannbewegen := true; |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Achso. Verstehe. Probier' mal so (ungetestet):
Delphi-Quellcode:
function THaupt.CanMoveLast(const deltaX, deltaY: integer): boolean;
var N, I, J: integer; begin Result := true; N := High(Block); for I := 0 to N - 4 do for J := 0 to 3 do if (Block[N - J].X + deltaX = Block[I].X) and (Block[N - J].Y + deltaY = Block[I].Y) then Result := false; end; |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Zitat:
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Zitat:
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Liste der Anhänge anzeigen (Anzahl: 1)
Tja und leider auch wieder Probleme. Aber wieder ein Denkfehler beim drehen von winkelrechts.
Ich hab das spiel jetzt so um geschrieben das man zum testen nur die Nummer des jeweiligen steins eingeben muss damit es erscheint. Für die Verbessrungsvorschläge von Thommas hatte ich bis jetzt noch keine Zeit Winkelrechts = 3 |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Ja, das Drehen ist in der Tat nicht so einfach. Hierzu muß man erst mal wissen um welchen Punkt man drehen will. Was die Sache aber wieder vereinfacht, ist daß sin+/-90° eins bzw. minus eins ist Und Cos Null ist).
Als Drehpunkt bietet sich den Schwerpunkt der Figur an. Dieser ist Näherungsweise SummeXi/4, SummeYi/4. Dann verschiebt man das Koordinatensystem in diesen Punkt, dreht den Stein und verschiebt anschließend wieder zurück auf das Ursprungssytem. Ich hab jetzt keine Zeit mir deinen Code anzuschauen, sieh' mal meine Methoden GetCurrentCenterPoint und MoveCurrent:
Delphi-Quellcode:
unit uTetris;
interface uses SysUtils, Classes, Contnrs, Graphics, Dialogs, Types; type TFigurPoints = array[0..3] of TPoint; TFigurType = (ftO, ftJ, ftL, ftT, ftI, ftZ, ftS); TFigurMove = (fmMoveLeft, fmMoveRight, fmTurnRight, fmMoveDown); TToken = class private FColor: TColor; FX, FY: integer; public procedure Draw(Canvas: TCanvas; TokenSize: integer); property Color: TColor read FColor write FColor; property X: integer read FX write FX; property Y: integer read FY write FY; end; TTetris = class(TObjectList) private FBitmap: TBitmap; FColCount, FRowCount, FLevel, FScore, FTokenSize: integer; function GetToken(Index: integer): TToken; function TokenAdd(Color: TColor; X, Y: integer): TToken; function MoveCurrent(FigurMove: TFigurMove; Applying: boolean): boolean; function GetCurrentCenterPoint: TPoint; function CanMoveCurrent(const P: TFigurPoints): boolean; function CanSetCurrent(const P: TFigurPoints): boolean; function GetCurrent: TFigurPoints; procedure SetCurrent(const Value: TFigurPoints); procedure DelLine(Row: integer); property FToken[Index: integer]: TToken read GetToken; property FCurrent: TFigurPoints read GetCurrent write SetCurrent; public procedure AddNewCurrent; function CurrentMoveDown: boolean; function CurrentMoveLeft: boolean; function CurrentMoveRight: boolean; function CurrentTurnRight: boolean; procedure CurrentFallDown; procedure Draw; procedure DelLines; function GameOver: boolean; constructor Create; destructor Destroy; override; property Score: integer read FScore write FScore; property TokenSize: integer read FTokenSize write FTokenSize; property ColCount: integer read FColCount write FColCount; property RowCount: integer read FRowCount write FRowCount; property Level: integer read FLevel write FLevel; property Bitmap: TBitmap read FBitmap; end; implementation { TToken } procedure TToken.Draw(Canvas: TCanvas; TokenSize: integer); var X1, X2, X3, Y1, Y2, Y3: integer; begin X1 := FX * TokenSize; Y1 := FY * TokenSize; X2 := X1 + TokenSize; Y2 := Y1 + TokenSize; X3 := TokenSize div 4; Y3 := X3; Canvas.Brush.Color := FColor; Canvas.Pen.Color := clBlack; Canvas.RoundRect(X1, Y1, X2, Y2, X3, Y3); end; { TTetris } function TTetris.GetToken(Index: integer): TToken; begin Result := TToken(Items[Index]); end; function TTetris.GetCurrent: TFigurPoints; var J: integer; begin for J := 1 to 4 do begin Result[J - 1].X := FToken[Count - J].X; Result[J - 1].Y := FToken[Count - J].Y; end; end; procedure TTetris.SetCurrent(const Value: TFigurPoints); var J: integer; begin for J := 1 to 4 do begin FToken[Count - J].X := Value[J - 1].X; FToken[Count - J].Y := Value[J - 1].Y; end; end; procedure TTetris.AddNewCurrent; const FigurTypeCount = 7; clOrange = $000080FF; var Left: integer; FigurType: TFigurType; begin Left := Random(FColCount - 3); FigurType := TFigurType(Random(FigurTypeCount)); case FigurType of ftO: begin TokenAdd(clYellow, Left, 0); TokenAdd(clYellow, Left + 1, 0); TokenAdd(clYellow, Left, 1); TokenAdd(clYellow, Left + 1, 1); end; ftJ: begin TokenAdd(clBlue, Left + 1, 2); TokenAdd(clBlue, Left + 1, 1); TokenAdd(clBlue, Left + 1, 0); TokenAdd(clBlue, Left, 2); end; ftL: begin TokenAdd(clOrange, Left + 1, 2); TokenAdd(clOrange, Left + 1, 1); TokenAdd(clOrange, Left + 1, 0); TokenAdd(clOrange, Left + 2, 2); end; ftT: begin TokenAdd(clPurple, Left + 1, 1); TokenAdd(clPurple, Left, 0); TokenAdd(clPurple, Left + 1, 0); TokenAdd(clPurple, Left + 2, 0); end; ftI: begin TokenAdd(clAqua, Left, 0); TokenAdd(clAqua, Left, 1); TokenAdd(clAqua, Left, 2); TokenAdd(clAqua, Left, 3); end; ftZ: begin TokenAdd(clRed, Left + 1, 1); TokenAdd(clRed, Left + 2, 1); TokenAdd(clRed, Left + 1, 0); TokenAdd(clRed, Left, 0); end; ftS: begin TokenAdd(clGreen, Left, 1); TokenAdd(clGreen, Left + 1, 1); TokenAdd(clGreen, Left + 1, 0); TokenAdd(clGreen, Left + 2, 0); end; end; Draw; end; function TTetris.GetCurrentCenterPoint: TPoint; var J: integer; P: TFigurPoints; begin Result.X := 0; Result.Y := 0; P := FCurrent; for J := 0 to 3 do begin Result.X := Result.X + P[J].X; Result.Y := Result.Y + P[J].Y; end; Result.X := Round(Result.X / 4); Result.Y := Round(Result.Y / 4); end; function TTetris.CanMoveCurrent(const P: TFigurPoints): boolean; var I, J: integer; begin Result := true; for I := 0 to Count - 5 do for J := 0 to 3 do if (P[J].X = FToken[I].X) and (P[J].Y = FToken[I].Y) then Result := false; end; function TTetris.CanSetCurrent(const P: TFigurPoints): boolean; var J: integer; begin Result := true; for J := 0 to 3 do if (P[J].X < 0) or (P[J].X >= FColCount) or (P[J].Y < 0) or (P[J].Y >= FRowCount) then Result := false; Result := Result and CanMoveCurrent(P); end; function TTetris.MoveCurrent(FigurMove: TFigurMove; Applying: boolean): boolean; var J: integer; ACurrentCenterPoint: TPoint; ACurrent, ACurrentCenter: TFigurPoints; begin Result := false; ACurrent := FCurrent; case FigurMove of fmMoveLeft: for J := 0 to 3 do Dec(ACurrent[J].X); fmMoveRight: for J := 0 to 3 do Inc(ACurrent[J].X); fmMoveDown: for J := 0 to 3 do Inc(ACurrent[J].Y); fmTurnRight: begin ACurrentCenterPoint := GetCurrentCenterPoint; for J := 0 to 3 do begin ACurrentCenter[J].X := ACurrent[J].X - ACurrentCenterPoint.X; ACurrentCenter[J].Y := ACurrent[J].Y - ACurrentCenterPoint.Y; end; for J := 0 to 3 do begin ACurrent[J].X := -ACurrentCenter[J].Y + ACurrentCenterPoint.X; ACurrent[J].Y := ACurrentCenter[J].X + ACurrentCenterPoint.Y; end; end; end; if CanSetCurrent(ACurrent) then begin Result := true; if Applying then FCurrent := ACurrent; end; end; function TTetris.CurrentMoveDown: boolean; begin Result := MoveCurrent(fmMoveDown, true); end; function TTetris.CurrentMoveLeft: boolean; begin Result := MoveCurrent(fmMoveLeft, true); end; function TTetris.CurrentMoveRight: boolean; begin Result := MoveCurrent(fmMoveRight, true); end; function TTetris.CurrentTurnRight: boolean; begin Result := MoveCurrent(fmTurnRight, true); end; procedure TTetris.CurrentFallDown; begin while CurrentMoveDown do Inc(FScore); end; function TTetris.GameOver: boolean; begin Result := not MoveCurrent(fmMoveDown, false) and not MoveCurrent(fmMoveLeft, false) and not MoveCurrent(fmMoveRight, false) and not MoveCurrent(fmTurnRight, false); end; procedure TTetris.DelLine(Row: integer); var I: integer; begin for I := Count - 1 downto 0 do if FToken[I].Y = Row then Delete(I); for I := 0 to Count - 1 do if FToken[I].Y < Row then FToken[I].Y := FToken[I].Y + 1; end; procedure TTetris.DelLines; var Row, Col, I, N, Rows: integer; begin Row := FRowCount - 1; Rows := 0; while Row > 0 do begin N := 0; for Col := 0 to FColCount - 1 do for I := 0 to Count - 1 do if (FToken[I].X = Col) and (FToken[I].Y = Row) then Inc(N); if N = FColCount then begin DelLine(Row); Inc(Row); Inc(Rows); end; Dec(Row); end; case Rows of 1: Inc(FSCore, FLevel * 40); 2: Inc(FSCore, FLevel * 100); 3: Inc(FSCore, FLevel * 300); 4: Inc(FSCore, FLevel * 1200); end; end; procedure TTetris.Draw; var I: integer; begin FBitmap.Canvas.Brush.Color := clCream; FBitmap.Canvas.FillRect(Rect(0, 0, FBitmap.Width, FBitmap.Height)); FBitmap.Canvas.Pen.Color := clSilver; for I := 1 to FColCount do begin FBitmap.Canvas.MoveTo(I * FTokenSize, 0); FBitmap.Canvas.LineTo(I * FTokenSize, FRowCount * FTokenSize); end; for I := 1 to FRowCount do begin FBitmap.Canvas.MoveTo(0, I * FTokenSize); FBitmap.Canvas.LineTo(FColCount * FTokenSize, I * FTokenSize); end; for I := 0 to Count - 1 do FToken[I].Draw(FBitmap.Canvas, FTokenSize); end; function TTetris.TokenAdd(Color: TColor; X, Y: integer): TToken; begin Result := TToken.Create; Result.Color := Color; Result.X := X; Result.Y := Y; Add(Result); end; constructor TTetris.Create; begin inherited Create(true); FBitmap := TBitmap.Create; end; destructor TTetris.Destroy; begin FBitmap.Free; inherited Destroy; end; end. |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Delphi-Quellcode:
Delphi bleibt jedesmal stehen wenn es einen neuen Block erzeugen soll warum?
procedure THaupt.findelinie;
var i,j,k,max,anzahl : integer; temp : array[1..16] of integer; begin gfblock.Clear; max := 0; anzahl := 0; for i := 1 to high(Block) do begin if 27-Block[i].fPosition.Y > max then max := 27-Block[i].fPosition.Y ; gfblock.Add(inttostr(Block[i].fPosition.X)+','+inttostr(Block[i].fPosition.y)+','+colortostring(Block[i].ffarbe) ); end; for j := 0 to max do begin for i := 1 to high(Block) do begin if Block[i].fPosition.Y = j then begin anzahl:= anzahl+1; temp[anzahl] := i; end; if anzahl = 16 then begin gfblock.Move(temp[1],high(Block)-1); gfblock.Move(temp[2],high(Block)-2); gfblock.Move(temp[3],high(Block)-3); gfblock.Move(temp[4],high(Block)-4); gfblock.Move(temp[5],high(Block)-5); gfblock.Move(temp[6],high(Block)-6); gfblock.Move(temp[7],high(Block)-7); gfblock.Move(temp[8],high(Block)-8); gfblock.Move(temp[9],high(Block)-9); gfblock.Move(temp[10],high(Block)-10); gfblock.Move(temp[11],high(Block)-11); gfblock.Move(temp[12],high(Block)-12); gfblock.Move(temp[13],high(Block)-13); gfblock.Move(temp[14],high(Block)-14); gfblock.Move(temp[15],high(Block)-15); gfblock.Move(temp[16],high(Block)-16); gfblock.Delete(high(block)-1); gfblock.Delete(high(block)-2); gfblock.Delete(high(block)-3); gfblock.Delete(high(block)-4); gfblock.Delete(high(block)-5); gfblock.Delete(high(block)-6); gfblock.Delete(high(block)-7); gfblock.Delete(high(block)-8); gfblock.Delete(high(block)-9); gfblock.Delete(high(block)-10); gfblock.Delete(high(block)-11); gfblock.Delete(high(block)-12); gfblock.Delete(high(block)-13); gfblock.Delete(high(block)-14); gfblock.Delete(high(block)-15); gfblock.Delete(high(block)-16); arraykurzen; end else neu; end; end; end; procedure THaupt.arraykurzen; var sl : TStringlist; i : integer; x,y : integer; farbe : Tcolor; begin setlength(Block,0); sl := TStringlist.Create; for i := 0 to gfblock.Count- 1 do begin sl.CommaText := gfblock[i]; x := strtoint(sl[0]); y := strtoint(sl[1]); farbe := stringtocolor(sl[2]); setlength(Block, Length(Block)+1); Block[high(Block)].fPosition.X := x; Block[high(Block)].fPosition.X := y; Block[high(Block)].fFarbe := farbe; sl.Clear; end; findelinie; end; Thomas ich hab jetzt gemerkt warum eine Liste besser gewesen wäre als eine array :D |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Entschuldige bitte, aber durch das steigt doch kein Mensch (und Compiler wohl auch nicht) durch.
Eine vernünftige Strukturierung der Programmteile und Daten wäre dringend angebracht |
AW: Tetris mit Canvas funktioniert nicht wie es soll
In was soll ich es den Strukturiren die eine Procedure lädt erst die array in eine Stringlist dann wird nach einer reihe gesucht. Wenn gefunden dann werden die Positionen in der Stringlist getauscht so dass man sie anschließend einfach löschen kann. Dann löscht die zweite procedure das array und erzeugt es anschließend neu aus der stringlist.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Was soll denn um Gottes Willen die Stringlist?
Ich hab das Konzept ja von Dir und war damals so begeistert, daß ich es runter programmiert habe. Als ich mit dem Programm dann fertig war ist mir aufgefallen, daß wir es immer nur mir den letzen 4 Blöcken zu tun haben (in meinem Code das Current). Deshalb könnte man statt einer Liste von Blöcken auch einfach ein Spielfeld Array (Zeilen * Spaltenanzahl) mit der FarbInfo verwenden. Das wärs. Mehr braucht man nicht. 4 Blöcke und ein Array (of TColor). Mit dem Array kämst du wahrscheinlich auch sehr viel besser zurecht. |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Eine TStringlist ist für Strings, deshalb heißt sie ja so. Wenn man etwas anderes da hineinpackt, dann funktioniert das zwar evtl., ist aber trotzdem das falsche Mittel. Ich kann auch mit einer Wasserpumpenzange einen Nagel in die Wand schlagen, nichtsdestotrotz wäre ein Hammer eigentlich besser dafür geeignet. Übrigens baust Du Dir da hübsche Speicherlecks, da die Stringliste immer wieder neu erzeugt, aber niemals freigegeben wird.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Delphi-Quellcode:
hab das ganze jetzt geändert. Es tut sich leider aber immer noch nichts
unit Unit2;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons; type TBlock = class; THaupt = class; TForm2 = class(TForm) Spielfeld: TImage; Timer1: TTimer; Button1: TSpeedButton; Edit1: TEdit; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private { Private-Deklarationen } public { Public-Deklarationen } Haupt : THaupt; end; THaupt = class(TObject) Block : array of TBlock; Anzahl : integer; kannbewegen : boolean; IDs : Integer; procedure Neu(); procedure Neufallen(); procedure verschiebenlinks(); procedure verschiebenrechts(); procedure findelinie(); procedure arraykurzen(); procedure Drehen(); function CanMoveLast(const deltaX, deltaY: integer): boolean; // procedure Prufen(); // procedure Entfernen(); private public zufall: integer; gedreht : integer; temp : array[1..16] of Integer; end; TBlock = class(TObject) private fFarbe : TColor; fPosition : TPoint; fID : Integer; public procedure zeichen; property Farbe : TColor read fFarbe write fFarbe; property Position : Tpoint read fPosition write fPosition; end; var Form2: TForm2; implementation {$R *.dfm} //Code Block procedure TBlock.zeichen; begin form2.Spielfeld.Canvas.Brush.Color := fFarbe; form2.Spielfeld.Canvas.Brush.Style := bssolid; form2.Spielfeld.Canvas.Rectangle(fPosition.X*24, fPosition.Y*24, fPosition.X*24+24, fPosition.Y*24+24 ); end; //Code Haupt procedure THaupt.Neu; begin gedreht := 0; form2.Timer1.Enabled := false; if (form2.Edit1.text = '') then begin repeat zufall := random(5) +1; until (zufall <> 0) ; end else begin try zufall := strtoint(form2.Edit1.Text); except showmessage('keine Zahl'); repeat zufall := random(5) +1; until (zufall <> 0) ; end; end; case zufall of 1: begin // Quadrat IDs := IDs +4; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clred ; Block[high(Block)-3].fPosition.X:= 4 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-3].fID := IDS-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clred ; Block[high(Block)-2].fPosition.X:= 5 ; Block[high(Block)-2].fPosition.Y:= -2 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clred ; Block[high(Block)-1].fPosition.X:= 4 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clred ; Block[high(Block)].fPosition.X:= 5 ; Block[high(Block)].fPosition.Y:= -1 ; Block[high(Block)].fID := IDs; //showmessage('Quadrat'); form2.Timer1.Enabled := true; end; 2: begin // Winkellinks IDs := IDs +4 ; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clyellow ; Block[high(Block)-3].fPosition.X:= 4 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-3].fID := IDs-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clyellow ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clyellow ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clyellow ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; Block[high(Block)].fID := IDs; //showmessage('Winkel'); form2.Timer1.Enabled := true; end; 3: begin //Winkelrechts IDS := IDs +4; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clblue ; Block[high(Block)-3].fPosition.X:= 6 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-3].fID := IDs-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clblue ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clblue ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clblue ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; Block[high(Block)].fID := IDs; //showmessage('Winkel'); form2.Timer1.Enabled := true; end; 4: begin //T IDS := IDs +4; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := cllime ; Block[high(Block)-3].fPosition.X:= 5 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-3].fID := IDs-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := cllime ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := cllime ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := cllime ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; //showmessage('T'); form2.Timer1.Enabled := true; end; 5: begin // Rechteck IDs := IDs +4; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clpurple ; Block[high(Block)-3].fPosition.X:= 5 ; Block[high(Block)-3].fPosition.Y:= -4 ; Block[high(Block)-3].fID := IDs-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clpurple ; Block[high(Block)-2].fPosition.X:= 5 ; Block[high(Block)-2].fPosition.Y:= -3 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clpurple ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -2 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clpurple ; Block[high(Block)].fPosition.X:= 5 ; Block[high(Block)].fPosition.Y:= -1 ; Block[high(Block)].fID := IDs; //showmessage('REchteck'); form2.Timer1.Enabled := true; end; end; end; procedure THaupt.Neufallen; var i :integer; begin Form2.Spielfeld.Canvas.Brush.Color := clwhite; Form2.Spielfeld.Canvas.Brush.Style := bssolid; Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height); kannbewegen :=false; if CanMoveLast(0,1) then kannbewegen:= true; if kannbewegen then begin Block[high(Block)-3].fPosition.Y := Block[high(Block)-3].fPosition.Y +1 ; Block[high(Block)-2].fPosition.Y := Block[high(Block)-2].fPosition.Y +1 ; Block[high(Block)-1].fPosition.Y := Block[high(Block)-1].fPosition.Y +1 ; Block[high(Block)].fPosition.Y := Block[high(Block)].fPosition.Y +1 ; end; if (Block[high(Block)-3].fPosition.y = 27) or (Block[high(Block)-2].fposition.y = 27) or (Block[high(Block)-1].fposition.y = 27) or (Block[high(Block)-0].fposition.y = 27) then kannbewegen:= false; for i := 0 to high(Block) do begin Block[i].zeichen; end; if not kannbewegen then findelinie; end; procedure THaupt.Drehen; begin kannbewegen := false; case Zufall of 1: begin //passiert nichts end; 2: begin case gedreht of 0: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +0; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y+1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0 ; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 1; end; 1: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1 ; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y +1; gedreht := 2; end; 2 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y -0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y +1; gedreht := 3; end; 3 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2 ; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x +0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 0; end; end; end; 3: begin case gedreht of 0: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -0; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0 ; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 1; end; 1: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 2; end; 2 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x + 1 ; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 3; end; 3 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0 ; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 0; end; end; end; 4: begin case gedreht of 0: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -1; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 1; end; 1: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +1; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 2; end; 2 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +1; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x + 1 ; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 3; end; 3 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -1; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 0; end; end; end; 5: begin case gedreht of 0: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x-1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x+1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 1; end; 1: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y -0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 0; end; end; end; end; end; procedure THaupt.verschiebenlinks; var i : Integer; begin if (Block[high(Block)-3].fPosition.x = 0) or (Block[high(Block)-2].fPosition.x = 0) or (Block[high(Block)-1].fPosition.x = 0) or (Block[high(Block)-0].fPosition.x = 0) then begin end else begin if canmovelast(-1,0) then begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.X -1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.X -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.X -1; Block[high(Block)-0].fPosition.X:= Block[high(Block)-0].fPosition.X -1; Form2.Spielfeld.Canvas.Brush.Color := clwhite; Form2.Spielfeld.Canvas.Brush.Style := bssolid; Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height); for i := 0 to high(Block) do begin Block[i].zeichen; end; end; end; end; procedure Thaupt.verschiebenrechts; var i : Integer; begin if (Block[high(Block)-3].fPosition.x = 15) or (Block[high(Block)-2].fPosition.x = 15) or (Block[high(Block)-10].fPosition.x = 15) or (Block[high(Block)-0].fPosition.x = 15) then begin end else begin if canmovelast(1,0) then begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.X +1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.X +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.X +1; Block[high(Block)-0].fPosition.X:= Block[high(Block)-0].fPosition.X +1; Form2.Spielfeld.Canvas.Brush.Color := clwhite; Form2.Spielfeld.Canvas.Brush.Style := bssolid; Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height); for i := 0 to high(Block) do begin Block[i].zeichen; end; end; end; end; function THaupt.CanMoveLast(const deltaX, deltaY: integer): boolean; var N, I, J: integer; begin Result := true; N := High(Block); for I := 0 to N - 4 do for J := 0 to 3 do if (Block[N - J].fPosition.X + deltaX = Block[I].fPosition.X) and (Block[N - J].fPosition.y + deltaY = Block[I].fPosition.Y) then Result := false; end; procedure THaupt.findelinie; var i,j,k,max,anzahl : integer; begin max := 0; J := 0; for i := 1 to high(Block) do begin if 27-Block[i].fPosition.Y > max then max := 27-Block[i].fPosition.Y ; end; while (j < max) and (anzahl<>16) do begin anzahl := 1; for i := 1 to high(Block) do begin if Block[i].fPosition.Y = j+27 then begin temp[anzahl] := Block[i].fID; anzahl:=anzahl+1; if anzahl = 16 then begin arraykurzen end else begin neu(); end; end; end; end; end; procedure THaupt.arraykurzen; var i,j,x : integer; begin for i := 1 to high(Block) do begin for j := 1 to 16 do begin if block[i].fID = temp[j] then begin x := i+1; repeat Block[x-1].fPosition.X := Block[x].fPosition.x; Block[x-1].fPosition.X := Block[x].fPosition.y; Block[x-1].fFarbe := Block[x].fFarbe; Block[x-1].fID := Block[x].fID; x := x+1; setlength(Block, length(Block)-1); until (x = high(Block)) ; end; end; end; findelinie; end; //Fenster procedure TForm2.Button1Click(Sender: TObject); begin Haupt.Neu(); end; procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); var i : integer; begin for i := 1 to high(Haupt.Block) do begin Haupt.Block[i].Free; end; Haupt.Free; end; procedure TForm2.FormCreate(Sender: TObject); begin Haupt := THaupt.Create; setlength(Haupt.Block, 0); Haupt.IDs := 0; end; procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if key = VK_UP then Haupt.Drehen; if key = VK_left then Haupt.verschiebenlinks; if key = Vk_right then Haupt.verschiebenrechts; if key = vk_down then Haupt.Neufallen; end; procedure TForm2.Timer1Timer(Sender: TObject); begin Haupt.Neufallen(); end; end. |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Siehe #23, zumindest ich persönlich habe wenig Lust, mich durch den ganzen Code zu quälen. Wieso greift THaupt auf Form2.Canvas zu? Eine Canvas-Property wäre doch viel flexibler. Der ganze DRY-Code in den case-Abfragen könnte auch gekürzt werden, indem man eine Methode zum Ändern der Position etc. einführt und nur noch diese aufruft usw.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Auf form2.canvas wird nie zugegriffen. Nur auf form2.spielfeld.canvas
Spielfeld ist ein TImage |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Meinetwegen, aber das ändert ja nichts an der Tatsache, dass die THaupt-Klasse auf Form2 zugreift.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Warum denn nicht irgent wie muss doch auf das Formular gezeichnet werden
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Wie schon gesagt: spendiere THaupt eine Property vom Typ TCanvas, auf den diese dann zeichnet. Dann kannst Du Form2.ImageDings.Canvas oder FormBla.Canvas oder was weiß ich zuweisen und bist nicht an Form2 gebunden.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Zitat:
Kein schöner Gedanke. Eben, du kannst das selber, wenn man dir dazu alles an die Hand gibt. So ist das auch hier. |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Ja des mag sein aber mein Problem löst es leider nicht.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Arni, du machst es dir unnötig schwer. Wie findest du denn das Konzept von #25?
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Das hört sich zwar deutlich einfacher an aber dann müsste einen großteil neumachen
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Übung macht den Meister. Wenn du’s etwas geschickt machst: die GUI 200 Zeilen, die Komponente 300 Zeilen.
|
AW: Tetris mit Canvas funktioniert nicht wie es soll
Ja aber ich hab trotzdem weiter experimentiert.
Delphi-Quellcode:
Jetzt klappt das finden aber mit dem arraykürzen da gibt es immer eine EAces violation :(
unit Unit2;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, Buttons; type TBlock = class; THaupt = class; TForm2 = class(TForm) Spielfeld: TImage; Timer1: TTimer; Button1: TSpeedButton; Edit1: TEdit; Label1: TLabel; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Button1Click(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); private { Private-Deklarationen } public { Public-Deklarationen } Haupt : THaupt; end; THaupt = class(TObject) Block : array of TBlock; Anzahl : integer; kannbewegen : boolean; IDs : Integer; procedure Neu(); procedure Neufallen(); procedure verschiebenlinks(); procedure verschiebenrechts(); procedure findelinie(); procedure arraykurzen(); procedure Drehen(); function CanMoveLast(const deltaX, deltaY: integer): boolean; function findemax(): integer; // procedure Prufen(); // procedure Entfernen(); private public zufall: integer; gedreht : integer; temp : array[1..16] of Integer; end; TBlock = class(TObject) private fFarbe : TColor; fPosition : TPoint; fID : Integer; public procedure zeichen; property Farbe : TColor read fFarbe write fFarbe; property Position : Tpoint read fPosition write fPosition; end; var Form2: TForm2; implementation {$R *.dfm} //Code Block procedure TBlock.zeichen; begin form2.Spielfeld.Canvas.Brush.Color := fFarbe; form2.Spielfeld.Canvas.Brush.Style := bssolid; form2.Spielfeld.Canvas.Rectangle(fPosition.X*24, fPosition.Y*24, fPosition.X*24+24, fPosition.Y*24+24 ); end; //Code Haupt procedure THaupt.Neu; begin gedreht := 0; form2.Timer1.Enabled := false; if (form2.Edit1.text = '') then begin repeat zufall := random(5) +1; until (zufall <> 0) ; end else begin try zufall := strtoint(form2.Edit1.Text); except showmessage('keine Zahl'); repeat zufall := random(5) +1; until (zufall <> 0) ; end; end; findelinie(); case zufall of 1: begin // Quadrat IDs := IDs +4; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clred ; Block[high(Block)-3].fPosition.X:= 4 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-3].fID := IDS-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clred ; Block[high(Block)-2].fPosition.X:= 5 ; Block[high(Block)-2].fPosition.Y:= -2 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clred ; Block[high(Block)-1].fPosition.X:= 4 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clred ; Block[high(Block)].fPosition.X:= 5 ; Block[high(Block)].fPosition.Y:= -1 ; Block[high(Block)].fID := IDs; //showmessage('Quadrat'); form2.Timer1.Enabled := true; end; 2: begin // Winkellinks IDs := IDs +4 ; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clyellow ; Block[high(Block)-3].fPosition.X:= 4 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-3].fID := IDs-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clyellow ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clyellow ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clyellow ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; Block[high(Block)].fID := IDs; //showmessage('Winkel'); form2.Timer1.Enabled := true; end; 3: begin //Winkelrechts IDS := IDs +4; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clblue ; Block[high(Block)-3].fPosition.X:= 6 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-3].fID := IDs-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clblue ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clblue ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clblue ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; Block[high(Block)].fID := IDs; //showmessage('Winkel'); form2.Timer1.Enabled := true; end; 4: begin //T IDS := IDs +4; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := cllime ; Block[high(Block)-3].fPosition.X:= 5 ; Block[high(Block)-3].fPosition.Y:= -2 ; Block[high(Block)-3].fID := IDs-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := cllime ; Block[high(Block)-2].fPosition.X:= 4 ; Block[high(Block)-2].fPosition.Y:= -1 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := cllime ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -1 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := cllime ; Block[high(Block)].fPosition.X:= 6 ; Block[high(Block)].fPosition.Y:= -1 ; //showmessage('T'); form2.Timer1.Enabled := true; end; 5: begin // Rechteck IDs := IDs +4; setlength(Block, Length(Block)+4); Block[high(Block)-3] := TBlock.Create; Block[high(Block)-3].Farbe := clpurple ; Block[high(Block)-3].fPosition.X:= 5 ; Block[high(Block)-3].fPosition.Y:= -4 ; Block[high(Block)-3].fID := IDs-3; Block[high(Block)-2] := TBlock.Create; Block[high(Block)-2].Farbe := clpurple ; Block[high(Block)-2].fPosition.X:= 5 ; Block[high(Block)-2].fPosition.Y:= -3 ; Block[high(Block)-2].fID := IDs-2; Block[high(Block)-1] := TBlock.Create; Block[high(Block)-1].Farbe := clpurple ; Block[high(Block)-1].fPosition.X:= 5 ; Block[high(Block)-1].fPosition.Y:= -2 ; Block[high(Block)-1].fID := IDs-1; Block[high(Block)] := TBlock.Create; Block[high(Block)].Farbe := clpurple ; Block[high(Block)].fPosition.X:= 5 ; Block[high(Block)].fPosition.Y:= -1 ; Block[high(Block)].fID := IDs; //showmessage('REchteck'); form2.Timer1.Enabled := true; end; end; end; procedure THaupt.Neufallen; var i :integer; begin Form2.Spielfeld.Canvas.Brush.Color := clwhite; Form2.Spielfeld.Canvas.Brush.Style := bssolid; Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height); kannbewegen :=false; if CanMoveLast(0,1) then kannbewegen:= true; if kannbewegen then begin Block[high(Block)-3].fPosition.Y := Block[high(Block)-3].fPosition.Y +1 ; Block[high(Block)-2].fPosition.Y := Block[high(Block)-2].fPosition.Y +1 ; Block[high(Block)-1].fPosition.Y := Block[high(Block)-1].fPosition.Y +1 ; Block[high(Block)].fPosition.Y := Block[high(Block)].fPosition.Y +1 ; end; if (Block[high(Block)-3].fPosition.y = 27) or (Block[high(Block)-2].fposition.y = 27) or (Block[high(Block)-1].fposition.y = 27) or (Block[high(Block)-0].fposition.y = 27) then kannbewegen:= false; for i := 0 to high(Block) do begin Block[i].zeichen; end; if not kannbewegen then neu(); end; procedure THaupt.Drehen; begin kannbewegen := false; case Zufall of 1: begin //passiert nichts end; 2: begin case gedreht of 0: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +0; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y+1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0 ; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 1; end; 1: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1 ; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y +1; gedreht := 2; end; 2 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y -0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y +1; gedreht := 3; end; 3 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2 ; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x +0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 0; end; end; end; 3: begin case gedreht of 0: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -0; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0 ; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 1; end; 1: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 2; end; 2 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +0; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x + 1 ; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 3; end; 3 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -0 ; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 0; end; end; end; 4: begin case gedreht of 0: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -1; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x+1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x-1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 1; end; 1: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +1; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 2; end; 2 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +1; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x + 1 ; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 3; end; 3 : begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -1; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x -1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y +0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x +1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 0; end; end; end; 5: begin case gedreht of 0: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x -2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y +2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x-1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y - 0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x+1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y -1; gedreht := 1; end; 1: begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.x +2; Block[high(Block)-3].fPosition.Y:= Block[high(Block)-3].fPosition.Y -2; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.x +1; Block[high(Block)-2].fPosition.Y:= Block[high(Block)-2].fPosition.Y -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.x -0; Block[high(Block)-1].fPosition.Y:= Block[high(Block)-1].fPosition.Y -0; Block[high(Block)].fPosition.X:= Block[high(Block)].fPosition.x - 1; Block[high(Block)].fPosition.Y:= Block[high(Block)].fPosition.Y + 1; gedreht := 0; end; end; end; end; end; procedure THaupt.verschiebenlinks; var i : Integer; begin if (Block[high(Block)-3].fPosition.x = 0) or (Block[high(Block)-2].fPosition.x = 0) or (Block[high(Block)-1].fPosition.x = 0) or (Block[high(Block)-0].fPosition.x = 0) then begin end else begin if canmovelast(-1,0) then begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.X -1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.X -1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.X -1; Block[high(Block)-0].fPosition.X:= Block[high(Block)-0].fPosition.X -1; Form2.Spielfeld.Canvas.Brush.Color := clwhite; Form2.Spielfeld.Canvas.Brush.Style := bssolid; Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height); for i := 0 to high(Block) do begin Block[i].zeichen; end; end; end; end; procedure Thaupt.verschiebenrechts; var i : Integer; begin if (Block[high(Block)-3].fPosition.x = 15) or (Block[high(Block)-2].fPosition.x = 15) or (Block[high(Block)-10].fPosition.x = 15) or (Block[high(Block)-0].fPosition.x = 15) then begin end else begin if canmovelast(1,0) then begin Block[high(Block)-3].fPosition.X:= Block[high(Block)-3].fPosition.X +1; Block[high(Block)-2].fPosition.X:= Block[high(Block)-2].fPosition.X +1; Block[high(Block)-1].fPosition.X:= Block[high(Block)-1].fPosition.X +1; Block[high(Block)-0].fPosition.X:= Block[high(Block)-0].fPosition.X +1; Form2.Spielfeld.Canvas.Brush.Color := clwhite; Form2.Spielfeld.Canvas.Brush.Style := bssolid; Form2.Spielfeld.Canvas.Rectangle(0,0,form2.Spielfeld.Width, form2.Spielfeld.Height); for i := 0 to high(Block) do begin Block[i].zeichen; end; end; end; end; function THaupt.CanMoveLast(const deltaX, deltaY: integer): boolean; var N, I, J: integer; begin Result := true; N := High(Block); for I := 0 to N - 4 do for J := 0 to 3 do if (Block[N - J].fPosition.X + deltaX = Block[I].fPosition.X) and (Block[N - J].fPosition.y + deltaY = Block[I].fPosition.Y) then Result := false; end; function THaupt.findemax; var i,max :integer; begin max := 0; for i := 1 to high(Block) do begin if 27-Block[i].fPosition.Y > max then max := 27-Block[i].fPosition.Y; end; result :=max; end; procedure THaupt.findelinie; var i,j: integer; begin Anzahl := 0; showmessage(inttostr(findemax+1)); for j := 0 to findemax do begin anzahl:=0; for i := 1 to high(Block) do begin if Block[i].fPosition.Y = 27-J then begin Anzahl := Anzahl+1; temp[Anzahl] := Block[i].fID ; form2.Label1.Caption := inttostr(Anzahl)+' ,'+inttostr(j); if Anzahl = 16 then begin showmessage('endlich'); arraykurzen; end; end else begin end; end; end; end; procedure THaupt.arraykurzen; var i,j,x : integer; begin x:= 0; for j := 1 to 16 do begin for i := 1 to high(Block) do begin if block[i].fID = temp[j] then begin x := i+1; repeat try showmessage(inttostr(X)+' , '+ inttostr(high(Block ))); Block[x-1].fPosition.X := Block[x].fPosition.x; Block[x-1].fPosition.X := Block[x].fPosition.y; Block[x-1].fFarbe := Block[x].fFarbe; Block[x-1].fID := Block[x].fID; x := x+1; setlength(Block, length(Block)-1); except showmessage('hier') end; until (x+1 > length(Block)) ; end; end; end; // findelinie; end; //Fenster procedure TForm2.Button1Click(Sender: TObject); begin Haupt.Neu(); end; procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction); var i : integer; begin for i := 1 to high(Haupt.Block) do begin Haupt.Block[i].Free; end; Haupt.Free; end; procedure TForm2.FormCreate(Sender: TObject); begin Haupt := THaupt.Create; setlength(Haupt.Block, 0); Haupt.IDs := 0; end; procedure TForm2.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if key = VK_UP then Haupt.Drehen; if key = VK_left then Haupt.verschiebenlinks; if key = Vk_right then Haupt.verschiebenrechts; if key = vk_down then Haupt.Neufallen; end; procedure TForm2.Timer1Timer(Sender: TObject); begin Haupt.Neufallen(); end; end. |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Warum steigst du denn nicht (endlich) auf ne Liste um?
Mit dem Array zur Not halt so (ungetestet). Nach DeleteBlock darf nur ein gültiger Index übergeben werden, sonst knallt's.
Delphi-Quellcode:
TBlock = class
private FFarbe : TColor; FPosition : TPoint; FID : Integer; function GetX: integer; function GetY: integer; procedure SetX(const Value: integer); procedure SetY(const Value: integer); public property X: integer read GetX write SetX; property Y: integer read GetY write SetY; property Farbe: TColor read FFarbe write FFarbe; property Position: TPoint read FPosition write FPosition; property ID: integer read FID write FID; procedure Zeichnen; procedure Assign(const Value: TBlock); end; THaupt = class .. public procedure DeleteBlock(Index: integer); procedure Clear; end; function TBlock.GetX: integer; begin Result := FPosition.X; end; function TBlock.GetY: integer; begin Result := FPosition.Y; end; procedure TBlock.SetX(const Value: integer); begin FPosition.X := Value; end; procedure TBlock.SetY(const Value: integer); begin FPosition.Y := Value; end; procedure TBlock.Assign(const Value: TBlock); begin FFarbe := Value.Farbe; FPosition := Value.Position; FID := Value.ID; end; procedure THaupt.DeleteBlock(Index: integer); var I, N: integer; begin N := Length(Block); for I := Index to N - 2 do Block[I].Assign(Block[I + 1]); Block[N - 1].Free; SetLength(Block, N - 1); end; procedure THaupt.Clear; // in FormDestroy aufrufen begin while Length(Block) > 0 do DeleteBlock(Length(Block) - 1); end; |
AW: Tetris mit Canvas funktioniert nicht wie es soll
Das mit dem array funktioniert nicht so recht. Jetzt habe ich das mal mit einer TObjectlist probiert. Eigentlich sollte ich den ganzen code nochmal neuschreiben oder zumindest anpassen aber da ich mir nicht sicher bin ob des so klappt probiere ich es erst mal so.
Delphi-Quellcode:
Das funktioniert nur leider nicht es löscht jedesmal etwas aber nicht das was es soll.
procedure THaupt.findelinie;
var x,x2 : TObjectlist; i,j,tmp : integer; test : TBlock; weiter,start : Boolean; begin x := Tobjectlist.Create; x2 := Tobjectlist.create; weiter := true; start := false; for i := 1 to high(Block) do begin x.Add(Block[i]); end; for j := 1 to 27 do begin if weiter then // damit nicht schon die nächste // unterrsucht wird bevor die davor // gelöscht wird begin x2.clear; x2:= Tobjectlist.Create; for i := 0 to x.Count-1 do begin test := TBlock(x.Items[i]) ; if test.fPosition.Y = j then begin showmessage(inttostr(j)); x2.Add(x.items[i]); if x2.Count+1 = 16 then begin weiter := false; start := true; end; end; end; end; end; if start then begin for i := 0 to x2.Count - 1 do begin tmp := x.IndexOf(x2.Items[i]); x.Delete(tmp); end; setlength(Block,x.Count+1); for i := 1 to x.Count do begin Block[i] := TBlock(x.Items[i-1]); end; weiter := true; start := false; x.Free; end; end; |
| Alle Zeitangaben in WEZ +1. Es ist jetzt 15:33 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz
