Finde forskelle i billeder

procedure TForm1.Button1Click(Sender: TObject);
var
b1,b2: tbitmap;
i,j: integer;
begin
memo1.Clear;
b1 := tbitmap.Create;
b2 := tbitmap.Create;
b1.LoadFromFile('b1.bmp');
b2.LoadFromFile('b2.bmp');
for i := 1 to b1.Width do
  for j := 1 to b1.height do
  if b1.Canvas.Pixels[i,j] <> b2.Canvas.Pixels[i,j] then
  memo1.lines.add('pixel: ' + inttostr(i) + ',' + inttostr(j) + ' er anderledes');
  b1.Free;
  b2.Free;
end;

kræver at du har en memo på din form

ok.. virker fint, går bare hamme langsomt... :(

ved det, men det er vist den eneste måde at gøre det på

Det her er vist lidt hurtigere :

{$R-}
type
  pPoint = ^TPoint;
  pScanLine = ^TScanLine;
  TScanLine = array[0..0] of TRGBTriple;

procedure FindDiffrences(const b1, b2: TBitmap; DiffList: TList);
var
  B1Row, B2Row: pScanLine;
  i, j: Integer;
  Point: pPoint;

  function SamePixel: Boolean;
  begin
    Result :=
      RGB(B1Row[j].rgbtRed, B1Row[j].rgbtGreen, B1Row[j].rgbtBlue)
    xor
      RGB(B2Row[j].rgbtRed, B2Row[j].rgbtGreen, B2Row[j].rgbtBlue) <> 0;
  end;
begin
  for i := 0 to B1.Height - 1 do
  begin
    B1Row := B1.ScanLine[i];
    B2Row := B2.ScanLine[i];
    for j := 0 to B1.Width - 1 do
    begin
      if not SamePixel then
      begin
        Point := new(pPoint);
        Point^.x := i;
        Point^.y := j;
        DiffList.Add(Point);
      end;
    end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  b1, b2: TBitmap;
  DiffList: TList;
begin
  b1 := tbitmap.Create;
  b2 := tbitmap.Create;
  DiffList := Tlist.Create;
  b1.LoadFromFile('b1.bmp');
  b2.LoadFromFile('b2.bmp');
  FindDiffrences(b1, b2, DiffList);

  //do stuff with DiffList

  FreeAndNil(DiffList);
  FreeAndNil(b1);
  FreeAndNil(b2);
end;



Jens B

hov ja
.
.
.
.
  for i := 0 to DiffList.Count do
    dispose(pPoint(DiffList[i]));

  FreeAndNil(DiffList);
  FreeAndNil(b1);
  FreeAndNil(b2);
end;


selvfølgelig