Delphi-PRAXiS
Seite 1 von 5  1 23     Letzte »    

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Tetris mit Canvas funktioniert nicht wie es soll (https://www.delphipraxis.net/173237-tetris-mit-canvas-funktioniert-nicht-wie-es-soll.html)

fox67 13. Feb 2013 20:46

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?

Bummi 13. Feb 2013 23:18

AW: Tetris mit Canvas funktioniert nicht wie es soll
 
Delphi-Quellcode:
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);
In Deinem Code ändert sich die Arraylänge folgendermassen:

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

Bjoerk 14. Feb 2013 00:00

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.

fox67 14. Feb 2013 16:50

AW: Tetris mit Canvas funktioniert nicht wie es soll
 
Zitat:

Zitat von Bjoerk (Beitrag 1203406)
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.

Hi Thomas,
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

Bjoerk 14. Feb 2013 17:23

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:
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;
Falls dir das zu kompliziert ist, vergiss es einfach. Vielleicht war ich auch einfach etwas übermotiviert. Nochmals Sorry.

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

DeddyH 14. Feb 2013 17:26

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.

fox67 14. Feb 2013 17:47

AW: Tetris mit Canvas funktioniert nicht wie es soll
 
Zitat:

Zitat von Bjoerk (Beitrag 1203571)
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:
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;
Falls dir das zu kompliziert ist, vergiss es einfach. Vielleicht war ich auch einfach etwas übermotiviert. Nochmals Sorry.

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

Ja ich werde bei jedem Stein überprüfen ob unter ihm keiner ist und erst dann die Position um eins nach unten ändern.

Gruß Arni

fox67 14. Feb 2013 18:00

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;

Volker Z. 14. Feb 2013 18:30

AW: Tetris mit Canvas funktioniert nicht wie es soll
 
Hallo,

Zitat:

Delphi erkenn die Pfeiltasten nicht als eingabe unter onkeydown? Keypreview habe ich auf true gestetzt.
Du hast ein TButton auf Deinem Formular. Der macht Dir einen Strich durch die Rechnung. Die Pfeiltasten werden vom Button verarbeitet und nicht mehr ans Form durchgereicht.

Gruß

Bjoerk 14. Feb 2013 18:31

AW: Tetris mit Canvas funktioniert nicht wie es soll
 
Zitat:

Zitat von DeddyH (Beitrag 1203572)
Wieso eigentlich TList und nicht TObjectList, wo es sich doch um Objekte handelt? Da könnte man sich die selbstgestrickte Speicherverwaltung sparen.

Eigentlich Ja. Und noch eigentlicher ein Paradebeispiel für eine Basisklasse mit abstrakten Methoden, wo gleich der ganze Stein erfasst wird. BTW, was du selbstgestrickte Speicherverwaltung nennst macht TObjectList aber auch so: TObject(Items[Index]).Free


Alle Zeitangaben in WEZ +1. Es ist jetzt 05:06 Uhr.
Seite 1 von 5  1 23     Letzte »    

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