Autor Beitrag
AlienX
Hält's aus hier
Beiträge: 9



BeitragVerfasst: Fr 16.08.02 14:11 
Ich hab folgendes Programm geschrieben, um die Sachen aus dem Thread "2D-Engine mit Bitmaps" zu testen.

ausblenden volle Höhe Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure MoveChar(Sender: TObject; var Done: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private-Deklarationen }
    MoveToX: Integer;
    MoveToY: Integer;
    PositionX: Integer;
    PositionY: Integer;
  public
    { Public-Deklarationen }
    Background: TBitmap;
    Character: TBitmap;
    BildBuffer: TBitmap;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  MoveToY := Y;
  MoveToX := X;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Background := TBitmap.Create;
  Background.LoadFromFile('monkey.bmp');
  Character := TBitmap.Create;
  Character.LoadFromFile('guy.bmp');
  BildBuffer := TBitmap.Create;

  PositionX := 200;
  PositionY := 200;

  Application.OnIdle := MoveChar;
end;

procedure TForm1.MoveChar(Sender: TObject; var Done: Boolean);
var TopLeft, BottomRight: TPoint;
begin
  if (MoveToX = PositionX) and (MoveToY = PositionY) then
    Done := true
  else
    begin

    Done := false;
    if (MoveToX > PositionX) then
      PositionX := PositionX + 3;
    if (MoveToX < PositionX) then
      PositionX := PositionX - 3;
    if (MoveToY > PositionY) then
      PositionY := PositionY + 3;
    if (MoveToY < PositionY) then
      PositionY := PositionY - 3;
    sleep(20);

    BildBuffer.FreeImage;
    BildBuffer := Background;

    TopLeft := Point(round(PositionX-Character.Width/2),PositionY-Character.Height);
    BottomRight := Point(round(PositionX+Character.Width/2),PositionY);

    BildBuffer.Canvas.BrushCopy(
          Rect(TopLeft,BottomRight),
          Character,
          Rect(0,0,Character.Width,Character.Height),
          clWhite);

    Form1.Canvas.BrushCopy(Rect(0, 0, 640, 400), BildBuffer, Rect(0,0,640,400), clWhite);

    end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //BildBuffer.Free;
  Background.Free;
  Character.Free;
end;

end.


Jetzt hab ich aber 2 Probleme:

1. Warum löst das BildBuffer.Free ein Fehler aus? Und was kann ich dagegen machen? (Ich denk mal, dass hängt mit dem Application.OnIdle zusammen.)

2. Das Bild Character bewegt sich zwar ohne Flimmern etc über das Bild, aber es zieht eine Spur hinter sich her. Ich versteh nur nicht warum, denn ich baue das Bild bei jedem Aufruf von MoveChar komplett neu auf. Wo liegt der Fehler?

--
Wenn mir jemand Frage 2 beantworten könnte, würde mir das schon sehr helfen, weil sonst kann ich nicht weiter machen.
AlienX Threadstarter
Hält's aus hier
Beiträge: 9



BeitragVerfasst: Fr 16.08.02 22:00 
Ich hab eine Möglichkeit gefunden, dazu ersetz ich
ausblenden Quelltext
1:
BildBuffer := Background;					

durch
ausblenden Quelltext
1:
2:
3:
    BildBuffer.Width := Background.Width;
    BildBuffer.Height := Background.Height;
    BildBuffer.Canvas.BrushCopy(Rect(0,0,Background.Width,Background.Height), Background, Rect(0,0,Background.Width,Background.Height), clWhite);


Warum Ersteres nicht geht, versteh ich trotzdem nicht.
Aber ich werd es eh anderst machen, weil es nicht gerade gut für die Performance ist, jedes Mal den Hintergrund neu zu zeichnen.[/code]