Delphi-PRAXiS
Seite 1 von 3  1 23      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Cross-Platform-Entwicklung (https://www.delphipraxis.net/91-cross-platform-entwicklung/)
-   -   iOS Multithreaded Zeichnen (https://www.delphipraxis.net/196934-multithreaded-zeichnen.html)

Sherlock 2. Jul 2018 08:00

Multithreaded Zeichnen
 
Ich versuche die Zeit zu verkürzen, die meine Applikation einfriert, wenn ich zeichne. Da ab Tokyo Bitmaps threadsicher sein sollen, habe ich das zeichnen auf die Bitmap in einen Thread ausgelagert und möchte die fertige Bitmap per Synchonize an die GUI übergeben. Unter Windows klappt das einwandfrei, mit dem iOS Simulator ebenso. Auf dem iDevice hingegen gar nicht. Ich habe dazu ein kleines Testprojekt gebaut, daß in per Button einen Thread startet, der auf einer Bitmap tausend zufällige Punkte mit einer Linie verbindet und dann das Ergebnis in ein Image auf der Oberfläche setzt. Das habe ich probiert per direkter Zuweisung, per Assign und CopyFromBitmap. Nichts führte zu einem sichtbaren Ergebnis.

Hier die relevanten Methoden:
Delphi-Quellcode:
procedure TPainter.Execute;
var
  myPoint1 : TPoint;
  myPoint2 : TPoint;
  i       : integer;
  service : IFMXPhotoLibrary;
begin
  inherited;
  while not Terminated do
  begin
    myPoint1 := TPoint.Zero;
    if fBMP.Canvas.BeginScene then
    begin
      fBMP.Canvas.Clear(TAlphaColorRec.Null);
      fBMP.Canvas.Stroke.Thickness := 1;
      fBMP.Canvas.Stroke.Color := TAlphaColorRec.Black;
      try
        for i := 0 to 1000 do
        begin
          myPoint2 := TPoint.Create(Random(fBMP.Width), Random(fBMP.Height));
          fBMP.Canvas.DrawLine(myPoint1, myPoint2, 1);
          myPoint1 := myPoint2;
        end;
      finally
        fBMP.Canvas.EndScene;
      end;
    end;
    Synchronize(updateGui);
    Sleep(1000);
  end;
end;
Und die synchronisierte Methode:
Delphi-Quellcode:
procedure TPainter.updateGui;
begin
  Form16.Image1.BeginUpdate;
  Form16.Image1.Bitmap.SetSize(fBMP.Size);
  Form16.Image1.Bitmap.Assign(fBMP);
  Form16.Image1.EndUpdate;
  Form16.Image1.Repaint;
end;
Im Ergebnis sollte eine Bitmap mit wildem Zickzack einmal pro Sekunde neu gezeichnet werden.

Was mache ich falsch?

TiGü 2. Jul 2018 09:11

AW: Multithreaded Zeichnen
 
Mangels iOS-Gerät kann ich es nicht testen und der folgende Quelltext ist nur ein Schuss ins Blaue, aber du kannst es ja mal versuchen.

Wesentliche Änderungen:

1. Erzeugung des Thread-Bitmaps im Execute und damit im Thread-Kontext (fühlt sich richtiger an - ob in FMX notwendig wissen andere besser).
2. Benachrichtigung der GUI durch übergebende Callback (flexibler, kein Zugriff auf globale Variablen [ja, ich weiß es es nur ein Testprojekt]).
3. Lesen und schreiben zwischen den Bitmaps mithilfe der Map-Methode und TBitmapData.Copy.

Vielleicht ist Punkt Nummer Drei die Lösung. Versuch macht klug!

Delphi-Quellcode:
unit ThreadBitmap.View;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Controls.Presentation, FMX.StdCtrls, FMX.Objects;

type
  TUpdateGui = TProc<TBitmap>;
 
  TPainter = class(TThread)
  private
    fBMP: TBitmap;
    fUpdateGui: TUpdateGui;
    procedure DoPainting(const ACanvas: TCanvas; const AWitdh, AHeight: Integer);
    procedure updateGui;
    procedure DoUpdateGui;

  protected
    procedure Execute; override;
  public
    constructor Create(const AUpdateGui: TUpdateGui);
    destructor Destroy; override;

  end;

  TForm16 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    FPainter: TPainter;
    procedure updateGui(ABitmap: TBitmap);
  public
    { Public declarations }
  end;

var
  Form16: TForm16;

implementation

{$R *.fmx}

{ TPainter }

constructor TPainter.Create(const AUpdateGui: TUpdateGui);
begin
  fUpdateGui := AUpdateGui;
  inherited Create(false);
end;

destructor TPainter.Destroy;
begin
  fUpdateGui := nil;
  inherited;
end;

procedure TPainter.DoPainting(const ACanvas: TCanvas; const AWitdh, AHeight: Integer);
var
  myPoint1: TPoint;
  myPoint2: TPoint;
  I: Integer;
begin
  myPoint1 := TPoint.Zero;
  if ACanvas.BeginScene then
  begin
    ACanvas.Clear(TAlphaColorRec.Null);
    ACanvas.Stroke.Thickness := 1;
    ACanvas.Stroke.Color := TAlphaColorRec.Black;
    try
      for I := 0 to 1000 - 1 do
      begin
        myPoint2 := TPoint.Create(Random(AWitdh), Random(AHeight));
        ACanvas.DrawLine(myPoint1, myPoint2, 1);
        myPoint1 := myPoint2;
      end;
    finally
      ACanvas.EndScene;
    end;
  end;
end;

procedure TPainter.Execute;
begin
  inherited;
  fBMP := TBitmap.Create(256, 256);
  try
    while not Terminated do
    begin
      DoPainting(fBMP.Canvas, fBMP.Width, fBMP.Height);
      updateGui;
      if not Terminated then
        Sleep(1000);
    end;
  finally
    fBMP.Free;
  end;
end;

procedure TPainter.DoUpdateGui;
begin
  fUpdateGui(fBMP);
end;

procedure TPainter.updateGui;
begin
  if Assigned(fUpdateGui) then
  begin
    Synchronize(DoUpdateGui);
  end;
end;

procedure TForm16.FormDestroy(Sender: TObject);
begin
  if Assigned(FPainter) then
    FPainter.Free;
end;

procedure TForm16.FormCreate(Sender: TObject);
begin
  FPainter := nil;
end;

procedure TForm16.Button1Click(Sender: TObject);
begin
  FPainter := TPainter.Create(updateGui);
end;

procedure TForm16.updateGui(ABitmap: TBitmap);
var
  LBitmap: TBitmap;
  LDataWrite, LDataRead: TBitmapData;
begin
  // Self.Image1.BeginUpdate;
  // try
  // Self.Image1.Bitmap.SetSize(ABitmap.Size);
  // Self.Image1.Bitmap.Assign(ABitmap);
  // finally
  // Self.Image1.EndUpdate;
  // Self.Image1.Repaint;
  // end;

  Self.Image1.BeginUpdate;
  try
    LBitmap := Self.Image1.Bitmap;
    LBitmap.SetSize(ABitmap.Size);
    if LBitmap.Map(TMapAccess.Write, LDataWrite) and ABitmap.Map(TMapAccess.Read, LDataRead) then
    begin
      try
        LDataWrite.Copy(LDataRead);
      finally
        ABitmap.Unmap(LDataRead);
        LBitmap.Unmap(LDataWrite);
      end;
    end;
  finally
    Self.Image1.EndUpdate;
    Self.Image1.Repaint;
  end;
end;

end.

Rollo62 2. Jul 2018 09:31

AW: Multithreaded Zeichnen
 
Schliesse mich TiGü an ...

Aber hast du schonmal versucht statt
Delphi-Quellcode:
Synchronize(updateGui);
die TThread-Funktionen zu nehmen ?
Kann gerade nicht nachschauen, womöglich verbirgt sich hinter Synchrinose genau dasselbe ...

Delphi-Quellcode:
TThread.Synchronize(nil,
                    procedure
                        updateGui;
                    end);
Edit: Queue funktioniert hier wohl nicht ....
oder
Delphi-Quellcode:
TThread.Queue(nil,
              procedure
                  updateGui;
              end);

Aber ganz ehrlich, nur weil EMBA schreibt TBitmap wäre threadsicher muss das nicht stimmen.
Ich fände das auch recht spannend.

Falls das Beispiel von TiGü bei dir läuft werde ich das mal auf iOS Testen, aber ich komme wahrscheinloch erst am Mittwoch dazu.

Rollo

Sherlock 2. Jul 2018 09:45

AW: Multithreaded Zeichnen
 
Also, TiGüs Variante funktioniert genausowenig. Parallel kann ich noch sagen, daß es unter macOS ebenso funktioniert.

Der Punkt ist vermutlich nicht das wie die Methode zum Updaten des Image mit der gezeichneten Bitmap aufzurufen ist, sondern ob die Methode selbst so korrekt ist, bzw. den Ansprüchen von iOS genügt.

Sherlock

Rollo62 2. Jul 2018 09:53

AW: Multithreaded Zeichnen
 
Ich habe mir das noch nicht angeschaut, aber es müsste ja in Allen Platformen threadsicher sein.
Das wäre doch ein großer Sprung, das wird womöglich erst in enem späteren Update kommen.

Dies ist jetzt auch der erste Versuch wo das mal jemand austested, soweit ich sagen kann :stupid:

Rollo

TiGü 2. Jul 2018 09:58

AW: Multithreaded Zeichnen
 
Zitat:

Zitat von Sherlock (Beitrag 1406280)
Also, TiGüs Variante funktioniert genausowenig. Parallel kann ich noch sagen, daß es unter macOS ebenso funktioniert.

Der Punkt ist vermutlich nicht das wie die Methode zum Updaten des Image mit der gezeichneten Bitmap aufzurufen ist, sondern ob die Methode selbst so korrekt ist, bzw. den Ansprüchen von iOS genügt.

Sherlock

Interessant wäre, ob das Map und Copy von TBitmapData erfolgreich durchlaufen wird oder fehlschlägt.
Oder irgendwas davor. Der Canvas für iOS ist welcher Art? OpenGL?

Sherlock 2. Jul 2018 10:16

AW: Multithreaded Zeichnen
 
FMX ist nach meinem Verständnis abgesehen von Windows immer OpenGL.

Die Durchläufe sind erfolgreich. Ich kann zB einen Zähler am Ende erhöhen, und dessen Wert in einem Label anzeigen lassen.

Sherlock

Rollo62 2. Jul 2018 18:49

AW: Multithreaded Zeichnen
 
Ich habe damit mal ein bischen rumgespeilt, mit TCriticalSectios, Events, etc.
Auch mit mehreren Teil-Bildern wenn ich die Bilder von mehreren Paintern vorbereite, und dann das Ergebnis per Timer abhole.

Es verhält sich auf Allen Platformen anders, auf OSX und IOS kann es mal Laufen, aber auf Android habe ich es nicht hinbekommen.

Ich vermute mal es liegt am TImage, auch BeginUpdate und Image.Canvas.BeginScene hilft nicht viel.

Vieleicht muss man das besser über ein Bitmap im Hintergrund machen, und da dan dem Image.Bitmap zuweisen.

Es gibt viele Wege, aber Alles hat Vor- und Nachteile, und ist anscheinend recht lahm.
Wäre schön wenn EMBA mal ein Demo dazu rausgeben würden, bei dem die Performance optimal bleibt.

Ansonsten ist das vielleicht ein Ansatz, von Eugene Kryukov, um das Zeichnen von Teilbereichen zu beschleunigen.
Funktioniert bei mir ganz gut, setze ich aber noch nicht produktiv ein.

Edit:
Und GetPixel statt Copy macht auch einen Unterschiede, damit geht es zuverlässiger (aber natürlich langsamer).
Delphi-Quellcode:
                for y := 0 to LDataRead.Height-1 do
                  for x := 0 to LDataRead.Width-1  do
                  begin
                      LDataWrite.SetPixel( x + LOfsX, y + LOfsY, LDataRead.GetPixel( x, y) );
                  end;

// statt               LDataWrite.Copy(LDataRead);
Rollo

EWeiss 2. Jul 2018 20:02

AW: Multithreaded Zeichnen
 
Zitat:

Queue funktioniert hier wohl nicht ....
Ist mir unverständlich warum es nicht gehen sollte.
Ist doch letztendlich nichts anderes als PostMessage!

Kenne mich zwar mit OpenGL aus aber mit FMX habe ich mich nicht beschäftigt da ich das Umfeld nicht habe.

gruss

Harry Stahl 2. Jul 2018 23:54

AW: Multithreaded Zeichnen
 
Zitat:

Zitat von Sherlock (Beitrag 1406269)
Ich versuche die Zeit zu verkürzen, die meine Applikation einfriert, wenn ich zeichne. Da ab Tokyo Bitmaps threadsicher sein sollen, habe ich das zeichnen auf die Bitmap in einen Thread ausgelagert und möchte die fertige Bitmap per Synchonize an die GUI übergeben.

Im Ergebnis sollte eine Bitmap mit wildem Zickzack einmal pro Sekunde neu gezeichnet werden.

Was mache ich falsch?

Ich habe im Moment leider kein IOS-Gerät im Entwicklungs-Einsatz, kann daher meinen Vorschlag nicht selber testen, muss ich Dir also überlassen.
Deine Variante funktioniert jedenfalls auf einem Android-Device, könnte also ggflls. auch ein spezielles IOS-Problem sein.

"Threadsicher" heißt ab 10.2, dass die Zugriffe mehrerer Threads auf einen Canvas intern von Delphi serialisiert werden. Damit hat sich auch die Art, wann man ein Locking vornimmt, etwas geändert, da bei Dir aber nicht mehrere Threads an einer Grafik arbeiten und Du ja gewollt eine Pause von 1 Sekunde haben willst, ist das hier egal (mehr Infos hierzu bei Bedarf in meinem aktuellen FMX-Buch im Grafik-Kapitel unter 6.4).

Diese Änderung hat aber letztlich auch zur Konsequenz, dass Du das temporäre Bitmap gar nicht mehr brauchst, sondern direkt Image1.bitmap zum zeichnen verwenden kannst (eine extra Synchronisierung entfällt also). Damit sollte auch das Zuweisungsproblem von fBMp an Image1.bitmap entfallen, das aus irgendeinem Grund anscheinend nicht unter IOS funktioniert (wäre zwar ein "umgehen" des Problems, aber eine Lösung, die man mal versuchen könnte, ist ja nicht mehr als copy und paste):

Schlage also mal vor zu testen, ob es so auch auf Deinem IOS-Device funktioniert(unter Windows, Linux, Android geht es):

Delphi-Quellcode:
procedure TPainter.Execute;
var
  myPoint1 : TPoint;
  myPoint2 : TPoint;
  i : integer;
begin
  inherited;
  while not Terminated do
  begin
    myPoint1 := TPoint.Zero;
    if Form15.Image1.bitmap.Canvas.BeginScene then
    begin
      Form15.Image1.bitmap.Canvas.Clear(TAlphaColorRec.Null);
      Form15.Image1.bitmap.Canvas.Stroke.Thickness := 1;
      Form15.Image1.bitmap.Canvas.Stroke.Color := TAlphaColorRec.Black;
      try
        for i := 0 to 1000 do
        begin
          myPoint2 := TPoint.Create(Random(Form15.Image1.Bitmap.Width), Random(Form15.Image1.bitmap.Height));
          Form15.Image1.bitmap.Canvas.DrawLine(myPoint1, myPoint2, 1);
          myPoint1 := myPoint2;
        end;
      finally
        Form15.Image1.bitmap.Canvas.EndScene;
      end;
    end;
    //Synchronize(updateGui); // wird nicht benötigt
    Sleep(1000);
  end;
end;
Image1.bitmap muss irgendwo natürlich noch mit einer sinnvollen Größe vorbelegt werden.


Alle Zeitangaben in WEZ +1. Es ist jetzt 14:29 Uhr.
Seite 1 von 3  1 23      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz