Linien neuzeichnen

PascalHST · Beitrag von **PascalHST** » Do 5. Jun 2014, 17:14

Hallo, ich habe das Spiel "Pong" programmiert.
Bin nun soweit, dass ich ein "Spielfeld gezeichnet habe, eine Art Netz aus gestrichelten Linien in der Mittel des Spielfeldes.

Nun habe ich das Problem, dass wenn jemand ein Punkt macht, das Netz einfach verschwindet und nicht erhalten bleibt, vielleicht kann jemand mal über den Code drüberschauen und eventuell den Fehler finden.
Die Prozedure dafür lautet "DrawCourt"

Code: Alles auswählen

unit FMain;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    tmrMoveBall: TTimer;
    procedure FormCreate           (Sender: TObject);                                      {Gestaltung}
    procedure FormDestroy          (Sender: TObject);
    procedure FormKeyPress         (Sender: TObject; var Key: char);                     {Steuerung}
    procedure tmrMoveBallTimer     (Sender: TObject);                                {KI (Bewegung) des Balls}
  private
    FBallX                     : integer;                                       //F = Form / integer = Reelle zahl folgt
    FBallY                     : integer;
    FDirection                 : integer;
    FSpeed                     : integer;
    FBatRightY                 : integer;
    FBatLeftY                  : integer;
    FScreenCenterX             : integer;
    FScreenCenterY             : integer;
    FBatRightX                 : integer;
    FBatLeftX                  : integer;
    FBatY                      : integer;
    FScoreLeft                 : integer;
    FScoreRight                : integer;
    FSavedBackground           : TbitMap;
 
    procedure DrawBall          (const AXNew, AYNew: integer);
    procedure DrawBatLeft       (const AYNew: integer);
    procedure DrawBatRight      (const AYNew: integer);
    procedure BounceBallonXAxis;
    procedure BounceBallonYAxis;
    procedure StartGame;
    procedure Serve;
    procedure DisplayScore;
    procedure AnnounceWinner;
    procedure DrawCourt;
    procedure RestoreBackground (const AX, AY: integer);
    procedure SaveBackground    (const AX, AY: integer);
    procedure PlaySoundBounce;
    procedure PlaySoundMissLeft;
    procedure PlaySoundMissRight;
    procedure playsoundpingpong;
 
 
 
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
uses
  LCLType, MMSystem;
 
{$R *.lfm}
 
{ TForm1 }
 
const
  CHoehe                 = 600;                                                 //C=Constante - Name frei wählbar
  CBreite                = 1024;
 
  CBallGeschwindigkeit   = 40;
  CServedAngel           = 15;
 
  CSchlaegerHoehe        = 80;
  CBallGroesse           = 15;
 
  CMaxPunktzahl          = 10;
 
 
procedure TForm1.FormCreate(Sender: TObject);                                    {Gestaltung/Formen}
begin
  Color                 := clWhite;
  Height                := CHoehe;
  Width                 := CBreite;
  Position              := poScreenCenter;
  BorderStyle           := bsNone;
 
  FBallX                := 0;
  FBallY                := 0;
  FDirection            := CServedAngel;
  FSpeed                := CBallGeschwindigkeit;
 
  FScreenCenterX        := ClientWidth div 2;
  FScreenCenterY        := ClientHeight div 2;
  FBatRightX            := ClientWidth - 30 - CBallGroesse;
  FBatLeftX             := 30;
  FBatY                 := 300;
 
  FSavedBackground:= TBitMap.Create;
  FSavedBackground.SetSize(CBallGroesse, CBallGroesse);
 
 
  end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
  FSavedBackground.Free;
end;
 
