Delphi中一简单图像比较例

unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
TextWidth, TextHeight : Integer;
TmpWidth, TmpHeight : Integer;
Temp : Integer;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Temp := 1021;
Image1.Canvas.TextOut( 0, 0, '0810212334' );
TextWidth  := Image1.Canvas.TextWidth  ( '0810212334' );
TextHeight := Image1.Canvas.TextHeight ( '0810212334' );
Image2.Canvas.TextOut ( 0, 0, IntToStr ( Temp ) );
TmpWidth  := Image2.Canvas.TextWidth  ( IntToStr ( Temp ) );
TmpHeight := Image2.Canvas.TextHeight ( IntToStr ( Temp ) );
end;
procedure TForm1.Button2Click(Sender: TObject);
var
TempStr : String;
i, j, k : Integer;
Flag : boolean;
TmpColor : DWORD;
Mark : Integer;
OldColorPtr : PByteArray;
TmpColorPtr : PByteArray;
begin
Mark := 0;
for i := 0 to TmpHeight - 1 do
begin
OldColorPtr := Image1.Picture.Bitmap.ScanLine [ i ];
TmpColorPtr := Image2.Picture.Bitmap.ScanLine [ i ];
Flag := true;
j := Mark;
while j < TextWidth do
begin
for k := 0 to TmpWidth do
begin
if OldColorPtr [j + k] <> TmpColorPtr[k] then
begin
Flag := false;
break;
end;
end;
inc ( j );
end;
if Flag and ( (j - k) > 0 ) then
Mark := j - k
else
Mark := 0;
end;
if Flag then
ShowMessage ( 'Find the text at + IntToStr (Mark - TmpWidth + 1) + ',0');
Image1.Canvas.Pen.Color := RGB ( $FF, $00, $00 );
Image1.Canvas.Brush.Style := bsClear;
Image1.Canvas.Rectangle( Mark - TmpWidth + 1, 0, Mark, TmpHeight );
end;
end.