AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Threads und TBitmaps

Ein Thema von TheGroudonx · begonnen am 12. Aug 2014 · letzter Beitrag vom 10. Okt 2017
 
Medium

Registriert seit: 23. Jan 2008
3.688 Beiträge
 
Delphi 2007 Enterprise
 
#22

AW: Threads und TBitmaps

  Alt 3. Sep 2014, 16:38
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
"When one person suffers from a delusion, it is called insanity. When a million people suffer from a delusion, it is called religion." (Richard Dawkins)

Geändert von Medium ( 3. Sep 2014 um 16:44 Uhr)
  Mit Zitat antworten Zitat
 

 

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 03:44 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz