您现在的位置:首页 >> 图形媒体 >> 图形媒体 >> 内容

Delphi中一简单图像比较例程

时间:2011/9/3 15:02:09 点击:

  核心提示:unit MainFrm;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms...

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.

作者:网络 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
本类推荐
  • 没有
本类固顶
  • 没有
  • 盒子文章(www.2ccc.com) © 2022 版权所有 All Rights Reserved.
  • 沪ICP备05001939号