Thema: FreePascal Bitmaps vergleichen

Einzelnen Beitrag anzeigen

SMO

Registriert seit: 20. Jul 2005
178 Beiträge
 
Delphi XE6 Professional
 
#2

AW: Bitmaps vergleichen

  Alt 28. Nov 2015, 17:09
Bei mir funktioniert das problemlos.
Habe es minimal modifiziert, um es testen zu können:

Delphi-Quellcode:
var
  BmpA, BmpB: TBitmap;

procedure Test(BmpIn, BmpInOut: TBitmap; Threshold: Byte; Color: TColor);
var
  x, y: Integer;
  PixelA, PixelB: PRGBTriple;
begin
  Assert(BmpIn.Width = BmpInOut.Width);
  Assert(BmpIn.Height = BmpInOut.Height);
  BmpIn.PixelFormat := pf24bit;
  BmpInOut.PixelFormat := pf24bit;
  Color := ColorToRGB(Color);
  for y := 0 to BmpIn.Height-1 do
  begin
    PixelA := BmpIn.ScanLine[y];
    PixelB := BmpInOut.ScanLine[y];
    for x := 0 to BmpIn.Width - 1 do
    begin
      if (Abs(PixelA.rgbtBlue - PixelB.rgbtBlue) <= Threshold) and
         (Abs(PixelA.rgbtGreen - PixelB.rgbtGreen) <= Threshold) and
         (Abs(PixelA.rgbtRed - PixelB.rgbtRed) <= Threshold) then
      begin
        PixelB.rgbtBlue := GetBValue(Color);
        PixelB.rgbtGreen := GetGValue(Color);
        PixelB.rgbtRed := GetRValue(Color);
      end;
      Inc(PixelA);
      Inc(PixelB);
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  BmpA := TBitmap.Create;
  BmpA.LoadFromFile('d:\test1.bmp');
  BmpB := TBitmap.Create;
  BmpB.LoadFromFile('d:\test2.bmp');
  Test(BmpA, BmpB, 10, clGreen);
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Draw(0, 0, BmpA);
  Canvas.Draw(BmpA.Width, 0, BmpB);
end;
  Mit Zitat antworten Zitat