AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
• Registrieren
Zurück Delphi-PRAXiS Sprachen und Entwicklungsumgebungen Object-Pascal / Delphi-Language Tetris mit Canvas funktioniert nicht wie es soll
Thema durchsuchen
Ansicht
Themen-Optionen

Tetris mit Canvas funktioniert nicht wie es soll

Ein Thema von fox67 · begonnen am 13. Feb 2013 · letzter Beitrag vom 21. Mär 2013
Antwort Antwort
Seite 1 von 5  1 23     Letzte »    
fox67

Registriert seit: 6. Okt 2010
Ort: 72661 Grafenberg
181 Beiträge
 
Turbo Delphi für Win32
 
#1

Tetris mit Canvas funktioniert nicht wie es soll

  Alt 13. Feb 2013, 21:46
Delphi-Version: 5
zusammenfalten · markieren
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?
Angehängte Dateien
Dateityp: zip Tetris.zip (221,8 KB, 14x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von Bummi
Bummi

Registriert seit: 15. Jun 2010
Ort: Augsburg Bayern Süddeutschland
3.470 Beiträge
 
Delphi XE3 Enterprise
 
#2

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 00:18
markieren
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
Thomas Wassermann H₂♂
Das Problem steckt meistens zwischen den Ohren
DRY DRY KISS
H₂♂ (wenn bei meinen Snipplets nichts anderes angegeben ist Lizenz: WTFPL)
  Mit Zitat antworten Zitat
Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#3

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 01:00
Hab' mir den Code gründlich angeschaut. Zu dem Code gäbe es viel zu sagen. Hab' mal 'n bissel was gemacht.

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

zusammenfalten · markieren
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.
  Mit Zitat antworten Zitat
fox67

Registriert seit: 6. Okt 2010
Ort: 72661 Grafenberg
181 Beiträge
 
Turbo Delphi für Win32
 
#4

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 17:50
Hab' mir den Code gründlich angeschaut. Zu dem Code gäbe es viel zu sagen. Hab' mal 'n bissel was gemacht.

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

zusammenfalten · markieren
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 . 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. 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
Geändert von fox67 (14. Feb 2013 um 19:01 Uhr)
  Mit Zitat antworten Zitat
Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#5

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 18:23
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:

markieren
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
  Mit Zitat antworten Zitat
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.616 Beiträge
 
Delphi 12 Athens
 
#6

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 18:26
Wieso eigentlich TList und nicht TObjectList, wo es sich doch um Objekte handelt? Da könnte man sich die selbstgestrickte Speicherverwaltung sparen.
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
fox67

Registriert seit: 6. Okt 2010
Ort: 72661 Grafenberg
181 Beiträge
 
Turbo Delphi für Win32
 
#7

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 18:47
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:

markieren
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
  Mit Zitat antworten Zitat
fox67

Registriert seit: 6. Okt 2010
Ort: 72661 Grafenberg
181 Beiträge
 
Turbo Delphi für Win32
 
#8

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 19:00
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.
zusammenfalten · markieren
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;
  Mit Zitat antworten Zitat
Volker Z.

Registriert seit: 4. Dez 2012
Ort: Augsburg, Bayern, Süddeutschland
419 Beiträge
 
Delphi XE4 Ultimate
 
#9

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 19:30
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ß
Volker Zeller
  Mit Zitat antworten Zitat
Bjoerk

Registriert seit: 28. Feb 2011
Ort: Mannheim
1.384 Beiträge
 
Delphi 10.4 Sydney
 
#10

AW: Tetris mit Canvas funktioniert nicht wie es soll

  Alt 14. Feb 2013, 19:31
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
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 5  1 23     Letzte »    

« Vorheriges Thema | Nächstes Thema »

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus
Gehe zu:

• Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 01:37 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz