Multithreading lastet nur 1 Kern aus

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