|
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:
|
| Alle Zeitangaben in WEZ +1. Es ist jetzt 09:15 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 by Thomas Breitkreuz