Tparallel und Bitmap-Bearbeitung

[Harry Stahl]

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.