procedure TForm1.FormKeyPress (Sender: TObject; var Key: char);                  {Steuerung}
begin
     if Ord(Key) = VK_ESCAPE  then                                               //ESC - Schließen
        Close;
     if Ord(Key) = VK_SPACE then                                                 //SPACE - Procedure "Start Game"
        StartGame;
     if Key in ['k', 'K'] then                                                   //Steuerung - Verschiebung Schläger in "Y +/-"
        DrawBatRight(FBatRightY + 20);
     if Key in ['i', 'I'] then
        DrawBatRight(FBatRightY - 20);
     if Key in ['s', 'S'] then
        DrawBatLeft(FBatLeftY + 20);
     if Key in ['w', 'W'] then
        DrawBatLeft(FBatLeftY - 20);
  end;
 
procedure TForm1.tmrMoveBallTimer(Sender: TObject);                             {Selbstbewegung
                                                                                des Balles durch Timer/
                                                                                Richtungsänderung}
var
     LXChange               : integer;
     LYCHange               : integer;
begin
 
 
     LXChange:= trunc(cos(Pi / 180 * FDirection) * FSpeed);
     LYChange:= trunc(sin(Pi / 180 * FDirection) * FSpeed);
 
 
     DrawBall(FBallX + LXChange, FBallY + LYChange);
 
     if (FBallX <= 0) then
     begin
          PlaySoundMissLeft;
          inc(FScoreRight);
          Serve;
      end
      else if (FBallX >= ClientWidth - CBallGroesse) then
      begin
           PlaySoundMissRight;
           inc(FScoreLeft);
           Serve;
      end
      else if (FBallY <= 0) or (FBallY >= ClientHeight - CBallGroesse)
          then
              BounceBallonYAxis
      else if (FBallX + CBallGroesse>= FBatRightX)              and                 {Bounce Schläger}
              (FBallY >= FBatRightY)                         and
              (FBallY + CBallGroesse<= FBatRightY + CSchlaegerHoehe)
          then
              BounceBallonXAxis
      else if (FBallX<= FBatLeftX + CBallGroesse)               and
              (FBallY >= FBatLeftY)                          and
              (FBallY + CBallGroesse<= FBatLeftY + CSchlaegerHoehe)
           then
               BounceBallonXAxis
 
      end;
 
procedure TForm1.DrawBall(const AXNew, AYNew: integer);                         {Ball/Größe}
begin
     RestoreBackground(FBallX, FBallY);
     SaveBackground(AXNew, AYNew);
     Canvas.Brush.Color         := ClBlack;
     Canvas.Pen.Style           := psClear;
     Canvas.Rectangle(AXNew, AYNew, AXNew + CBallGroesse, AYNew + CBallGroesse);
     FBallX                     := AXNew;
     FBallY                     := AYNew;
     end;
 
procedure TForm1.DrawBatLeft(const AYNew: integer);
begin
     if (AYNew <= 0) or (AYNew + CSchlaegerHoehe >= ClientHeight) then
        Exit;
     Canvas.Pen.Style            := psClear;
     Canvas.Brush.Color          := ClWhite;
     Canvas.Rectangle(FBatLeftX, FBatLeftY, FBatLeftX + CBallGroesse, FBatLeftY + CSchlaegerHoehe);
     Canvas.Brush.Color          := ClBlack;
     Canvas.Rectangle(FBatLeftX, AYNew, FBatLeftX + CBallGroesse, AYNew + CSchlaegerHoehe);
     FBatLeftY                   := AYNew;
     end;
 
procedure TForm1.DrawBatRight (const AYNew: integer);                           {Rechter Schläger}
begin
     if (AYNew <= 0) or (AYNew + CSchlaegerHoehe >= ClientHeight) then
        Exit;
     Canvas.Pen.Style             := psClear;
     Canvas.Brush.Color           := ClWhite;
     Canvas.Rectangle(FBatRightX, FBatRightY, FBatRightX + CBallGroesse, FBatRightY + CSchlaegerHoehe);
     Canvas.Brush.Color           := ClBlack;
     Canvas.Rectangle(FBatRightX, AYNew, FBatRightX + CBallGroesse, AYNew + CSchlaegerHoehe);
     FBatRightY                   := AYNew;
     end;
 
