Delphi-PRAXiS
Seite 3 von 3     123   

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Algorithmen, Datenstrukturen und Klassendesign (https://www.delphipraxis.net/78-algorithmen-datenstrukturen-und-klassendesign/)
-   -   Tparallel und Bitmap-Bearbeitung (https://www.delphipraxis.net/182796-tparallel-und-bitmap-bearbeitung.html)

Harry Stahl 20. Nov 2014 21:23

AW: Tparallel und Bitmap-Bearbeitung
 
Also, um das noch abzuschließen: Offensichtlich ist Scanline nicht threadsafe. Daher habe ich Scanline nur einmal außerhalb des Task-Threads verwendet und innerhalb des Tasks greife ich berechnet auf den DIB-Speicher zu.

Auf einer 6-Kern CPU wird das Bild dann mit ca. 40 MS bearbeitet, also mit Parallel-Bearbeitung 4 mal schneller als ohne.

Hier die fertige Lösung für 24 und 32-Bit-Bitmap (32-Bit wird noch ca. 20% schneller berechnet).

Delphi-Quellcode:
// Bitmap = Zielbitmap; Original = Quelle, Value zwischen -240 und + 240
procedure Helligkeit(Bitmap: TBitmap; Const Original : TBitmap; Value: integer; IgnoreWhite: Boolean);
var
  L,xx,LL,UsedCPUs : integer; n : byte;
  ar : array[0..255] of byte;
  myTasks: array of ITask;
  Dest, Src: Pointer;

  Procedure CreateNewWorkerTask24 (var T: ITask; L:Integer);
  begin
    T := TTask.Create(procedure ()
    var
      Ziel, Quelle : ^TRGBTriple;
      x, y, Start, Stop: Integer;
    begin
      if Bitmap.Height = 1 then begin
        Start := 0; Stop := 0;
      end else begin
        if L = 0 then Start := 0 else Start := (L * (Bitmap.Height div UsedCpus)) + 1;
        if L = 0 then Stop := Bitmap.Height div UsedCpus else Stop := (Bitmap.Height div UsedCpus) * (L+1);
        if Stop > Bitmap.Height-1 then Stop := Bitmap.Height-1;
      end;

      for y := Start to Stop do begin
        Ziel := Pointer(Integer(Dest) + LL * Y);
        Quelle := Pointer(Integer(Src) + LL * Y);

        for x := 0 to (Bitmap.Width-1) do begin
          if (IgnoreWhite = false) or (Quelle^.rgbtBlue <> 255) or (Quelle^.rgbtGreen <> 255) or (Quelle^.rgbtred <> 255) then begin
            Ziel^.rgbtBlue := ar[Quelle^.rgbtBlue];
            Ziel^.rgbtred  := ar[Quelle^.rgbtred];
            Ziel^.rgbtGreen := ar[Quelle^.rgbtGreen];
          end;

          inc(Ziel);
          inc(Quelle);
        end;
      end;
    end
    );
  end;

  Procedure CreateNewWorkerTask32 (var T: ITask; L:Integer);
  begin
    T := TTask.Create(procedure ()
    var
      RGBAQuelle, RGBAZiel: pRGBALine;
      x, y, Start, Stop: Integer;
    begin
      if Bitmap.Height = 1 then begin
        Start := 0; Stop := 0;
      end else begin
        if L = 0 then Start := 0 else Start := (L * (Bitmap.Height div UsedCpus)) + 1;
        if L = 0 then Stop := Bitmap.Height div UsedCpus else Stop := (Bitmap.Height div UsedCpus) * (L+1);
        if Stop > Bitmap.Height-1 then Stop := Bitmap.Height-1;
      end;

      for y := Start to Stop do begin
        RGBAZiel := Pointer(Integer(Dest) + LL * Y); //Bitmap.ScanLine[y];
        RGBAQuelle := Pointer(Integer(Src) + LL * Y); //Original.Scanline[y];

        for x := 0 to (Bitmap.Width-1) do begin
          if RGBAZiel^[x].rgbReserved <> 0 then begin
            if (IgnoreWhite = false) or (RGBAQuelle^[x].rgbBlue <> 255) or (RGBAQuelle^[x].rgbgreen <> 255) or (RGBAQuelle^[x].rgbred <> 255) then begin
              RGBAZiel^[x].rgbBlue := ar[RGBAQuelle^[x].rgbBlue];
              RGBAZiel^[x].rgbred := ar[RGBAQuelle^[x].rgbred];
              RGBAZiel^[x].rgbgreen := ar[RGBAQuelle^[x].rgbgreen];
            end;
          end;
        end;
      end;
    end
    );
  end;

begin
  n := abs(value);

  //Fall berücksichtigen, dass Bitmap nur 1 Zeile hoch oder weniger Zeilen als CPUS an Board
  if Bitmap.Height < CPUsOnBoard then UsedCPUs := Bitmap.height else UsedCPUs := CPUsOnBoard;

  if value > 0 then begin
    for xx := 0 to 255 do if integer(xx + n) > 255 then ar[xx] := 255 else ar[xx] := xx + n
  end else begin
    for xx := 0 to 255 do if integer(xx - n) < 0 then ar[xx] := 0 else ar[xx] := xx - n;
  end;

  Dest := Bitmap.ScanLine[0];
  Src := Original.ScanLine[0];

  if Bitmap.Height = 1 then begin
    LL := 0;
  end else begin
    LL := Integer(Bitmap.ScanLine[1]) - Integer(Dest);
  end;

  SetLength(myTasks, UsedCpus);

  for L := 0 to UsedCpus-1 do begin
    if Bitmap.pixelformat = pf32bit then begin
      CreateNewWorkerTask32 (myTasks[L], L);
    end else begin
      CreateNewWorkerTask24 (myTasks[L], L);
    end;
    myTasks[L].Start;
  end;

  TTask.WaitForAll(myTasks);
end;
Wenn ich das richtig verstanden habe, muss man hinterher nicht "aufräumen"? Ein Free für den Task gibt es nicht.

Sir Rufo 20. Nov 2014 22:07

AW: Tparallel und Bitmap-Bearbeitung
 
Nun ja, warum sollte das auch threadsafe ausgelegt sein? Das ist Bestandteil der VCL und die ist eben auf einen Thread ausgelegt.

Und bei einem
Delphi-Quellcode:
interface
gehe ich erstmal davon aus, dass sich das von selber entfernt (ja, es gibt Ausnahmen) und macht gerade bei den Tasks auch Sinn.

Noch was zu den Tasks:
  • Die 24 und 32 Varianten kann man bestimmt zusammenfassen
  • Du kannst dir einen eigenen ThreadPool erzeugen und dort Min/Max der Workerthreads festlegen auf die Anzahl der CPU-Kerne. Wenn du dann die Tasks übergibst, dann stehen auch sofort diese Threads zur Verfügung und arbeiten die Tasks direkt ab. Ansonsten wartet der ThreadPool und analysiert das System, ob denn noch ein weiterer Thread gestartet werden könnte. Ist der Thread einmal erzeugt, dann bleibt der bis zum Ende des ThreadPools.

Harry Stahl 20. Nov 2014 22:48

AW: Tparallel und Bitmap-Bearbeitung
 
Zitat:

Zitat von Sir Rufo (Beitrag 1280551)
Noch was zu den Tasks:
  • Die 24 und 32 Varianten kann man bestimmt zusammenfassen
  • Du kannst dir einen eigenen ThreadPool erzeugen und dort Min/Max der Workerthreads festlegen auf die Anzahl der CPU-Kerne. Wenn du dann die Tasks übergibst, dann stehen auch sofort diese Threads zur Verfügung und arbeiten die Tasks direkt ab. Ansonsten wartet der ThreadPool und analysiert das System, ob denn noch ein weiterer Thread gestartet werden könnte. Ist der Thread einmal erzeugt, dann bleibt der bis zum Ende des ThreadPools.

Zusammenfassen der Bit-Varianten wäre zwar möglich, aber bei 24-Bit Bitmaps mit Performance-Verlust verbunden. Bei einer 32-Bitmap kann das System die 4*8 Byte gut in einem Rutsch in die Register einer 32-Bit oder 64-Bit CPU laden. Daher ist dann der Zugriff per Array in den Speicherbereich die effizienteste Lösung. Bei der 24-Bit-Bitmap käme das wegen der nicht passenden Registerbreite nicht so gut hin, daher ist es dort schneller, per Pointer-Addition auf den Speicherbereich zu zeigen und jeweils das entsprechende Byte direkt zu bearbeiten.

Oder gibt es da noch eine zusammenfassende Lösung, die ich noch nicht kenne?

Das mit den ThreadPools werde ich mir mal ansehen. Ich denke, die Parallel-Unit werde ich mir nach und nach erschließen, denn das alles ist sehr vielversprechend und ja auch viel leichter zu handhaben als die Verwendung eines Threads (also zumindest, was die Erzeugung eines Tasks im Vergleich mit einem Thread betrifft).

Sir Rufo 20. Nov 2014 23:20

AW: Tparallel und Bitmap-Bearbeitung
 
Nun ja, man konnte ja seit geraumer Zeit schon einen anonymen Thread erstellen, allerdings ist das etwas völlig anderes als das mit den Tasks.

Dort macht man jetzt genau das, was man eigentlich möchte: Eine Aufgabe erstellen, die in einem anderen Thread-Kontext ausgeführt werden soll :)


Alle Zeitangaben in WEZ +1. Es ist jetzt 15:21 Uhr.
Seite 3 von 3     123   

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