Threads und TBitmaps

[Medium]

Der Timer da macht mir echte Bauchschmerzen. Probier doch mal bitte folgendes aus:

Delphi-Quellcode:

unit Unit1;

interface

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

type
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure ThreadPaint(var msg: TMessage); message WM_THREADPAINT;
   private
   public
     { Public-Deklarationen }
   end;

var
   Form1: TForm1;
   Paintthread : TPaintThread;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin 
  Paintthread := TPaintThread.Create(false, self.Handle);
end;

procedure TForm1.ThreadPaint(var msg: TMessage);
begin
  Paintthread.LockBMP;
  try
    self.Canvas.Draw(40, 40, PaintThread.BMP);
  finally
    Paintthread.UnlockBMP;
  end;
end;

end.

Delphi-Quellcode:

unit UThread;

interface 

uses
   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   Dialogs, ComCtrls, StdCtrls, ExtCtrls, SyncObjs;
     
type 
  TPaintThread = class(TThread)
  private
    FBMP: TBitmap;
    FBMPCS: TCriticalSection;
    FHandle: THandle;
  protected
    procedure Execute; override;
  public
    constructor Create(CreateSuspended: Boolean; aMainformHandle: THandle);
    procedure LockBMP;
    procedure UnlockBMP;
    property BMP: TBitmap read FBMP;
  end;

const
  WM_THREADPAINT = WM_USER + 1234;

implementation 

constructor TPaintThread.Create(CreateSuspended: Boolean; aMainformHandle: THandle);
begin
  inherited Create(CreateSuspended);
  FBMPCS := TCriticalSection.Create;
  FBMP := TBitmap.Create;
  FBMP.Width := 300;
  FBMP.Height := 300;
  FHandle := aMainformHandle;
end;

procedure TPaintThread.Execute;
begin
  while not Terminated do
  begin
    LockBMP;
    try
      FBMP.Canvas.MoveTo(Random(300), Random(300));
      FBMP.Canvas.LineTo(Random(300), Random(300));
    finally
      UnlockBMP;
    end;
    PostMessage(FHandle, WM_THREADPAINT, 0, 0);
    sleep(1);
  end;
end;

procedure TPaintThread.LockBMP;
begin
  FBMPCS.Enter;
  FBMP.Canvas.Lock;
end;

procedure TPaintThread.UnlockBMP;
begin
  FMP.Canvas.Unlock;
  FBMPCS.Leave;
end;

end.

Edit:

Zitat:

Das Locken und Unlocken ist noch die größte Herausforderung, denn wenn auch nur 1 lock oder unlock fehlt geht die ganze Anzeige meistens nichtmehr.

Das stimmt, deswegen ist gerade hier die Benutzung von try..finally noch wichtiger als eh schon. Aber das ist eine schöne Fingerübung, denn eigentlich sollte man immer so programmieren, dass alles rund und sauber behandelt wird. Das andere nennt man Frickeln