procedure TForm1.BounceBallonXAxis;                                             {Bounce X-Achse}
begin
     FDirection:= FDirection + (90 - FDirection) * 2;
     PlaySoundBounce;
     end;
 
procedure TForm1.BounceBallonYAxis;                                             {Bounce Y-Achse}
begin
     FDirection:= FDirection + (180 - FDirection) * 2 ;
     PlaySoundBounce;
     end;
 
procedure TForm1.StartGame;
begin
      FScoreLeft           := 0;
      FScoreRight          := 0;
      Serve;
      end;
 
procedure TForm1.Serve;
begin
      tmrMoveBall.Enabled   := false;
      DrawCourt;
      DisplayScore;
      //Wenn jemand gewonnen hat, dann..
      if (FScoreLeft >=10) or (FScoreRight >=10) then
         AnnounceWinner
      //Ansonsten weiterspielen
      else begin
          DrawBall(FScreenCenterX, FScreenCenterY);
          DisplayScore;
          Sleep(1000);
          tmrMoveBall.Enabled:= True;
          end;
      end;
 
procedure TForm1.DisplayScore;
var
LScore: string;
LX: integer;
 
begin
     Canvas.Font.Name         := 'Courier New';
     Canvas.Font.Size         := 32;
     Canvas.Font.Style        := [fsBold];
     Canvas.Font.Color        := clBlack;
     Canvas.Brush.Color       := clWhite;
     LScore                   := IntToStr(FScoreLeft);
     LX                       := FScreenCenterX - 50 - Canvas.TextWidth(LScore);
     Canvas.Textout(LX, 30, LScore);
     Canvas.Textout(FScreenCenterX + 50,30, IntToStr(FScoreRight));
     DrawBatRight(FScreenCenterY);
     DrawBatLeft(FScreenCenterY);
     end;
 
procedure TForm1.AnnounceWinner;
 
  var
    LX: integer;
  const
    CGewinnerText               = 'Win';
    begin
      playsoundpingpong;
      Canvas.Font.Name          := 'Courier New';
      Canvas.Font.Size          := 32;
      Canvas.Font.Style         := [fsBold];
      Canvas.Font.Color         := clBlack;
      Canvas.Brush.Color        := clWhite;
      if FScoreRight <= CMaxPunktzahl then
         LX:= FScreenCenterX + 50
      else
          LX:= FScreenCenterX - 50 - Canvas.TextWidth(CGewinnerText);
          Canvas.TextOut(LX, 100, CGewinnerText);
 
    end;
 
procedure TForm1.PlaySoundBounce;                                                {Sounds}
begin
     PlaySound('bounce.wav', 0, SND_ASYNC);
     end;
 
procedure TForm1.PlaySoundMissLeft;
begin
     PlaySound('miss-left.wav', 0, SND_ASYNC);
     end;
 
procedure TForm1.PlaySoundMissRight;
begin
     PlaySound('miss-right.wav', 0, SND_ASYNC);
     end;
 
procedure TForm1.playsoundpingpong;
begin
     PlaySound('ping-pong.wav', 0, SND_ASYNC);
     end;
 
procedure TForm1.DrawCourt;
var
  LY: integer;
begin
  Canvas.Brush.Color:=clWhite;
  Canvas.Rectangle(
  0, 0, ClientWidth, ClientHeight);
  Canvas.Pen.Color:= clBlack;
  LY:= 0;
  while LY <= ClientHeight do
  begin
  Canvas.Line(
    FScreenCenterX,
    LY,
    FScreenCenterX,
    LY + 20);
  Inc(LY, 40);
  end;
  Canvas.Pen.Color:=clBlack;
  end;
 
procedure TForm1.RestoreBackground(const AX, AY: integer);
begin
  Canvas.Draw(AX, AY, FSavedBackground);
end;
 
