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
Antwort Antwort
Medium

Registriert seit: 23. Jan 2008
3.689 Beiträge
 
Delphi 2007 Enterprise
 
#1

AW: Threads und TBitmaps

  Alt 1. Sep 2014, 14:20
Das was du da jetzt tust, sieht ganz danach aus als würdest du überall wo es am Rohr leckt ein Pflaster aufkleben, und hoffen, dass das hält, und das Rohr nicht wieder an anderer Stelle platzt. Du solltest ernsthaft überdenken ein Rohr aus anderem Material zu nehmen. (Das war voll metaphorisch. Was ich sagen will ist: Du hast ein ziemliches Gewurschtel, und wurschtelst es in der Hoffnung, dass irgendwann ein (scheinbar) funktionierendes Knäul stehen bleibt, nur noch mehr.) (Okay, das war auch metaphorisch...)
"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)
  Mit Zitat antworten Zitat
TheGroudonx

Registriert seit: 21. Mai 2014
44 Beiträge
 
#2

AW: Threads und TBitmaps

  Alt 1. Sep 2014, 14:32
Ich möchte Bilder in einem Thread zeichnen lassen und diese dann auf die Form kopieren.
Dabei soll die CPU-Auslastung in den Thread geschoben werden.
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#3

AW: Threads und TBitmaps

  Alt 1. Sep 2014, 14:53
Hier mal so ein BitmapThread
Delphi-Quellcode:
unit BitmapProducerThread;

interface

uses
  System.Generics.Collections,
  System.Classes,
  System.SyncObjs,
  Vcl.Graphics;

type
  TBitmapParameters = record
    Width : Integer;
    Height : Integer;
    constructor Create( AWidth, AHeight : Integer );
  end;

  TBitmapProducerThread = class( TThread )
  private
    FEvent : TEvent;
    FInputCS : TCriticalSection;
    FOutputCS : TCriticalSection;
    FInputQueue : TQueue<TBitmapParameters>;
    FOutput : TBitmap;
    FOnOutputChanged : TNotifyEvent;
    procedure SetOutput( const Value : TBitmap );
    procedure SetOnOutputChanged( const Value : TNotifyEvent );
    function GetOnOutputChanged : TNotifyEvent;
    procedure DoOutputChanged;
  protected
    procedure Execute; override;
    procedure TerminatedSet; override;
    function GetBitmapParameter : TBitmapParameters;
    procedure DoExecute;
  public
    constructor Create;
    destructor Destroy; override;

    procedure Add( ABitmapParameters : TBitmapParameters );
    procedure Get( ABitmap : TBitmap );

    property OnOutputChanged : TNotifyEvent read GetOnOutputChanged write SetOnOutputChanged;
  end;

implementation

{ TBitmapParameters }

constructor TBitmapParameters.Create( AWidth, AHeight : Integer );
begin
  Width := AWidth;
  Height := AHeight;
end;

{ TBitmapProducerThread }

procedure TBitmapProducerThread.Add( ABitmapParameters : TBitmapParameters );
begin
  FInputCS.Enter;
  try
    FInputQueue.Enqueue( ABitmapParameters );
    FEvent.SetEvent;
  finally
    FInputCS.Leave;
  end;
end;

constructor TBitmapProducerThread.Create;
begin
  FInputCS := TCriticalSection.Create;
  FOutputCS := TCriticalSection.Create;
  FEvent := TEvent.Create( nil, True, False, '' );
  FInputQueue := TQueue<TBitmapParameters>.Create;
  FOutput := TBitmap.Create;
  inherited Create;
end;

destructor TBitmapProducerThread.Destroy;
begin

  inherited;
  FInputQueue.Free;
  FOutput.Free;
  FOutputCS.Free;
  FInputCS.Free;
  FEvent.Free;
end;

procedure TBitmapProducerThread.DoExecute;
var
  LBitmap : TBitmap;
  LParams : TBitmapParameters;
  LIdx : Integer;
begin
  // Parameter aus Queue holen
  LParams := GetBitmapParameter;

  LBitmap := TBitmap.Create;
  try

    // Bitmap erstellen
    LBitmap.Canvas.Lock;
    try
      LBitmap.Width := LParams.Width;
      LBitmap.Height := LParams.Height;

      // 5000 rote Pixel auf ein Bitmap malen
      for LIdx := 1 to 5000 do
        LBitmap.Canvas.Pixels[Random( LBitmap.Width ), Random( LBitmap.Height )] := clRed;

    finally
      LBitmap.Canvas.Unlock;
    end;

    // Bitmap in die Ausgabe schreiben
    SetOutput( LBitmap );

  finally
    LBitmap.Free;
  end;

  // Benachrichtigen
  Synchronize( DoOutputChanged );
