AGB  ·  Datenschutz  ·  Impressum  







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

Multithreading lastet nur 1 Kern aus

Ein Thema von Pussyranger · begonnen am 8. Feb 2012 · letzter Beitrag vom 10. Feb 2012
 
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, 19: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
 


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 08:08 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