AGB  ·  Datenschutz  ·  Impressum  







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

Tparallel und Bitmap-Bearbeitung

Ein Thema von Harry Stahl · begonnen am 18. Nov 2014 · letzter Beitrag vom 20. Nov 2014
Antwort Antwort
Benutzerbild von Harry Stahl
Harry Stahl

Registriert seit: 2. Apr 2004
Ort: Bonn
2.560 Beiträge
 
Delphi 12 Athens
 
#1

AW: Tparallel und Bitmap-Bearbeitung

  Alt 19. Nov 2014, 18:51
Ja, in der Tat, hier dauert es nun ca. 570 MS, Beschleunigungsziel wird also nicht erreicht.

Aber auf jeden Fall hast Du schon mal mehr Licht ins Dunkel gebracht, also dafür schon mal vielen Dank. Werde weiter probieren und posten, wenn ich die Lösung habe...
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

Registriert seit: 2. Apr 2004
Ort: Bonn
2.560 Beiträge
 
Delphi 12 Athens
 
#2

AW: Tparallel und Bitmap-Bearbeitung

  Alt 20. Nov 2014, 00:27
Was seltsam ist: Der zuletzt von mir gepostete Code funktioniert ohne Fehler, wenn man vor Aufruf der beiden Tasks die folgenden beiden Zeilen einfügt:

Delphi-Quellcode:
QB := Original.ScanLine[0]; // <-- Die
ZB := Bitmap.ScanLine[0]; // <-- und die Zeile im Code, dann keine Access-Violation
Also eigentlich ziemlich sinnlos, aber durch den Aufruf von Scanline wird "TBitmap.GetScanline aufgerufen und irgendwas dort bewirkt, dass der Zugriff dann stabil ist:

Delphi-Quellcode:
function TBitmap.GetScanLine(Row: Integer): Pointer;
begin
  Changing(Self);
  with FImage.FDIB, dsbm, dsbmih do
  begin
    if (Row < 0) or (Row >= bmHeight) then
      InvalidOperation(@SScanLine);
    DIBNeeded;
    GDIFlush;
    if biHeight > 0 then // bottom-up DIB
      Row := biHeight - Row - 1;
    Result := PByte(bmBits) +
      Row * BytesPerScanline(biWidth, biBitCount, 32);
  end;
end;
Noch besser wird die Performance, wenn man bei einer 4-Core-cpu das Bild in 4 Tasks aufteilt und berechnen lässt.

Optimal wäre also, wenn man anhand der verfügbaren cpu-Kerne das Bild in eine entsprechende Anzahl Bereiche einteilt und dann die entsprechende Anzahl von Tasks dynamisch erzeugt. Da werde ich mich jetzt mal ran machen. Die Performance-Gewinne scheinen vielversprechend zu sein...

Geändert von Harry Stahl (20. Nov 2014 um 00:32 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

Registriert seit: 2. Apr 2004
Ort: Bonn
2.560 Beiträge
 
Delphi 12 Athens
 
#3

AW: Tparallel und Bitmap-Bearbeitung

  Alt 20. Nov 2014, 01:05
OK, so sieht das nun fertig aus, abhängig von der Anzahl der CPUs werden entsprechende Worker-Tasks erzeugt, die dann die einzelnen Bildteile berechnen. Auf einem 4-Kern-PC spürt man wirklich einen deutlichen Unterschied.

Hier die geänderten Teile:

Delphi-Quellcode:
var
  ...
Procedure CreateNewWorkerTask (var T: ITask; L:Integer);
  begin
    T := TTask.Create(procedure ()
    var
      Ziel, Quelle : ^TRGBTriple;
      x, y, Start, Stop: Integer; OK: Boolean;
      begin
        if L = 0 then Start := 0 else Start := L * (Bitmap.Height div cpus);
        if L = 0 then Stop := Bitmap.Height div cpus else Stop := (Bitmap.Height div cpus) * (L+1);

        if Stop > Bitmap.Height-1 then Stop := Bitmap.Height-1;

        for y := Start to Stop do begin
          Ziel := Bitmap.Scanline[y];
          Quelle := Original.Scanline[y];

          for x := 0 to (Bitmap.Width-1) do begin
            if IgnoreWhite then begin
              OK := (Quelle^.rgbtBlue <> 255) or (Quelle^.rgbtGreen <> 255) or (Quelle^.rgbtred <> 255);
            end else begin
              OK := True;
            end;

            if OK 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;

begin
...

    QB := Original.ScanLine[0]; // <-- Die
    ZB := Bitmap.ScanLine[0]; // <-- und die Zeile im Code, dann keine Access-Violation

    cpus := GetCPUCount div GetCPULogicalProcessorCount; // Hier in Delphi-Praxis gefunden

    SetLength(myTasks, cpus);

    for L := 0 to cpus-1 do begin
      CreateNewWorkerTask (myTasks[L], L);
      myTasks[L].Start;
    end;

    TTask.WaitForAll(myTasks);
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

Registriert seit: 2. Apr 2004
Ort: Bonn
2.560 Beiträge
 
Delphi 12 Athens
 
#4

AW: Tparallel und Bitmap-Bearbeitung

  Alt 20. Nov 2014, 21:23
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.

Geändert von Harry Stahl (20. Nov 2014 um 22:03 Uhr)
  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: Tparallel und Bitmap-Bearbeitung

  Alt 20. Nov 2014, 22:07
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 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.
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)

Geändert von Sir Rufo (20. Nov 2014 um 22:15 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von Harry Stahl
Harry Stahl

Registriert seit: 2. Apr 2004
Ort: Bonn
2.560 Beiträge
 
Delphi 12 Athens
 
#6

AW: Tparallel und Bitmap-Bearbeitung

  Alt 20. Nov 2014, 22:48
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).

Geändert von Harry Stahl (20. Nov 2014 um 22:51 Uhr)
  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: Tparallel und Bitmap-Bearbeitung

  Alt 20. Nov 2014, 23:20
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
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
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 21:46 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