unit Unit1;
interface
uses
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ExtCtrls,
MMSystem;
type
TRealPoint =
record
X: Single;
Y: Single;
end;
TForm1 =
class(TForm)
PaintBox1: TPaintBox;
procedure FormCreate(Sender: TObject);
procedure PaintBox1Click(Sender: TObject);
procedure PaintBox1Paint(Sender: TObject);
procedure FormClose(Sender: TObject;
var Action: TCloseAction);
private
FBitmap: TBitmap;
FFinished: Boolean;
FLastRenderTime: Cardinal;
FPos: TRealPoint;
procedure Render;
procedure Run;
public
end;
var
Form1 : TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
FBitmap := TBitmap.Create;
FBitmap.Width := 20;
FBitmap.Height := 20;
with FBitmap.Canvas
do
begin
Brush.Color := clRed;
Pen.Color := clRed;
Ellipse(0, 0, 20, 20);
end;
FPos.X := 0;
FPos.Y := 0;
DoubleBuffered := True;
end;
procedure TForm1.PaintBox1Click(Sender: TObject);
begin
Run;
FLastRenderTime := timeGetTime;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
BitBlt(PaintBox1.Canvas.Handle, Round(FPos.X), Round(FPos.Y), 20, 20, FBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure TForm1.Render;
var
TimeDiff : Integer;
begin
TimeDiff := timeGetTime - FLastRenderTime;
FPos.X := FPos.X + TimeDiff / 3;
PaintBox1.Invalidate;
// MP: An dieser Stelle überflüssig
//Application.ProcessMessages;
Inc(FLastRenderTime, TimeDiff);
end;
procedure TForm1.Run;
// MP:
//var
// Message : TMsg;
begin
while not FFinished
do
begin
// MP: Warum nimmst du nicht Application.ProcessMessages?
Application.ProcessMessages;
// MP: Von welchen Fenster soll PeekMessage denn die Nachrichten an die Fenster-Prozedur weiterleiten,
// wenn du null als Fensterhandle angibst?
// Und an welcher Stelle hast du die (nicht vorhandene) Fensterklasse mit deiner Fenster-Prozedur verknüpft?
// Du mischt hier VCL und 'NonVCL' Code, was zum einem so nicht funktioniert und zum anderen nicht gemacht
// werden sollte.
// while PeekMessage(Message, 0, 0, 0, PM_REMOVE) do
// begin
// TranslateMessage(Message);
// DispatchMessage(Message);
// end;
// MP: Dein Hauptthread braucht 100% CPU-Last, dass da nichts mehr reagiert, ist kein Wunder.
Sleep(1);
Render;
end;
end;
// MP: Was soll das? Wird doch nie aufgerufen. Und warum implementierst du eine Fenster-Prozedur,
// wenn du mit der VCL arbeitest?
//function WndProc(hWnd: Integer; Message, wParam, lParam: Longint): Longint; stdcall;
//begin
// Result := 0;
// case Message of
// WM_DESTROY: PostQuitMessage(0);
// WM_CLOSE: begin
// Form1.FFinished := True;
// DestroyWindow(hWnd);
// end
// else Result := DefWindowProc(hWnd, Message, wParam, lParam);
// end;
//end;
// MP: FFinished auf TRUE setzen, sonst kann das Fenster nicht geschlossen werden.
procedure TForm1.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
FFinished := True;
end;
end.