Auf TPanel mit Thread malen

[Jens Schumann]

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?

[Sprint]

Zitat:

Zitat von Jens Schumann

Trotz der Verwendung von Synchronize und Lock/UnLock wird auf Panel1 irgendwann nicht mehr gezeichnet. Der Thread läuft weiter!

Vielleicht hilft ein SetProcessAffinityMask.

[Jens Schumann]

Hallo,

Zitat:

Zitat von Sprint

Zitat:

Zitat von Jens Schumann

Trotz der Verwendung von Synchronize und Lock/UnLock wird auf Panel1 irgendwann nicht mehr gezeichnet. Der Thread läuft weiter!

Vielleicht hilft ein SetProcessAffinityMask.

Die API-Funktion ist mir bislang noch nicht untergekommen. Deshalb habe ich in die MSDN Online Library geschaut.
Ich habe es so verstanden:
Hole mit GetProcessAffinityMask die z.Z. gültige BitMask.
Verändere die BitMask wie gewünscht
Setze mit SetProcessAffinityMask die neue BitMask.

Leider konnte ich keine Liste mit den Werten und deren Bedeutung für die BitMask finden.
Dann kann ich mir auch noch nicht erklären, wie sich die Funktion heilend auf mein Problem
auswirken soll. Hättest Du evt. noch ein paar Hineise?

[Jens Schumann]

*push*

[Sprint]

Da ich kein Intel Prozessor mit HT habe, kann ich hier auch nichts ausprobieren. Aber versuche mal das hier:

Delphi-Quellcode:

SetProcessAffinityMask(GetCurrentProcess, 1);

Ansonsten schau mal in die Newsgroup comp.os.ms-windows.programmer.win32
Du bist auf jeden Fall nicht der einzige mit HT Nebeneffekten.

[Jens Schumann]

Hallo Sprint,
ich habe meinen Code gerade auf einem PIII 1 GHz (Win2000 und kompiliert mit D5 Pro SP1) ausgefühgt. Es tritt der gleiche Fehler auf.
D.h. es kann nicht am HT liegen.

[Sprint]

Zitat:

Zitat von Jens Schumann

ich habe meinen Code gerade auf einem PIII 1 GHz (Win2000 und kompiliert mit D5 Pro SP1) ausgefühgt. Es tritt der gleiche Fehler auf. D.h. es kann nicht am HT liegen.

Getestet habe ich deinen Code nicht. Ich bin davon ausgegangen, dass dieser fehlerfrei auf einen "normalen" Prozessor läuft.

[Jens Schumann]

Hallo,
hier kommt das Testprogramm.
Nach klick auf Button1 die Maus über dem Formular bewegen. Irgendwann wird dann nicht mehr gezeichnet.

[Sprint]

Wenn ich das Lock und Unlock entferne, dann geht's.

Edit: Das war jetzt auf dein erstes Posting bezogen. Die ZIP Datei habe ich mir nicht angeschaut.

[Jens Schumann]

Zitat:

Zitat von Sprint

Wenn ich das Lock und Unlock entferne, dann geht's.

Edit: Das war jetzt auf dein erstes Posting bezogen. Die ZIP Datei habe ich mir nicht angeschaut.

Wenn ich das Lock und UnLock entferne funktioniert es nicht. (Immer noch auf dem PIII)