end;

procedure TBitmapProducerThread.DoOutputChanged;
var
  LEvent : TNotifyEvent;
begin
  LEvent := OnOutputChanged;
  if Assigned( LEvent )
  then
    LEvent( Self );
end;

procedure TBitmapProducerThread.Execute;
begin
  inherited;
  while not Terminated do
    begin
      FEvent.WaitFor;

      if not Terminated
      then
        begin
          DoExecute;
        end;

    end;
end;

procedure TBitmapProducerThread.Get( ABitmap : TBitmap );
begin
  FOutputCS.Enter;
  try
    if Assigned( FOutput )
    then
      ABitmap.Assign( FOutput );
  finally
    FOutputCS.Leave;
  end;
end;

function TBitmapProducerThread.GetBitmapParameter : TBitmapParameters;
begin
  FInputCS.Enter;
  try
    Result := FInputQueue.Dequeue;
    if ( FInputQueue.Count = 0 ) and not Terminated
    then
      FEvent.ResetEvent;
  finally
    FInputCS.Leave;
  end;
end;

function TBitmapProducerThread.GetOnOutputChanged : TNotifyEvent;
begin
  FOutputCS.Enter;
  try
    Result := FOnOutputChanged;
  finally
    FOutputCS.Leave;
  end;
end;

procedure TBitmapProducerThread.SetOnOutputChanged( const Value : TNotifyEvent );
begin
  FOutputCS.Enter;
  try
    FOnOutputChanged := Value;
  finally
    FOutputCS.Leave;
  end;
end;

procedure TBitmapProducerThread.SetOutput( const Value : TBitmap );
begin
  FOutputCS.Enter;
  try
    FOutput.Assign( Value );
  finally
    FOutputCS.Leave;
  end;
end;

procedure TBitmapProducerThread.TerminatedSet;
begin
  inherited;
  FEvent.SetEvent;
end;

end.
und die passende Form dazu
Delphi-Quellcode:
unit FormMain;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, BitmapProducerThread,
  Vcl.StdCtrls;

type
  TForm1 = class( TForm )
    Image1 : TImage;
    Button1 : TButton;
    ListBox1 : TListBox;
    procedure Button1Click( Sender : TObject );
  private
    FBitmapProducer : TBitmapProducerThread;
    procedure BitmapProducerOutputChanged( Sender : TObject );
  public
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  end;

var
  Form1 : TForm1;

implementation

{$R *.dfm}
{ TForm1 }

procedure TForm1.AfterConstruction;
begin
  inherited;
  FBitmapProducer := TBitmapProducerThread.Create;
  FBitmapProducer.OnOutputChanged := BitmapProducerOutputChanged;
end;

procedure TForm1.BeforeDestruction;
begin
  inherited;
  FBitmapProducer.OnOutputChanged := nil;
  FBitmapProducer.Free;
end;

procedure TForm1.BitmapProducerOutputChanged( Sender : TObject );
begin
  FBitmapProducer.Get( Image1.Picture.Bitmap );
end;

procedure TForm1.Button1Click( Sender : TObject );
var
  LIdx : Integer;
begin
  ListBox1.Clear;
  for LIdx := 1 to 200 do
    FBitmapProducer.Add( TBitmapParameters.Create( Image1.Width, Image1.Height ) );
end;

end.
die DPR ist recht harmlos
Delphi-Quellcode:
program dp_181416;

uses
  Vcl.Forms,
  FormMain in 'FormMain.pas{Form1},
  BitmapProducerThread in 'BitmapProducerThread.pas';

{$R *.res}

begin
  ReportMemoryLeaksOnShutdown := True;
  Randomize;
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
TheGroudonx

Registriert seit: 21. Mai 2014
44 Beiträge
 
#4

AW: Threads und TBitmaps

  Alt 1. Sep 2014, 15:11
Hab mir jetzt mal eine Unit mit Synchronize angeschaut, scheint auf den ersten Blick zu funktionieren.

Den Quelltext von Sir Rufo habe ich versucht zu kompilieren, aber Delphi 7 kennt kein "System.Generics.Collections" (hoffe ist nicht wichtig).
Nach der Anpassung der Unit-Bezeichnungen kommt leider schon bei Zeile 14
    constructor Create( AWidth, AHeight : Integer ); die nächste Fehlermeldung "End erwartet aber constructor gefunden"
