AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren

Multithreading lastet nur 1 Kern aus

Ein Thema von Pussyranger · begonnen am 8. Feb 2012 · letzter Beitrag vom 10. Feb 2012
Antwort Antwort
Seite 2 von 2     12
Benutzerbild von divBy0
divBy0

Registriert seit: 4. Mär 2007
Ort: Sponheim
1.021 Beiträge
 
Delphi XE2 Professional
 
#11

AW: Multithreading lastet nur 1 Kern aus

  Alt 10. Feb 2012, 14:39
Vergleich doch mal die Farbwerte von dem ArrayOfColor und dem Originalbitmap. Irgendwo muss ja was mit rot und grün schief gehen.
Marc
9 von 10 Stimmen in meinem Kopf sagen ich bin nicht verrückt, die 10. summt die Melodie von Tetris... | Wenn das die Lösung ist, dann hätte ich gerne mein Problem zurück! | engbarth.es
  Mit Zitat antworten Zitat
Namenloser

Registriert seit: 7. Jun 2006
Ort: Karlsruhe
3.724 Beiträge
 
FreePascal / Lazarus
 
#12

AW: Multithreading lastet nur 1 Kern aus

  Alt 10. Feb 2012, 14:51
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.
  Mit Zitat antworten Zitat
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
Benutzerbild von DeddyH
DeddyH

Registriert seit: 17. Sep 2006
Ort: Barchfeld
27.463 Beiträge
 
Delphi 11 Alexandria
 
#14

AW: Multithreading lastet nur 1 Kern aus

  Alt 10. Feb 2012, 20:22
Wenn ich mich nicht irre, ist TColor bereits im Format BGR, du moppelst somit doppelt.
Detlef
"Ich habe Angst vor dem Tag, an dem die Technologie unsere menschlichen Interaktionen übertrumpft. Die Welt wird eine Generation von Idioten bekommen." (Albert Einstein)
Dieser Tag ist längst gekommen
  Mit Zitat antworten Zitat
Benutzerbild von Pussyranger
Pussyranger

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

AW: Multithreading lastet nur 1 Kern aus

  Alt 10. Feb 2012, 20:29
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!
Miniaturansicht angehängter Grafiken
unbenannt2.png  

Geändert von Pussyranger (11. Feb 2012 um 18:24 Uhr)
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

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:59 Uhr.
Powered by vBulletin® Copyright ©2000 - 2022, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf