比较两张图片的相似程序

直接使用ImageEn的源代码，如果是单独使用这一个功能又不想安装整个组件包的话


unit CompareImage;

interface

uses Classes, SysUtils, Math, Graphics;

function ConvertToBmp(img: TGraphic; W, H: Integer): TBitmap;
function CompareImages(image1, image2: TBitmap; diffmap: TBitmap): double;

implementation

type
  PRGB = ^TRGB;
  TRGB = packed record
    B: Byte;
    G: Byte;
    R: Byte
  end;
const
  gRedToGrayCoef = 21;
  gGreenToGrayCoef = 71;
  gBlueToGrayCoef = 8;

function ConvertToBmp(img: TGraphic; W, H: Integer): TBitmap;
begin
  Result := TBitmap.Create;
  Result.Width := W;
  Result.Height := H;
  Result.PixelFormat := pf24bit;
  Result.Canvas.StretchDraw(Result.Canvas.ClipRect, img);
end;

function CompareImages(image1, image2: TBitmap; diffmap: TBitmap): double;
var
  x, y: integer;
  w, h: integer;
  prgb1, prgb2: PRGB;
  i1, i2: integer;
  di: integer;
  d: double;
  dm: pbyte;
begin
  result := 0;
  if (image1.PixelFormat <> pf24bit) or (image2.PixelFormat <> pf24bit) then
    exit;
  if Assigned(diffmap) and (diffmap.PixelFormat<>pf8bit) and (diffmap.PixelFormat<>pf8bit) then
    diffmap:=nil;
  w := Min(image1.Width,image2.Width);
  h := Min(image1.Height,image2.Height);
  if Assigned(diffmap) then
  begin
    diffmap.Width := w;
    diffmap.Height := h;
    with diffmap.Canvas do begin
      Brush.Color := $FF;
      FillRect(ClipRect);
    end;
  end;
  d := 0;
  dm := nil;
  for y := 0 to h - 1 do
  begin
    prgb1 := image1.Scanline[y];
    prgb2 := image2.Scanline[y];
    if assigned(diffmap) then
      dm := diffmap.Scanline[y];
    for x := 0 to w - 1 do
    begin

      with prgb1^ do
        i1 := (r * gRedToGrayCoef + g * gGreenToGrayCoef + b * gBlueToGrayCoef) div 100;
      with prgb2^ do
        i2 := (r * gRedToGrayCoef + g * gGreenToGrayCoef + b * gBlueToGrayCoef) div 100;

      di := abs(i1 - i2);

      d := d + di / 255;

      inc(prgb1);
      inc(prgb2);
      if assigned(dm) then
      begin
        dm^ := di;
        inc(dm);
      end;
    end;
  end;
  d := d / (w * h);
  result := 1 - d;
end;

end.


使用方法：
1、引用本单元
2、加载图像到两个Image控件中
3、可以调用ConvertToBmp将Image里的Graphic转换成BMP再来做比较
procedure TForm1.btn1Click(Sender: TObject);
var
  d: Double;
begin
  d := CompareImages(ConvertToBmp(img1.Picture.Graphic, 128, 128), ConvertToBmp(img2.Picture.Graphic, 128, 128), nil);
  Caption := Format('相似度：%.2f, %s', [d, TimeToStr(time)]);
end;