Multithreading lastet nur 1 Kern aus

[Medium]

Ich vermute hier doch eher oberflächlichere Gründe als den MM. Aber so lange wir hier keinen Code sehen, unterstelle ich dem TE einfach mal, dass er an einer Lösung so interessiert dann doch nicht ist

[Pussyranger]

Zitat von Sir Rufo:

Ich weiß ja nicht wo du die Probleme mit den Bitmaps und dem ThreadSafe hast, es sei denn, du willst jeden Thread auf die gleichen Bitmap-Instanzen zugreifen lassen.

Ich weiß nicht mehr, wieso es mit Bitmaps nicht funktioniert hat. Aber als ich es mit Colorarrays probiert habe und das sogar schneller war als mit Bitmaps, war mir das auch egal.

Hier der Quellocode:

Unit1 (Threadaufruf):

Delphi-Quellcode:

var
  Thread: array of TDifference_Finder;
  ThreadsRunning,ges,Durchzaehler: integer;

{...}

function BitmapToArrayofColor(Bitmap: TBitmap):Colorarray;
VAR i,j: integer;
begin
  SetLength(result, Bitmap.Width, Bitmap.Height);
  for i := 0 to Bitmap.Width-1 do
    for j := 0 to Bitmap.Height-1 do
      result[i,j]:=Bitmap.Canvas.Pixels[i,j];
end;

function ArrayofColorToBitmap(AoC: ColorArray):TBitmap;
VAR i,j: integer;
begin
  result:=TBitmap.Create;
  result.Width:=Length(AoC);
  result.Height:=Length(AoC[0]);
  for i := 0 to Length(AoC)-1 do
    for j := 0 to Length(AoC[0])-1 do
      result.Canvas.Pixels[i,j]:=AoC[i,j];
end;

procedure TForm1.ThreadDoneD(Sender: TObject);
begin
  Dec(ThreadsRunning);
end;

function Unterschiede_markieren(Bild1, Bild2: TBitmap; Blend: Real; Toleranz: Byte):TBitmap;
VAR i,j,Breite,Hoehe,Itert: integer;
begin
  ThreadCount:=4;
  SetLength(Thread, ThreadCount);

  result:=TBitmap.Create;
  SetLength(fertig_bild,Min(Bild1.Width,Bild2.Width),Min(Bild1.Height,Bild2.Height));
  ThreadsRunning:=ThreadCount;

  for i := 0 to ThreadCount-1 do
  begin         
    Thread[i]:=TDifference_Finder.Create(BitmapToArrayofColor(Bild1), BitmapToArrayofColor(Bild2), Round(i*(Min(Bild1.Width,Bild2.Width))/ThreadCount), Round((i+1)*(Min(Bild1.Width,Bild2.Width)-1)/ThreadCount), Blend, Toleranz, true);
    Thread[i].OnTerminate:=Form1.ThreadDoneD;
    Thread[i].FreeOnTerminate:=true;
    Thread[i].Resume;
  end;
  while ThreadsRunning > 0 do Application.ProcessMessages;
  result:=ArrayofcolorToBitmap(fertig_Bild);
end;

TDifference_Finder:

Delphi-Quellcode:

unit Difference_Finder;

interface

uses
  Windows,Classes, SysUtils, Graphics, Math, JPEG, Unit3;
type
  TDifference_Finder = class(TThread)
  private
    Bild1t, Bild2t, Finish: Colorarray;
    StartXt, EndXt: integer;
    Blendt: Real;
    Toleranzt: Byte;
  protected
    procedure Execute; override;
    procedure fertig;
    procedure Diff;
    function Toleranz_pruefen(C1, C2: TColor; Toleranz: Byte):boolean;
    function ColorBetween(C1, C2: TColor; blend: Real):TColor;
    procedure TColor2RGB(Color: TColor; VAR R, G, B: Byte);
    function RGB2TColor(R, G, B: Byte): Integer;
    function Differenz_finden(C1, C2: TColor; Blend: real; Toleranz: Byte):TColor;
  public
    constructor Create(Bild1, Bild2: Colorarray; StartX, EndX: integer; Blend: Real; Toleranz: Byte; CreateSuspended: Boolean);
  end;

implementation

constructor TDifference_Finder.Create(Bild1, Bild2: Colorarray; StartX, EndX: integer; Blend: Real; Toleranz: Byte; CreateSuspended: Boolean);
begin
  Bild1t:=Bild1;
  Bild2t:=Bild2;
  StartXt:=StartX;
  EndXt:=EndX;
  Blendt:=Blend;
  Toleranzt:=Toleranz;
  inherited Create(True);
end;

function TDifference_Finder.ColorBetween(C1, C2: TColor; blend: Real):TColor;
VAR R, G, B, y1, y2: Byte;
begin
   C1:=ColorToRGB(C1);
   C2:=ColorToRGB(C2);
   y1:=GetRValue(C1);
   y2:=GetRValue(C2);
   R:=Round(y1 + (y2-y1)*blend);
   y1:=GetGValue(C1);
   y2:=GetGValue(C2);
   G:=Round(y1 + (y2-y1)*blend);
   y1:=GetBValue(C1);
   y2:=GetBValue(C2);
   B := Round(y1 + (y2-y1)*blend);
   result:=RGB(r, g, b);
end;

procedure TDifference_Finder.TColor2RGB(Color: TColor; VAR R, G, B: Byte);
begin
  if Color SHR 24 = $FF then Color:=GetSysColor(Color AND $FF)
  else if Color SHR 24 > $02 then Color := 0;
  R:=Color;
  G:=(Color SHR 8);
  B:=(Color SHR 16);
end;

function TDifference_Finder.RGB2TColor(R, G, B: Byte): Integer;
begin
  result:=R OR (G SHL 8) OR (B SHL 16);
end;

function TDifference_Finder.Differenz_finden(C1, C2: TColor; Blend: real; Toleranz: Byte):TColor;
VAR R1,G1,B1,R2,G2,B2: Byte; Proz: extended;
begin
  TColor2RGB(C1,R1,G1,B1);
  TColor2RGB(C2,R2,G2,B2);
  Proz:=0;
  Proz:=Proz+33.33*(((Abs(R1-R2)))/255);
  Proz:=Proz+33.33*(((Abs(G1-G2)))/255);
  Proz:=Proz+33.33*(((Abs(B1-B2)))/255);

  Proz:=Proz-Toleranz;
  if Proz < 0 then Proz:=0;

  if Proz < 50 then result:=RGB2TColor(Round(Proz/100*255),255,0)
  else if Proz > 50 then result:=RGB2TColor(255,255-Round(Proz/100*255),0);
  result:=ColorBetween(result, C2, 1-Blend);
end;

function TDifference_Finder.Toleranz_pruefen(C1, C2: TColor; Toleranz: Byte):boolean;
VAR R1,G1,B1,R2,G2,B2: Byte; Proz: extended;
begin
  TColor2RGB(C1,R1,G1,B1);
  TColor2RGB(C2,R2,G2,B2);
  Proz:=0;
  Proz:=Proz+33.33*(((Abs(R1-R2)))/255);
  Proz:=Proz+33.33*(((Abs(G1-G2)))/255);
  Proz:=Proz+33.33*(((Abs(B1-B2)))/255);

  if Proz <=Toleranz then result:=true else result:=false;
end;

procedure  TDifference_Finder.fertig;
VAR i,j:integer;
begin
  for i := StartXt to EndXt do
    for j := 0 to Length(fertig_Bild[0]) do
      fertig_Bild[i,j]:=Finish[i-StartXt,j];
end;

procedure TDifference_Finder.Diff; //<---------------- hier findet der Vergleich statt
VAR i,j: integer;
begin
  SetLength(Finish, EndXt-StartXt+1, Min(Length(Bild1t[0]),Length(Bild2t[0])));

  for i := StartXt to EndXt do
    for j := 0 to Length(Bild2t[0]) do
      if Toleranz_pruefen(Bild1t[i,j], Bild2t[i,j], Toleranzt) then Finish[i-StartXt,j]:=Bild2t[i,j]
      else Finish[i-StartXt,j]:=Differenz_finden(Bild1t[i,j],Bild2t[i,j], Blendt, Toleranzt);