procedure TForm1.SaveBackground(const AX, AY: integer);
begin
  FSavedBackground.Canvas.CopyRect(
    Rect(0, 0, CBallGroesse, CBallGroesse),
    Canvas,
    Rect(AX, AY, AX + CBallGroesse, AY + CBallGroesse));
end;
 
 
end.

theo · Beitrag von **theo** » Do 5. Jun 2014, 19:41

Auf den Form.Canvas zeichnet man nur im OnPaint Event.
Der From Canvas puffert nicht.

PascalHST · Beitrag von **PascalHST** » Do 5. Jun 2014, 19:48

theo hat geschrieben:Auf den Form.Canvas zeichnet man nur im OnPaint Event.
Der From Canvas puffert nicht.

Kannst du mir bitte den Code umschreiben?
Bin Anfänger..

Mathias · Beitrag von **Mathias** » Do 5. Jun 2014, 20:04

Anstelle in den Form-Canvas zu schreiben, würde ich eine TImages nehmen und in desen Canvas schreiben.
Der TImages puffert die Daten.

PascalHST · Beitrag von **PascalHST** » Do 5. Jun 2014, 20:08

Mathias hat geschrieben:Anstelle in den Form-Canvas zu schreiben, würde ich eine TImages nehmen und in desen Canvas schreiben.
Der TImages puffert die Daten.

Schick mal bitte den Code...

theo · Beitrag von **theo** » Do 5. Jun 2014, 22:05

PascalHST hat geschrieben: Kannst du mir bitte den Code umschreiben?
Bin Anfänger..

Ja klar...

Dodo · Beitrag von **Dodo** » Mi 11. Jun 2014, 14:49

PascalHST hat geschrieben:
Mathias hat geschrieben:Anstelle in den Form-Canvas zu schreiben, würde ich eine TImages nehmen und in desen Canvas schreiben.
Der TImages puffert die Daten.
Schick mal bitte den Code...

Nanana, learning by doing ist als Anfänger das A und O!

Durch Copy&Paste lernt man nichts... wäre auch zu schön

Beitrag von **pluto** » Fr 13. Jun 2014, 15:10

Hier eine kleine Beschreibung:
1. Du sicherst das was du gezeichnet hast, in eine TBitMap Variable
1.A Dafür muss die TBitMap Variable die gleiche Größe haben, wie das Canvas.

3. Nun kannst du, bei jedem OnPaint als erstes aus dieser TBitMap Variable sichern.

TBitMap hat unter anderem eine Methode: Canvas.Draw. Wobei Canvas TCanvas ist und eine Klasse da stellt.
TBitMap nutzt intern TCanvas zum "Zeichnen".

Ich denke, da solltest du schon genügend Hinweise hier im Forum oder im Netz finden.

Eine Andere Möglichkeit wäre, dein "Hintergrund" Ständig neu Zeichen zu lassen im Timer. Das ist zwar je nach Größe von deinem Canvas Träge und Langsam, ist aber einfacher.

Oder wie Vorgeschlagen einfach TImage nutzen. TImage Buffert intern das Bild.

Mathias · Beitrag von **Mathias** » Fr 13. Jun 2014, 17:50

Eine Andere Möglichkeit wäre, dein "Hintergrund" Ständig neu Zeichen zu lassen im Timer.

Das finde ich eine unnötige CPU-Belastung.

Beitrag von **pluto** » Fr 13. Jun 2014, 18:26

Das finde ich eine unnötige CPU-Belastung.

Ja, dass Stimmt. In diesen Fall ist es nicht gerechtfertigt. Ich meide das auch immer.

PascalHST · Beitrag von **PascalHST** » Fr 13. Jun 2014, 18:31

Code: Alles auswählen