Da ich mich nur mehr oder weniger mit Basics auskenne möchte ich lieber nicht versuchen, die ganzen Stellen umzuschreiben.
Trotzdem werde ich mir mal die Synchronize Methode genauer ansehen
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#5

AW: Threads und TBitmaps

  Alt 1. Sep 2014, 15:29
Ah, war mir nicht aufgefallen, dass du nur Delphi 7 hast (du könntest das ja in dein Profil eintragen).

Das Prinzip der CriticalSections, Events und Synchronize bleibt aber gleich und kannst du fast 1:1 übernehmen. Wichtig ist einfach, dass alle Zugriffe von aussen entsprechend geschützt erfolgen.

Auch die Bitmap, die im Thread erzeugt wird, ist erst nach der Fertigstellung von aussen abrufbar. Solange kann von aussen nur das zuletzt erzeugte Bitmap abgerufen werden.

System.Generics.Collections beinhaltet TQueue<T> was du anders lösen müsstest, denn Generics sind Delphi 7 nicht bekannt.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
TheGroudonx

Registriert seit: 21. Mai 2014
44 Beiträge
 
#6

AW: Threads und TBitmaps

  Alt 1. Sep 2014, 15:30
Die neue Art sieht so aus:

Aufruf:
Delphi-Quellcode:
procedure TForm1.FormCreate(Sender: TObject);
begin
Paintthread := TPaintThread.create(false);
Paintthread.Image := Image1;
end;
Thread:
Delphi-Quellcode:
unit UThread;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls;
    
type
  Image = TImage;
  TPaintThread = class(TThread)



private

    Zeichenflaeche: TImage;
    MyBild : TBitmap;



    procedure zeichnen;

    procedure SetImage(const Value: TImage);

  protected

    procedure Execute; override;

  public

    constructor Create(CreateSuspended: Boolean);

    property Image: TImage read Zeichenflaeche write SetImage;

  end;





implementation





constructor TPaintThread.Create(CreateSuspended: Boolean);
begin
inherited;

MyBild := TBitmap.create;
MyBild.LoadFromFile('1.bmp');

end;



procedure TPaintThread.Execute;
begin

 While (Terminated = False) do
 begin

 Synchronize(Zeichnen);
 sleep(1);

 end;
end;



procedure TPaintThread.Zeichnen;
begin
Zeichenflaeche.Canvas.Draw(random(50) + 1,random(50) + 1,MyBild);
end;



procedure TPaintThread.SetImage(const Value: TImage);
begin
Zeichenflaeche := Value;
end;

end.
Das geht auch sehr gut.
Ist das in etwa so wie es richtig ist oder müssen nach wie vor Schutzoptionen wie TCriticalSection darin verwendet werden?
  Mit Zitat antworten Zitat
Benutzerbild von Sir Rufo
Sir Rufo

Registriert seit: 5. Jan 2005
Ort: Stadthagen
9.454 Beiträge
 
Delphi 10 Seattle Enterprise
 
#7

AW: Threads und TBitmaps

  Alt 1. Sep 2014, 15:41
Ähm, das eigentliche Zeichnen erledigt du jetzt im Kontext des Hauptthreads

Synchronize( Zeichnen ); Damit hast du rein gar nichts gewonnen ... ja, es funktioniert, aber wozu benötigst du dann einen Thread, wenn du es eh wieder im Hauptthread zeichnen lässt.
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ‎ea 0a 4c 14 0d b6 3a a4 c1 c5 b9 dc 90 9d f0 e9 de 13 da 60)
  Mit Zitat antworten Zitat
Whookie

Registriert seit: 3. Mai 2006
Ort: Graz
454 Beiträge
 
Delphi 10.3 Rio
 
#8

AW: Threads und TBitmaps

  Alt 1. Sep 2014, 15:45
Damit hast du rein gar nichts gewonnen ... ja, es funktioniert, aber wozu benötigst du dann einen Thread, wenn du es eh wieder im Hauptthread zeichnen lässt.
Das bringt nur was wenn vor dem Synchronize eine gaaaaanze menge arbeit passiert ... "zeichnen" bezieht sich hier ja nur auf einen Blit auf den Screen (der ja eigentlich flott sein sollte)
Whookie

Software isn't released ... it is allowed to escape!
  Mit Zitat antworten Zitat
Antwort Antwort

 

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 00:18 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