end;

procedure TDifference_Finder.Execute;
begin
  Diff;
  Synchronize(fertig);
end;

end.

Unit3 (Unit1 und TDifference_Finder haben darauf zugriff):

Delphi-Quellcode:

unit Unit3;

interface

uses Vcl.Graphics;

type Colorarray = array of array of TColor;

VAR fertig_Bild: Colorarray; ThreadCount: integer;

implementation

end.

[Namenloser]

Hast du mal gemessen, welcher Teil des Codes welchen Anteil an der Gesamtlaufzeit hat? Vielleicht sind die Threads so schnell fertig, dass du davon gar nichts bemerkst, aber der Rest, der im Main-Thread läuft, braucht die meiste Zeit. Kann sein, dass du hier die völlig falsche Stelle optimiert hast! Ein Tipp, um in Zukunft gleich den Flaschenhals zu finden: Sampling Profiler. (Bei Benutzung in den Compiler-Optionen unbedingt die Mapfile-Generierung aktivieren, sonst hast du sehr wenig davon).

Delphi-Quellcode:

function BitmapToArrayofColor(Bitmap: TBitmap):Colorarray;
VAR i,j: integer;
begin
  SetLength(result, Bitmap.Width, Bitmap.Height);
  for i := 0 to Bitmap.Width-1 do
    for j := 0 to Bitmap.Height-1 do
      result[i,j]:=Bitmap.Canvas.Pixels[i,j];
end;

function ArrayofColorToBitmap(AoC: ColorArray):TBitmap;
VAR i,j: integer;
begin
  result:=TBitmap.Create;
  result.Width:=Length(AoC);
  result.Height:=Length(AoC[0]);
  for i := 0 to Length(AoC)-1 do
    for j := 0 to Length(AoC[0])-1 do
      result.Canvas.Pixels[i,j]:=AoC[i,j];
end;

Das wären so Kandidaten. Der Zugriff über TCanvas.Pixels ist nämlich unheimlich lahm. Schau dir mal TBitmap.Scanline an. Damit kannst du dir wahrscheinlich auch dein ColorArray sparen. Allerdings musst du das Bitmap dann zeilenweise bearbeiten – aktuell scheinst du ja spaltenweise vorzugehen (was übrigens auch aus Caching-Gründen ineffizient ist, da das Bitmap zeilenweise im Speicher liegt. Sprich: eine Bildzeile kann einfach „in einem Rutsch“ eingelesen werden, während bei Pixeln aus verschiedenen Zeilen immer hin und her gesprungen werden muss. Das dürfte hier zwar kaum ins Gewicht fallen, weil andere Stellen viel stärker bremsen, aber dennoch kann man es mal erwähnen).

[Pussyranger]

Danke! Ich hatte überhaupt nicht damit gerechnet, dass es an der Umwandlung liegt :O
Der Geschwindigkeitsunterschied ist gigantisch Leider sind die Threads jetzt absolut überflüssig ^^

Habe den Code jetzt angespasst, aber bei der Rückumwandlung vom Colorarray zum Bitmap gibts jedoch noch einen kleinen Fehler, da das Bild einen gelbstich hat:

Delphi-Quellcode:

procedure TColor2RGB(Color: TColor; VAR R, G, B: Byte);
begin
  if Color SHR 24 = $FF then Color:=GetSysColor(Color AND $FF)
  else if Color SHR 24 > $02 then Color := 0;
  R := Color;
  G := (Color shr 8);
  B := (Color shr 16);
end;

function ArrayofColorToBitmap(AoC: ColorArray):TBitmap;
type
  PixArray = Array [1..3] of Byte;
VAR i,j:integer; p: ^PixArray; R,G,B: Byte;
begin
  result:=TBitmap.Create;
  result.PixelFormat := pf24Bit;
  result.Width:=Length(AoC);
  result.Height:=Length(AoC[0]);
  for i := 0 to Length(AoC[0])-1 do
  begin
    p:= result.ScanLine[i];
    for j := 0 to Length(AoC)-1 do
    begin
      TColor2RGB(Aoc[j,i], R, G, B);
      p^[1]:=B; //<-------- die Kanäle sind schon vertauscht
      p^[2]:=G;
      p^[3]:=R;
      Inc(p);
    end;
  end;