unit FMain;
 
}
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls;
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    tmrMoveBall: TTimer;
    procedure FFormPaint(Sender: TObject);
    procedure FormCreate           (Sender: TObject);                                      {Gestaltung}
    procedure FormDestroy          (Sender: TObject);
    procedure FormKeyPress         (Sender: TObject; var Key: char);                     {Steuerung}
    procedure tmrMoveBallTimer     (Sender: TObject);                                {KI (Bewegung) des Balls}
  private
    FBallX                     : integer;                                       //F = Form / integer = Reelle zahl folgt
    FBallY                     : integer;
    FDirection                 : integer;
    FSpeed                     : integer;
    FBatRightY                 : integer;
    FBatLeftY                  : integer;
    FScreenCenterX             : integer;
    FScreenCenterY             : integer;
    FBatRightX                 : integer;
    FBatLeftX                  : integer;
    FBatY                      : integer;
    FScoreLeft                 : integer;
    FScoreRight                : integer;
    FSavedBackground           : TbitMap;
 
    procedure DrawBall          (const AXNew, AYNew: integer);
    procedure DrawBatLeft       (const AYNew: integer);
    procedure DrawBatRight      (const AYNew: integer);
    procedure BounceBallonXAxis;
    procedure BounceBallonYAxis;
    procedure StartGame;
    procedure Serve;
    procedure DisplayScore;
    procedure AnnounceWinner;
    procedure DrawCourt;
    procedure RestoreBackground (const AX, AY: integer);
    procedure SaveBackground    (const AX, AY: integer);
    procedure DisplayInstructions;
    procedure PlaySoundBounce;
    procedure PlaySoundMissLeft;
    procedure PlaySoundMissRight;
    procedure playsoundpingpong;
 
 
 
    { private declarations }
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
uses
  LCLType, MMSystem;
 
{$R *.lfm}
 
{ TForm1 }
 
const
  CHoehe                 = 768;                                                 //C=Constante - Name frei wählbar
  CBreite                = 1366;
 
  CBallGeschwindigkeit   = 50;
  CServedAngel           = 15;
 
  CSchlaegerHoehe        = 80;
  CBallGroesse           = 15;
 
  CMaxPunktzahl          = 10;
 
 
procedure TForm1.FormCreate(Sender: TObject);                                    {Gestaltung/Formen}
begin
  Color                 := clWhite;
  Height                := CHoehe;
  Width                 := CBreite;
  Position              := poScreenCenter;
  BorderStyle           := bsNone;
 
  FBallX                := 5;
  FBallY                := 10;
  FDirection            := CServedAngel;
  FSpeed                := CBallGeschwindigkeit;
 
  FScreenCenterX        := ClientWidth div 2;
  FScreenCenterY        := ClientHeight div 2;
  FBatRightX            := ClientWidth - 30 - CBallGroesse;
  FBatLeftX             := 30;
  FBatY                 := 300;
 
  FSavedBackground      := TBitMap.Create;
  FSavedBackground.SetSize(CBallGroesse, CBallGroesse);
 
 
  end;
 
procedure TForm1.FFormPaint(Sender: TObject);
begin
  DrawCourt;
  DisplayInstructions;
  DisplayScore;
  OnPaint:= nil;
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
     FSavedBackground.Free;
  end;
 
 
procedure TForm1.DrawBall(const AXNew, AYNew: integer);                         {Ball/Größe}
begin
     RestoreBackground(FBallX, FBallY);
     SaveBackground(AXNew, AYNew);
     Canvas.Brush.Color         := ClBlack;
     Canvas.Pen.Style           := psClear;
     Canvas.Rectangle(AXNew, AYNew, AXNew + CBallGroesse, AYNew + CBallGroesse);
     FBallX                     := AXNew;
     FBallY                     := AYNew;
     end;
 
 
procedure TForm1.StartGame;
begin
      FScoreLeft           := 0;
      FScoreRight          := 0;
      Serve;
      end;
 
procedure TForm1.Serve;
begin
      tmrMoveBall.Enabled   := false;
      DrawCourt;
      DisplayScore;
      //Wenn jemand gewonnen hat, dann..
      if (FScoreLeft >=10) or (FScoreRight >=10) then
         AnnounceWinner
      //Ansonsten weiterspielen
      else begin
          DrawBall(FScreenCenterX, FScreenCenterY);
          DisplayScore;
          Sleep(500);
          tmrMoveBall.Enabled:= true;
          end;
      end;
 
 
