Einzelnen Beitrag anzeigen

Benutzerbild von Pussyranger
Pussyranger

Registriert seit: 15. Mär 2011
25 Beiträge
 
Delphi XE2 Architect
 
#13

AW: Multithreading lastet nur 1 Kern aus

  Alt 10. Feb 2012, 20:15
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;
  Mit Zitat antworten Zitat