Hallo,
ich habe ein Problem mit der Synchronization von Threads. Ich habe einen P4 3GHz mit HT.
Ich wollte nur so zum Zeitvertreib dieses
Thread Beispiel ausprobieren. Das das dort gezeigte keinerlei Code zum synchronisieren enthält machte mich etwas mißtrauisch. Tatsächlich der Code läuft nicht auf meinem Rechner.
Ich habe die Zeile // Sleep(30000); // replace with
query.Open or such auskommentiert, da ich das Formular verschieben möchte usw. Wenn ich jetzt die Maus bewege beleibt die Animation stehen.
Jetzt habe ich aus dem Code ein kleineres Beispiel abgeleitet.
Das ist der Thread
Delphi-Quellcode:
unit jsgaugethread_impl;
interface
// [url]http://www.swissdelphicenter.ch/de/showcode.php?id=1906[/url]
uses
Windows, Classes, SysUtils, Controls, Graphics, ExtCtrls;
type
TJsGaugeThread =
class(TThread)
private
{ Private-Deklarationen }
FPanel : TPanel;
FPaintRect : TRect;
FImage : TBitmap;
procedure UpdateControl;
protected
procedure Execute;
override;
public
constructor Create(Panel : TPanel; Paintrect: TRect);
end;
implementation
Type
TCanvasWinControl =
class(TCustomControl)
public
property Canvas;
end;
constructor TJsGaugeThread.Create(Panel : TPanel; Paintrect: TRect);
begin
inherited Create(True);
FPanel:= Panel;
FPaintRect := Paintrect;
FreeOnterminate := True;
Resume;
end;
procedure TJsGaugeThread.Execute;
var
DC : HDC;
T : Integer;
begin
FImage:=TBitmap.Create;
T:=0;
Try
With FImage
do
begin
Width:= FPaintRect.Right - FPaintRect.Left;
Height:= FPaintRect.Bottom - FPaintRect.Top;
end;
{ with }
While Not Terminated
do
begin
With FImage.Canvas
do
begin
Brush.Color:=clRed;
Brush.Style:=bsSolid;
Rectangle(FPaintrect);
Brush.Style:=bsClear;
Font.Size:=12;
Font.Style:=[fsBold];
Inc(T);
TextOut(10,10,'
Testtext aus dem Thread '+IntToStr(T));
Synchronize(UpdateControl);
end;
// With Image.Canvas do
Sleep(50);
end;
// While Not Terminated do
Finally
FImage.FreeImage;
end;
end;
procedure TJsGaugeThread.UpdateControl;
begin
With TCanvasWinControl(FPanel).Canvas
do
begin
Lock;
BitBlt(
Handle,
FPaintRect.Left,
FPaintRect.Top,
FPaintRect.Right,
FPaintRect.Bottom,
FImage.Canvas.Handle,
0, 0,
SRCCOPY);
UnLock;
end;
end;
end.
Und hier der Aufruf
Delphi-Quellcode:
procedure TForm1.Button1Click(Sender: TObject);
begin
FGauge:=TJsGaugeThread.Create(Panel1,Panel1.ClientRect);
Application.ProcessMessages;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
FGauge.Terminate;
end;
Trotz der Verwendung von Synchronize und Lock/UnLock wird auf Panel1 irgendwann nicht mehr gezeichnet. Der Thread läuft weiter!
Warum ist das so?