Multithreading lastet nur 1 Kern aus

[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.

[Pussyranger]

Ich glaub, da irrst du dich

Nichtsdestotrotz würde dann nicht so ein Bild entstehen:

Edit: Alles klar, Fehler gefunden. Hab vergessen das Pixelformat der Vergleichsbilder auf pf32Bit zu stellen. Danke für eure Hilfe!