FMX-TBitmap: Nach Gebrauch von Canvas ins threads unbrauchbar?

[Renate Schaaf]

Der Vollständigkeit halber hier die Version, die bei mir bis jetzt verlässlich läuft:

Meine pointer-version der Rotation hat zu dem Problem beigetragen, wieso verstehe ich im Moment nicht, aber das ist ein andere Frage.

Delphi-Quellcode:

var
  Form2: TForm2;

implementation

{$R *.fmx}

uses System.threading, System.UIConsts;

// Ohne pointers ist es sicherer
procedure Rotate(const bm: TBitmap);
var
  x, y, b, h: integer;
  DataSource, DataTarget: TBitmapData;
  help: TBitmap;
begin
  b := bm.height;
  h := bm.width;
  help := TBitmap.Create;
  try
    help.SetSize(b, h);
    Assert(bm.Map(TMapAccess.ReadWrite, DataSource));
    Assert(help.Map(TMapAccess.ReadWrite, DataTarget));
    for y := 0 to h - 1 do
    begin
      for x := 0 to b - 1 do
      begin
        DataTarget.SetPixel(x, y, DataSource.GetPixel(y, b - 1 - x));
      end;
    end;
    help.Unmap(DataTarget);
    bm.Unmap(DataSource);
    bm.Assign(help);
  finally
    help.free;
  end;
end;

procedure TextOnBitmapSimple(const bm: TBitmap; const text: String;
  cb, ct: Cardinal);
begin
  bm.Canvas.BeginScene;
  bm.Canvas.Clear(cb);
  bm.Canvas.Font.Size := 30;
  bm.Canvas.Fill.Color := ct;
  bm.Canvas.FillText(RectF(0, 0, bm.width, bm.height), text, False, 1, [],
    TTextAlign.Center, TTextAlign.Center);
  bm.Canvas.EndScene;
end;

// Ohne die mit // ? markierten Stellen geht der Canvas-Inhalt unter Android verloren
procedure TextOnBitmap(const bm: TBitmap; const text: String; cb, ct: Cardinal);
var
  am: TBitmap;
begin
  // ?Im Haupt-Thread ausführen
  TThread.Synchronize(TThread.Current,
    procedure
    begin
      // ?Den Canvas von einer temporären Bitmap benutzen
      am := TBitmap.Create;
      try
        am.SetSize(bm.width, bm.height);
        TextOnBitmapSimple(am, text, cb, ct);
        // ?Pixel rüberkopieren
        bm.CopyFromBitmap(am);
      finally
        am.free;
      end;
    end);
end;

// Gucken was los ist
procedure TForm2.ShowProgress(i: integer; const bm: TBitmap);
begin
  TThread.Synchronize(TThread.Current,
    procedure
    begin
      ProgressBar1.Value := i;
      ImageControl2.Bitmap := bm;
      // refcount ist immer 3, wieso?
      Label2.text := IntToStr(bm.Image.refcount);
      sleep(500);
    end);
end;

procedure TForm2.Button5Click(Sender: TObject);
var
  bm: TBitmap;
  i, count: integer;
  aThread: TThread;
begin
  ImageControl2.Bitmap := nil;
  aThread := TThread.CreateAnonymousThread(
    procedure
    begin
      count := trunc(SpinCount.Value);
      bm := TBitmap.Create;
      bm.SetSize(600, 400);
      TextOnBitmap(bm, 'This works', claYellow, claBlue);
      i := 0;
      while i < count do
      begin
        ShowProgress(i, bm);
        Rotate(bm);
        inc(i);
      end;
      ShowProgress(count, bm);
      bm.free;
    end);
  aThread.Start;
end;