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.