end;

Woran liegt das?

[divBy0]

Vergleich doch mal die Farbwerte von dem ArrayOfColor und dem Originalbitmap. Irgendwo muss ja was mit rot und grün schief gehen.

[Namenloser]

Kann ich jetzt auf Anhieb auch nicht erkennen. Teste doch erst mal, ob es an der Zuweisung oder an der Berechnung liegt, indem du R, B und G jeweils $FF (255) zuweist. Das Bild sollte dann ja weiß sein. Wenn es das nicht ist, weißt du zumindest, wo du suchen musst.

Mal ganz allgemein ein paar Dinge:

Delphi-Quellcode:

// 1. Das T sollte aus dem Funktionsnamen entfernt werden, da die Funktion sonst
// .. für einen Typen halten könnte. Außerdem gibt es keinen Grund "To" als "2"
// .. abzukürzen.
// 2. Ich würde statt "var" "out" verwenden, damit klar ist, dass diese Parameter
// .. ausschließlich der Ausgabe und nicht der Eingabe dienen.
procedure TColor2RGB(Color: TColor; VAR R, G, B: Byte);
begin
  if Color SHR 24 = $FF then Color:=GetSysColor(Color AND $FF)
  else if Color SHR 24 > $02 then Color := 0;
  // Funktioniert zwar, aus Gründen der Verständlichkeit würde ich aber
  // and $FF ans Ende dieser Zeilen anfügen, damit klar ist, dass
  // Der Wert auf 0..255 beschränkt ist.
  R := Color;
  G := (Color shr 8);
  B := (Color shr 16);
end;

function ArrayofColorToBitmap(AoC: ColorArray):TBitmap;
type
  // 1. Ein Array mit einem Start-Index von 1 ist unüblich.
  // .. Nimm stattdessen besser [0..2]
  // 2. Bei solchen Strukturen, wo es sehr darauf ankommt, dass
  // .. die Daten in einer bestimmten Anordnung im Speicher liegen
  // .. immer packed array bzw. packed record statt einem normalen
  // .. array/record verwenden.
  // .. Sonst kannst du nie sicher sein, dass die Bytes auch wirklich
  // .. direkt hintereinander liegen, ohne irgendwelche Lücken dazwischen.
  // 3. Es gibt bereits einen Datentyp der hierfür geeignet ist, er heißt
  // .. TRGBTriple.
  // 4. Typen beginnen per Konvention mit dem Präfix T. Der Typ sollte also
  // .. TPixArray heißen, und nicht PixArray.
  PixArray = Array [1..3] of Byte;
VAR i,j:integer; p: ^PixArray; R,G,B: Byte;
begin
  result:=TBitmap.Create;
  // Effizienter ist pf32Bit, weil der Speicher auf 32 Bit aligned ist.
  // D.h. 32 Bit können mit einem Lesebefehl eingelesen werden, bei
  // 24 Bit sind ggf. 2 Lese-Befehle nötig.
  // Ein weiterer Vorteil ist, dass nicht mehr unbedingt einen eigenen 
  // Datentyp wie PixArray für die Verarbeitung brauchst, sondern einfach
  // einen Integer/Cardinal oder TColor nehmen kannst, die ebenfalls
  // 32 Bit breit sind. Alternativ kannst du TRGBQuad verwenden, womit
  // du komfortabel auf die einzelnen Bytes R, G, B und A zugreifen kannst.
  // Wenn du weiterhin dein PixArray verwendest, musst du es natürlich
  // auf 4 Elemente erweitern.
  result.PixelFormat := pf24Bit;
  result.Width:=Length(AoC);
  result.Height:=Length(AoC[0]);
  for i := 0 to Length(AoC[0])-1 do
  begin
    p:= result.ScanLine[i];
    for j := 0 to Length(AoC)-1 do
    begin
      TColor2RGB(Aoc[j,i], R, G, B);
      p^[1]:=B; //<-------- die Kanäle sind schon vertauscht
      p^[2]:=G;
      p^[3]:=R;
      Inc(p);
    end;
  end;