procedure TForm1.DrawCourt;
var
  LY: integer;
begin
  Canvas.Brush.Color:=clWhite;
  Canvas.Rectangle(
  0, 0, ClientWidth, ClientHeight);
  Canvas.Pen.Color:= clWhite;
  LY:= 0;
  while LY <= ClientHeight do
  begin
  Canvas.Line(
    FScreenCenterX,
    LY,
    FScreenCenterX,
    LY + 20);
  Inc(LY, 40);
  Canvas.Pen.Color:=clBlack;
  end;
 
  end;
 
procedure TForm1.RestoreBackground(const AX, AY: integer);
begin
  Canvas.Draw(AX, AY, FSavedBackground);
end;
 
procedure TForm1.SaveBackground(const AX, AY: integer);
begin
  FSavedBackground.Canvas.CopyRect(
    Rect(0, 0, CBallGroesse, CBallGroesse),
    Canvas,
    Rect(AX, AY, AX + CBallGroesse, AY + CBallGroesse));
end;
.

Okay, habe jetzt mal die wichtigsten Proceduren rausgeschrieben.
Ich will das der Hintergrund/Spielfeld bestehen bleibt...
Ich habe ein "OnPaint" In einer neue Procedure "FFormPaint" hinzugefügt.
TBitMap muss also die gleiche Größe haben wie das Canvas?! - Also Unter DrawCourt hat die das Canvas die Grüße " 0, 0, ClientWidth, ClientHeight" - Wo soll ich das nun einfügen?

Beitrag von **pluto** » Fr 13. Jun 2014, 19:06

TBitMap muss also die gleiche Größe haben wie das Canvas?! - Also Unter DrawCourt hat die das Canvas die Grüße " 0, 0, ClientWidth, ClientHeight" - Wo soll ich das nun einfügen?

Nun, TFrom hat ein Event :onResize oder so ähnlich. Da musst du die Größe setzten. Vorher die Klasse mit Create Erstellen und dann kannst du mit ClientWidth und ClientHeight die Größe von deiner TBitMap setzten.
Die hat zwei Eigenschaften: Width und Height.

PascalHST · Beitrag von **PascalHST** » Fr 13. Jun 2014, 19:24

Resize habe ich gefunden, versteh nicht ganz wie du das meinst zwecks Klassen erstellen, bzw Wo ich die lassen erstellen soll.

Mathias · Beitrag von **Mathias** » Fr 13. Jun 2014, 20:24

pluto hat geschrieben:
TBitMap muss also die gleiche Größe haben wie das Canvas?! - Also Unter DrawCourt hat die das Canvas die Grüße " 0, 0, ClientWidth, ClientHeight" - Wo soll ich das nun einfügen?
Nun, TFrom hat ein Event :onResize oder so ähnlich. Da musst du die Größe setzten. Vorher die Klasse mit Create Erstellen und dann kannst du mit ClientWidth und ClientHeight die Größe von deiner TBitMap setzten.
Die hat zwei Eigenschaften: Width und Height.

Nimm doch anstelle von TBitmap, TImage und setzte die Eigenschaft Align auf alClient und Stretch auf True. Somit füllt die Bitmap immer schon dein Form aus.

PascalHST · Beitrag von **PascalHST** » Sa 14. Jun 2014, 17:14

Nimm doch anstelle von TBitmap, TImage und setzte die Eigenschaft Align auf alClient und Stretch auf True. Somit füllt die Bitmap immer schon dein Form aus.

Wie lautet der Code dafür? Bin grade ziemlich überfordert bei der Objektprogrammierung.

Deutsches Lazarusforum

Linien neuzeichnen

Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen

Re: Linien neuzeichnen