end;

Und grundsätzlich könntest du dir die ganze Konvertiererei auch sparen, wenn du direkt mit der Scanline arbeiten würdest.

[Pussyranger]

Danke für die zahlreichen Verbesserungsvorschläge! Den Fehler habe ich gefunden, es lag tatsächlich an der 1. Umwandlung

Ich wollte es jetzt nochmal nur mit Bitmaps (ohne Colorarray) versuchen, da ich gehofft hatte, dass man bei Threads weniger Probleme mit Scanline als mit direktem Zugriff auf das Canvas hat.
Wirklich erfolgreich war ich aber nicht, denn da kommen die komischsten Bilder raus...

Wäre nett wenn da nochmal jemand kurz drüber schauen könnte, ansonsten lass ichs halt so wies vorher war.

Delphi-Quellcode:

constructor TDifference_Finder.Create(Bild1, Bild2: TBitmap; StartY, EndY: integer; Blend: Real; Toleranz: Byte; CreateSuspended: Boolean);
begin
  Bild1t:=TBitmap.Create;
  Bild1t.Assign(Bild1);
  Bild2t:=TBitmap.Create;
  Bild2t.Assign(Bild2);
  StartYt:=StartY;
  EndYt:=EndY;
  Blendt:=Blend;
  Toleranzt:=Toleranz;
  inherited Create(True);
end;

procedure TDifference_Finder.fertig;
VAR i,j:integer;
begin
  fertig_Bild.Canvas.Draw(0, StartYt, Finish);
end;

function TDifference_Finder.BGRToColor(const BGR : Integer) : TColor;
begin
  result := (BGR and $FF000000) + ((BGR and $000000FF) shl 16) + (BGR and $0000FF00) + ((BGR and $00FF0000) shr 16);
end;
procedure TDifference_Finder.ColorToRGB2(Color: TColor; OUT R, G, B: Byte);//<--------------"ColorToRGB" ist schon eine delphiinterne Funktion, daher die 2 am Ende
begin
  if Color SHR 24 = $FF then Color:=GetSysColor(Color AND $FF)
  else if Color SHR 24 > $02 then Color := 0;
  R := Color AND $FF;
  G := (Color shr 8) AND $FF;
  B := (Color shr 16) AND $FF;
end;

procedure TDifference_Finder.Diff;
type
  TPixArray = packed Array [0..3] of Byte;
var
  i,j,zwf1,zwf2: integer;
  p1,p2: PIntegerArray;
  p: ^TPixArray;
  R,G,B: Byte;
begin
  Finish:=TBitmap.Create;
  Finish.PixelFormat:=pf32Bit;
  Finish.Width:=Bild2t.Width;
  Finish.Height:=EndYt-StartYt+1;
  for i := StartYt to EndYt do
  begin
    p1:=Bild1t.ScanLine[i];
    p2:=Bild2t.ScanLine[i];
    p:=Finish.ScanLine[i-StartYt];
    for j := 0 to Bild2t.Width-1 do
    begin
      zwf1:=BGRToColor(p1[j]);//<-------------- hier werden falsche werte eingetragen (glaub ich)
      zwf2:=BGRToColor(p2[j]);//<--------------/

      if Toleranz_pruefen(zwf1, zwf2, Toleranzt) then ColorToRGB2(zwf2, R, G, B)
      else ColorToRGB2(Differenz_finden(zwf1, zwf2, Blendt, Toleranzt), R, G, B);

      p^[0]:=B;
      p^[1]:=G;
      p^[2]:=R;
      p^[3]:=0;
      Inc(p);
    end;
  end;
end;

procedure TDifference_Finder.Execute;
begin
  Diff;
  Synchronize(fertig);
end;

[DeddyH]

Wenn ich mich nicht irre, ist TColor bereits im Format BGR, du moppelst somit doppelt.