delphi高级验证码识别引擎源码

[muyfmuyfj]

小弟水平低，代码写的很乱，请谅解
需用到calcexprress,pngimage和gifimage，这里不再提供!

unit OCR;

interface

uses Windows, SysUtils, Graphics, Classes, PNGImage, GIFImage, JPEG, Math, AsphyreZlib;

type
  TOCRLibSetting = record  //验证码库设置
    SaveBMP: Boolean; //存储转换后的Bmp文件
    BmpPath: String; //Bmp存储路径
    BmpPrefix: String; //Bmp文件前缀
    BmpSuffix: String; //Bmp文件后缀
  end;

type
  //图像大小类
  TOCRSz = record
    W,H: Byte;   //宽，高
  end;
  //特征码模板库类
  TOCRTemplates = record
    Count: Byte;    //数量
    Names: array of String; //名称
    OCRFiles: array of String; //文件名/路径
    OCRSz: array of TOCRSz; //图像大小
    YaoqiuSS: array of Byte;  //是否为算式
  end;

//初始化验证码库
function InitOCRLib: Boolean;
//取消使用Dll
procedure CancelUseDLL;
//加载验证码模板库
function LoadOCRLib(const AFileName: String = ''): Boolean;
//图像转换为BMP
function ALL2BMP(const Filename : String; const Bmp: TBitmap): Boolean;
//加载资源dll
function LoadOCRResourceDLL(const ADllName: String): Boolean;
//识别验证码
function RecogOCR(var Success: Boolean; const ImageFile: String): String;
//更改特征码模板
function LoadOCRTemplate(const TmplID: Integer): Boolean;
//加载特征码文件
function LoadOCRFile(const ocrFile: String; const IsAutoSS: Boolean = False): Boolean;
//查找验证码特征文件
function FetchOCR(const StartIndex: Integer; const Width,Height: Integer; const AOCRName: String = ''): Integer;
//验证码库设置
function SetOCRLib(const ASetting: TOCRLibSetting): Boolean;
//获得验证码库设置
function GetOCRLibSetting: TOCRLibSetting;
//获得验证码模板库
function GetOCRTemplates: TOCRTemplates;
//获取最后识别时间(毫秒)
function GetLastRecogTime: DWORD;
//调用AspriseOcr
//function RecogOCRByOCRLib(const FileName: String): String;
//释放验证码库/清除特征码文件
function FreeOcr: Boolean;

//procedure SetPicFormat(Format: Byte);

const
  FMT_AUTO = 4; //自动
  FMT_PNG = 2; //png
  FMT_BMP = 1; //bmp
  FMT_GIF = 3; //gif
  FMT_JPEG = 0; //jpg/jpeg

implementation

uses IniFiles, SSUtils;

type
  RSpeicalEffects = record  //特殊效果
    To1Line: Boolean;   //字符归位
    RemoveZD: Boolean;  //消除噪点
    Y0: Byte;           //Y轴偏移
    XcZD: Byte;         //噪点阀值
  end;

type //字符特征码
  RChar = record
    MyChar: char;          //字符
    used: Boolean;         //已使用
    MyCharInfo: array[0..49, 0..49] of byte;  //字符图像
  end;

type //字符特征文件
  RCharInfo = record
    charwidth: byte; //字符宽度
    charheight: byte; //字符高度
    X0: byte; //第一个字符开始x偏移
    TotalChars: byte; //图象字符总数
    CusDiv : boolean;  //自定义二值化运算
    DivCmp : Byte; //  0:>  1:=  2:<
    DivColr : TColor;  //二值化阀值
    _CmpChr,_CmpBg: Boolean;  //比较字符(黑色),比较背景(白色)
    _ClrRect: Boolean;   //清除矩形
    _RectLen: Byte;     //矩形长度

    allcharinfo: array[0..42] of RChar; //字符特征码列表
  end;

type
  TOcrVersionSng = array [0..1] of Byte;
  TOcrVersion = record    //版本号
    First,Minjor: Byte;   //版本
    Author: String[10];   //作者
    Name: String[20];     //特征码名称
  end;

  ROcrLibFile = record
    Sng: TOcrVersionSng;  //版本标识
    Ver: TOcrVersion;     //版本
    W,H: Byte;            //图像宽,高
    Effect: RSpeicalEffects;  //特殊效果
    CharInfo: RCharInfo;     //特征码
    EffectBLW: Boolean;     //通用二值化
  end;

  TOcrLibDllInfo = record
    DllFile: String;
    MDLRPrefix: String;
    MDLRType: String;
  end;

var
  _BITMAP: TBitmap;  //识别图像
  MycharInfo: RCharInfo; //特征码
  _Effect: RSpeicalEffects;  //特效
  _EffBLW: Boolean;  //通用二值化
  SSCode: Byte;   //是否为算式

var
  BmW,BmH: Integer;  //特征码图像宽,高
  OcrName: String;  //特征码名称
  _PicFormat: Byte; //图像格式
  _PicWidth,_PicHeight: Byte; //实际图像宽,高
  Templates: TOCRTemplates; //模板列表
  Setting: TOCRLibSetting;
  LastRecogTime: DWORD;

var
  UseDll: Boolean;
  DllInfo: TOcrLibDllInfo;

const
  SP = '@';

procedure CancelUseDLL;
begin
  UseDll := False;
end;

function GetLastRecogTime: DWORD;
begin
  Result := LastRecogTime;
end;

function GetOCRLibSetting: TOCRLibSetting;
begin
  Result := Setting;
end;

function GetOCRTemplates: TOCRTemplates;
begin
  Result := Templates;
end;

function LoadOCRResourceDLL(const ADllName: String): Boolean;
var
  strm: TResourceStream;
  hDll: THandle;
  S: String;
  function GetTempPathFileName: String;
  var
    SPath, SFile : PChar;
  begin
    SPath := AllocMem(MAX_PATH);
    SFile := AllocMem(MAX_PATH);
    GetTempPath(MAX_PATH, SPath);
    GetTempFileName(SPath, '~OC', 0, SFile);
    Result := String(SFile);
    FreeMem(SPath, MAX_PATH);
    FreeMem(SFile, MAX_PATH);
    DeleteFile(Result);
  end;
begin
  Result := False;
  try
    hDll := LoadLibrary(PChar(ADllName));
    if hDll <> 0 then
    begin
      try
        strm := TResourceStream.Create(hDll,
          'SDSOFT_OCR',
          PChar('OCR'));

        S := GetTempPathFileName;
        strm.SaveToFile(S);
        try
          UseDll := True;
          Result := LoadOCRLib(S);
        except
          UseDll := False;
        end;
        if Result = False then UseDll := False;
        if UseDll = True then DllInfo.DllFile := ADllName;

        DeleteFile(S);
      finally
        FreeLibrary(hDll);
      end;
    end;
    Result := True;
  except
  end;
end;

function SetOCRLib(const ASetting: TOCRLibSetting): Boolean;
begin
  Result := False;
  try
    Setting := ASetting;
    Result := True;
  except
  end;
end;

function InitOCRLib: Boolean;
begin
  Result := False;
  try
    UseDll := False;
    DllInfo.DllFile := '';
    DllInfo.MDLRPrefix := '';
    DllInfo.MDLRType := '';

    _BITMAP := nil;
    FillChar(MycharInfo,SizeOf(RCharInfo),#0);
    MycharInfo.DivCmp := 3;
    MycharInfo.DivColr := $7FFFFF;
    MycharInfo._CmpChr := True;
    MycharInfo._CmpBg := False;
    MycharInfo.X0 := 0;
    MycharInfo.charwidth := 0;
    MycharInfo.CusDiv := False;
    MycharInfo.charheight := 0;
    FillChar(_Effect,SizeOf(RSpeicalEffects),#0);
    _Effect.To1Line := False;
    _Effect.RemoveZD := False;
    Setting.SaveBMP := False;
    Setting.BmpPrefix := 'OCR';
    Setting.BmpSuffix := '';
    LastRecogTime := 0;
  except
  end;
end;

function FetchOCR(const StartIndex: Integer; const Width,Height: Integer; const AOCRName: String = ''): Integer;
var
  I: Integer;
begin
  Result := -1;
  for I := StartIndex to Integer(Templates.Count) - 1 do
  begin
    if (Templates.Names[I] = AOCRName) or
         ((Templates.OCRSz[I].W = Width) and (Templates.OCRSz[I].H = Height))
           then
    begin
      Result := I;
      Break;
    end;
  end;
end;

function LoadOCRLib(const AFileName: String = ''): Boolean;
var
  Ini: TIniFile;
  S,S2: String;
  I,J: Integer;

  FileName: String;
begin
  Result := False;
  FileName := AFileName;
  if FileName = '' then
    FileName := ExtractFilePath(ParamStr(0))+'OCR.INI';
  try
    Templates.Count := 0;
    SetLength(Templates.Names,0);
    SetLength(Templates.OCRFiles,0);
    Ini := TIniFile.Create(FileName);
    Templates.Count := Byte(Ini.ReadInteger('OCRLIB','TCNT',0));
    SetLength(Templates.Names,Templates.Count*SizeOf(String));
    SetLength(Templates.OCRFiles,Templates.Count*SizeOf(String));
    SetLength(Templates.OCRSz,Templates.Count*SizeOf(TOCRSz));
    SetLength(Templates.YaoqiuSS,Templates.Count*SizeOf(Byte));
    for I := 0 to Templates.Count - 1 do
    begin
      S := Ini.ReadString('OCRLIB','T'+IntToStr(I),'');
      if S <> '' then
      begin
        J := Pos(';',S);
        S2 := Copy(S,1,J-1);
        S := Copy(S,J+1,Length(S)-J+1);
        if UseDll then Templates.OCRFiles[I] := S2
        else Templates.OCRFiles[I] := ExtractFilePath(ParamStr(0))+S2;
        J := Pos(';',S);
        S2 := Copy(S,1,J-1);
        S := Copy(S,J+1,Length(S)-J+1);
        Templates.OCRSz[I].W := Byte(StrToInt(S2));
        J := Pos(';',S);
        S2 := Copy(S,1,J-1);
        S := Copy(S,J+1,Length(S)-J+1);
        Templates.OCRSz[I].H := Byte(StrToInt(S2));
        Templates.YaoqiuSS[I] := Byte(StrToInt(S));
        Templates.Names[I] := Ini.ReadString('OCRNAME','T'+IntToStr(I),'');
      end;
    end;
    if UseDll = True then
    begin
      DllInfo.MDLRPrefix := Ini.ReadString('DLLSETTING','Prefix','');
      DllInfo.MDLRType := Ini.ReadString('DLLSETTING','ResourceType','OCR');
    end;
    Ini.Free;
    Result := True;
  except
  end;
end;

function LoadOCRFile(const ocrFile: String; const IsAutoSS: Boolean = False): Boolean;
var
  Fstrm: TFileStream;
  strm: TMemoryStream;
  dat: ROcrLibFile;
  function VersVerify: Boolean;
  begin
    Result := (dat.Sng[0] = Byte('O')) and (dat.Sng[1] = Byte('C'));
  end;
begin
  Result := False;
  try
    Fstrm := TFileStream.Create(ocrFile,fmOpenRead);
    strm := TMemoryStream.Create;
    try
      Fstrm.Position := 0;
      ZDecompressStream(FStrm,strm);
      Fstrm.Free;

      strm.Position := 0;
      strm.Read(dat,SizeOf(ROcrLibFile));
      if VersVerify = True then
      begin
        MycharInfo := dat.CharInfo;
        _Effect := dat.Effect;
        BmW := dat.W;
        BmH := dat.H;
        OcrName := dat.Ver.Name;
        _EffBLW := dat.EffectBLW;
        Result := True;
      end;
    finally
      strm.Free;
    end;
    if IsAutoSS = True then SSCode := 1
    else SSCode := 0;
  except
  end;
end;

[muyfmuyfj]

procedure To1Line(const Bmp: TBitmap; Y0,X0,Chw,CharL: Byte);
type
  xByteArray = array of Byte;
var
  X,Y: Integer;
  Ch: TBitmap;
  MinJL: xByteArray;
  function MinArr(const Data: xByteArray; const Count: Integer): Byte;
  var
    I: Integer;
  begin
    if Count = 0 then Exit;
    Result := Data[0];
    for I := 0 to Count - 1 do
    begin
      if Data[I] < Result then Result := Data[I];
    end;
  end;
  procedure GetMinJL(const nChar: Byte);
  var
    K,L,M: Byte;
    c: TColor;
    MinJLS: xByteArray;
  begin
    K := X0 + nChar * Chw;
    SetLength(MinJLS,Chw);
    for L := 0 to Chw - 1 do
    begin
      M := 0;
      c := Bmp.Canvas.Pixels[K+L,M+Y0];
      while (c <> clBlack) and (M <= Bmp.Height) do
      begin
        inc(M);
        c := Bmp.Canvas.Pixels[K+L,M+Y0];
      end;
      MinJLS[L] := M;
    end;
    MinJL[nChar] := MinArr(MinJLS,Chw);
    SetLength(MinJLS,0);
  end;
begin
  SetLength(MinJL,CharL);
  Ch := TBitmap.Create;
  for X := 0 to CharL - 1 do
  begin
    GetMinJL(X);
    Y := X0 + X * Chw;

    Ch.Width := Chw;
    Ch.Height := Bmp.Height - MinJL[X];
    Ch.Canvas.Brush.Color := clWhite;
    Ch.Canvas.Brush.Style := bsSolid;
    Ch.Canvas.Pen.Color := clWhite;
    Ch.Canvas.Pen.Style := psSolid;
    Ch.Canvas.Rectangle(0,0,Ch.Width,Ch.Height);
    Ch.Canvas.CopyRect(Rect(0,0,Ch.Width,Ch.Height),Bmp.Canvas,Rect(Y,MinJL[X],Y+Chw,Bmp.Height));

    Bmp.Canvas.Brush.Color := clWhite;
    Bmp.Canvas.Brush.Style := bsSolid;
    Bmp.Canvas.Pen.Color := clWhite;
    Bmp.Canvas.Pen.Style := psSolid;
    Bmp.Canvas.Rectangle(Y,MinJL[X],Y+Chw,Bmp.Height);
    Bmp.Canvas.CopyRect(Rect(Y,Y0,Y+Chw,Bmp.Height-MinJL[X]),Ch.Canvas,Rect(0,0,Ch.Width,Ch.Height));
  end;
  Ch.Free;
  SetLength(MinJL,0);
end;

function GetTail(str,sp : String): Integer;
var
  Temp : String;
begin
  Temp := Str;
  Delete(Temp,1,Pos(sp,str)+length(sp)-1);
  Result := StrToInt(Temp);
end;

procedure SlQuickSort(Sl : TStringList; iLo, iHi: Integer);
var
  Lo, Hi, Mid : Integer;
  T : String;
begin
  Lo := iLo;
  Hi := iHi;
  Mid := GetTail(Sl[(Lo + Hi) div 2],Sp);
  repeat
    while GetTail(Sl[Lo],Sp) < Mid do Inc(Lo);
    while GetTail(Sl[Hi],Sp) > Mid do Dec(Hi);
    if Lo <= Hi then
    begin
      T := sl[Lo];
      sl[Lo] := sl[Hi];
      sl[Hi] := T;
      Inc(Lo);
      Dec(Hi);
    end;
  until Lo > Hi;
  if Hi > iLo then SlQuickSort(Sl, iLo, Hi);
  if Lo < iHi then SlQuickSort(Sl, Lo, iHi);
end;

Function HexToInt(Hex :String):Int64;
Var Sum : Int64;
    I,L : Integer;
Begin
  L := Length(Hex);
  Sum := 0;
  For I := 1 to L Do
   Begin
   Sum := Sum * 16;
   If ( Ord(Hex[I]) >= Ord('0')) and (Ord(Hex[I]) <= Ord('9')) then
      Sum := Sum + Ord(Hex[I]) - Ord('0')
   else If ( Ord(Hex[I]) >= Ord('A') ) and (Ord(Hex[I]) <= Ord('F')) then
      Sum := Sum + Ord(Hex[I]) - Ord('A') + 10
   else If ( Ord(Hex[I]) >= Ord('a') ) and ( Ord(Hex[I]) <= Ord('f')) then
      Sum := Sum + Ord(Hex[I]) - Ord('a') + 10
   else
      Begin
      Sum := -1;
      break;
      End;
   End;
  Result := Sum;
End;

function GetHead(str,sp : String):string;
begin
  Result:=copy(str,1,pos(sp,str)-1);
end;

procedure WhiteBlackImgEx(const bmp: TBitmap);
type
  xByteArray = array of Byte;
var
  p: PByteArray;
  J,Y,W: Integer;
  arr: xByteArray;
  function AverageArr(const Data: xByteArray; const Count: Integer): Int64;
  var
    I: Integer;
  begin
    Result := 0;
    if Count = 0 then Exit;
    for I := 0 to Count - 1 do
    begin
      Result := Result + Data[I];
    end;
    Result := Round(Result/Count);
  end;
begin
  bmp.PixelFormat := pf24bit;
  SetLength(arr,bmp.Height*bmp.Width);
  for Y := 0 to bmp.Height - 1 do
  begin
    p := bmp.ScanLine[Y];
    J := 0;
    while J < bmp.Width*3 do
    begin
      arr[(Y*bmp.Width)+J div 3] := Round((p[J]+p[J+1]+p[J+2])/3);
      Inc(J,3);
    end;
  end;
  W := Byte(AverageArr(Arr,bmp.Height*bmp.Width));
  for Y := 0 to bmp.Height - 1 do
  begin
    p := bmp.ScanLine[Y];
    J := 0;
    while J < bmp.Width*3 do
    begin
      if Round((p[J]+p[J+1]+p[J+2])/3) >= W then
      begin
        p[J] := 0;
        p[J+1] := 0;
        p[J+2] := 0;
      end else
      begin
        p[J] := MaxByte;
        p[J+1] := MaxByte;
        p[J+2] := MaxByte;
      end;
      Inc(J,3);
    end;
  end;
  SetLength(Arr,0);
end;

procedure Ranse(const bmp: TBitmap; const Color: TColor);
var
  c: TColor;
  X,Y: Integer;
  r1,g1,b1: Byte;
  r2,g2,b2: Byte;
begin
  r1 := GetRValue(Color);
  g1 := GetGValue(Color);
  b1 := GetBValue(Color);
  for X := 0 to bmp.Width - 1 do
  begin
    for Y := 0 to bmp.Height - 1 do
    begin
      c := Bmp.Canvas.Pixels[X,Y];
      r2 := GetRValue(c);
      g2 := GetGValue(c);
      b2 := GetBValue(c);
     // if (c <> clWhite) and (c <> clBlack) then
     // begin
        r2 := Round(r1*Min(Abs(r2-MaxByte),MaxByte-r2)/MaxByte);
        g2 := Round(g1*Min(Abs(g2-MaxByte),MaxByte-g2)/MaxByte);
        b2 := Round(b1*Min(Abs(b2-MaxByte),MaxByte-b2)/MaxByte);
        c := RGB(r2,g2,b2);
        Bmp.Canvas.Pixels[X,Y] := c;
    //  end;
    end;
  end;
end;

procedure Grayscale(const bmp: TBitmap);
var
  p: PByteArray;
  J,Y,W: Integer;
begin
  bmp.PixelFormat := pf24bit;
  for Y := 0 to bmp.Height - 1 do
  begin
    p := bmp.ScanLine[Y];
    J := 0;
    while J < bmp.Width*3 do
    begin
      W := (P[J] * 28 + P[J+1] *151 + P[J+2] * 77);
      W := W shr 8;
      P[J] := Byte(W);
      P[J+1] := Byte(W);
      P[J+2] := Byte(W);
      Inc(J,3);
    end;
  end;
  //bmp.PixelFormat := pf1bit;
  //bmp.PixelFormat := pf24bit;
end;

function ALL2BMP(const Filename : String; const Bmp: TBitmap): Boolean;
var
  GIF: TGIFImage;
  jpg: TJPEGImage;
  PNG: TPNGobject;
  FileEx: String;
begin
  Result := False;
  try
    FileEx := UpperCase(ExtractFileExt(filename));
    if FileEx = '.PNG' then
    begin
      PNG := TPNGobject.Create;
      try
        PNG.LoadFromFile(filename);
        _PicFormat := 2;
        BMP.Assign(PNG);
      except
        //not png image
      end;
      PNG.Free;
    end else if FileEx = '.BMP' then
      try
        BMP.LoadFromFile(filename);
        _PicFormat := 1;
      except
        //not bmp image
      end
    else if FileEx = '.GIF' then
    begin
      GIF := TGIFImage.Create;
      try
        GIF.LoadFromFile(filename);
        _PicFormat := 3;
        BMP.Assign(GIF);
      except
        //not gif image
      end;
      GIF.Free;
    end else if (FileEx = '.JPG') or (FileEx = '.JPEG') then
    begin
      JPG := TJPEGImage.Create;
      try
        JPG.LoadFromFile(filename);
        _PicFormat := 4;
        BMP.Assign(JPG);
      except
        //not jpg image
      end;
      JPG.Free;
    end;
    //
    if _PicFormat = 0 then
      try
        BMP.LoadFromFile(FileName);
        _PicFormat := 1;
      except
      end;
    if _PicFormat = 0 then
    begin
      PNG := TPNGobject.Create;
      try
        PNG.LoadFromFile(FileName);
        _PicFormat := 2;
        BMP.Assign(PNG);
      finally
        PNG.Free;
      end;
    end;
    if _PicFormat = 0 then
    begin
      GIF := TGIFImage.Create;
      try
        GIF.LoadFromFile(FileName);
        _PicFormat := 3;
        BMP.Assign(GIF);
      finally
        GIF.Free;
      end;
    end;
    if _PicFormat = 0 then
    begin
      JPG := TJPEGImage.Create;
      try
        JPG.LoadFromFile(FileName);
        BMP.Assign(JPG);
        _PicFormat := 4;
      finally
        JPG.Free;
      end;
    end;
    Result := True;
  except
  end;
end;

[muyfmuyfj]

function PIC2BMP(filename : String): TBITMAP;
var
  GIF: TGIFImage;
  jpg: TJPEGImage;
  BMP: TBITMAP;
  PNG: TPNGobject;
  FileEx: String;
  i, j, x: Byte;
  b : boolean;
  //
  SrcRGB : pByteArray;
  ClPixel : TColor;
begin
  b := False;
  ClPixel := 0;
  FileEx := UpperCase(ExtractFileExt(filename));
  BMP := TBITMAP.Create;
  if FileEx = '.PNG' then
  begin
    PNG := TPNGobject.Create;
    try
      PNG.LoadFromFile(filename);
      _PicFormat := 2;
      BMP.Assign(PNG);
    except
      //not png image
    end;
    PNG.Free;
  end else if FileEx = '.BMP' then
    try
      BMP.LoadFromFile(filename);
      _PicFormat := 1;
    except
      //not bmp image
    end
  else if FileEx = '.GIF' then
  begin
    GIF := TGIFImage.Create;
    try
      GIF.LoadFromFile(filename);
      _PicFormat := 3;
      BMP.Assign(GIF);
    except
      //not gif image
    end;
    GIF.Free;
  end else if (FileEx = '.JPG') or (FileEx = '.JPEG') then
  begin
    JPG := TJPEGImage.Create;
    try
      JPG.LoadFromFile(filename);
      _PicFormat := 4;
      JPG.Grayscale := TRUE;
      BMP.Assign(JPG);
    except
      //not jpg image
    end;
    JPG.Free;
  end;
  //
  if _PicFormat = 0 then
    try
      BMP.LoadFromFile(FileName);
      _PicFormat := 1;
    except
    end;
  if _PicFormat = 0 then
  begin
    PNG := TPNGobject.Create;
    try
      PNG.LoadFromFile(FileName);
      _PicFormat := 2;
      BMP.Assign(PNG);
    finally
      PNG.Free;
    end;
  end;
  if _PicFormat = 0 then
  begin
    GIF := TGIFImage.Create;
    try
      GIF.LoadFromFile(FileName);
      _PicFormat := 3;
      BMP.Assign(GIF);
    finally
      GIF.Free;
    end;
  end;
  if _PicFormat = 0 then
  begin
    JPG := TJPEGImage.Create;
    try
      JPG.LoadFromFile(FileName);
      JPG.Grayscale := TRUE;
      BMP.Assign(JPG);
      _PicFormat := 4;
    finally
      JPG.Free;
    end;
  end;

  _PicWidth := BMP.Width;
  _PicHeight := BMP.Height;
  //BMP.SaveToFile(_PicFile+'.BMP');

  //Fetch(_BbsType,_PicWidth,_PicHeight,_PicFormat,_CodeUrl);
  if _EffBLW then
  begin
    Grayscale(bmp);
    Ranse(bmp,clRed);
    WhiteBlackImgEx(bmp);
  end else
  begin
    Bmp.PixelFormat := pf24Bit;

  // make picture only black and white
    for j := 0 to BMP.Height - 1 do
    begin
      SrcRGB := BMP.ScanLine[j];
      for i := 0 to BMP.Width - 1 do
      begin
        if MycharInfo._ClrRect then
        begin
          x := MycharInfo._RectLen;
          if (i<x)or(j<x)or(i>BMP.Width-1-x)or(j>BMP.Height-1-x) then
          begin
            SrcRGB[i*3]   := $ff;
            SrcRGB[i*3+1] := $ff;
            SrcRGB[i*3+2] := $ff;
            continue;
          end;
        end;
        ClPixel := HexToInt(IntToHex(SrcRGB[i*3],2)+
                              IntToHex(SrcRGB[i*3+1],2)+
                              IntToHex(SrcRGB[i*3+2],2));
        if MycharInfo.CusDiv then
        begin
          case MycharInfo.DivCmp of
          0:  b := ClPixel > MycharInfo.DivColr;
          1:  b := ClPixel = MycharInfo.DivColr;
          2:  b := ClPixel < MycharInfo.DivColr;
          4:  b := ClPixel <> MycharInfo.DivColr;
          end;
        end else
          b := ClPixel > MycharInfo.DivColr;
        if b then begin
          SrcRGB[i*3]   := $ff;
          SrcRGB[i*3+1] := $ff;
          SrcRGB[i*3+2] := $ff;
        end else begin
          SrcRGB[i*3]   := 0;
          SrcRGB[i*3+1] := 0;
          SrcRGB[i*3+2] := 0;
        end;
      end;
    end;
  end;
  {BMP.Canvas.lock;
  for i := 0 to BMP.Width - 1 do
    for j := 0 to BMP.Height - 1 do
    begin
      if _ClrRect then
      begin
        x := _RectLen;
        if (i<x)or(j<x)or(i>BMP.Width-1-x)or(j>BMP.Height-1-x) then
        begin
          BMP.Canvas.Pixels[i, j] := clwhite;
          continue;
        end;
      end;
      if _CusDiv then
      begin
        case _DivCmp of
        0:  b := BMP.Canvas.Pixels[i, j] > _DivColr;
        1:  b := BMP.Canvas.Pixels[i, j] = _DivColr;
        2:  b := BMP.Canvas.Pixels[i, j] < _DivColr;
        end;
      end else
        b := BMP.Canvas.Pixels[i, j] > _DivColr;
      if b then
        BMP.Canvas.Pixels[i, j] := clwhite
      else
        BMP.Canvas.Pixels[i, j] := clblack;
    end;
  BMP.Canvas.Unlock;  }
  result := BMP;
end;

function CMPBMP(SBMP: TBITMAP; x0, m: integer): integer;
var
  i, j: integer;
  //
  SrcRGB : pByteArray;
begin
  result := 0;
  for j := 0 to MycharInfo.charheight -1 do
  begin
    SrcRGB := SBMP.ScanLine[j];
    for i := 0 to MycharInfo.charwidth -1 do
    begin
      if MycharInfo._CmpChr and (SrcRGB[(x0+i)*3] = 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 0) then
        Inc(Result);
      if MycharInfo._CmpBg and (SrcRGB[(x0+i)*3] > 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 1) then
        Inc(Result);
    end;
  end;

  {
  result := 0;
  SBMP.Canvas.Lock;
  for i := 0 to MycharInfo.charwidth - 1 do
    for j := 0 to MycharInfo.charHeight - 1 do
    begin
      if _CmpChr and (SBMP.Canvas.Pixels[x0 + i, j] = 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 0) then
        Inc(Result);
      if _CmpBg and (SBMP.Canvas.Pixels[x0 + i, j] > 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 1) then
        Inc(Result);
    end;
  SBMP.Canvas.Unlock;  }
end;


function CMPBMPPRO(SBMP: TBITMAP; x0, m: integer): integer;
var
  i, j : integer;
  xj : byte;
  Ret : Integer;
  //
  SrcRGB : pByteArray;
begin
  result := 99999;
  for xj := 0 to _BITMAP.Height - MycharInfo.charheight do
  begin
    Ret := 0;
    for j := 0 to MycharInfo.charHeight - 1 do
    begin
      SrcRGB := SBMP.ScanLine[j+xj];
      for i := 0 to MycharInfo.charwidth - 1 do
      begin
        if MycharInfo._CmpChr and (SrcRGB[(x0+i)*3] = 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 0) then
          Inc(Ret);
        if MycharInfo._CmpBg  and (SrcRGB[(x0+i)*3] > 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 1) then
          Inc(Ret);
      end;
    end;
    if result > Ret then
    result := Ret;
  end;

  {result := 99999;
  SBMP.Canvas.Lock;
  for xj := 0 to _BITMAP.Height - MycharInfo.charheight do
  begin
    Ret := 0;
    for i := 0 to MycharInfo.charwidth - 1 do
      for j := 0 to MycharInfo.charHeight - 1 do
      begin
        if _CmpChr and (SBMP.Canvas.Pixels[x0 + i, j+xj] = 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 0) then
          Inc(Ret);
        if _CmpBg  and (SBMP.Canvas.Pixels[x0 + i, j+xj] > 0) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = 1) then
          Inc(Ret);
      end;
    if result > Ret then
    result := Ret;
  end;
  SBMP.Canvas.Unlock;   }
end;

function GetStringFromImage(SBMP: TBITMAP): String;
//const
//  SpeicalChars: array [0..6] of String = ('+','-','*','/','(',')','=');
var
  k, m, x: integer;
  alike : Integer;
  S : String;
  Sort : boolean;
  SlAlike : TStringList;
begin
  //DebugStr('SBMP_W_H',IntToStr(SBMP.Width)+'*'+IntToStr(SBMP.Height),'e:');
  result := '';
  if _Effect.To1Line = True then
  begin
    try
      To1Line(SBMP,_Effect.Y0,MycharInfo.X0,MycharInfo.charwidth,Mycharinfo.TotalChars);
    except
    end;
  end;
  SlAlike := TStringList.Create;
  for k := 0 to MycharInfo.TotalChars - 1 do
  begin
    x := MycharInfo.X0 + MyCharInfo.charwidth * k;
    //DebugLog('k:'+IntToStr(k)+'  '+'x:'+IntToStr(x));
    SlAlike.Clear;
    Sort := True;
    for m := 0 to 42 do
    begin
      if Mycharinfo.allcharinfo[m].used = True then
      begin
        {if m>35 then
          S := SpeicalChars[m-36]
        else if m>9 then
          S := Chr(m+87)
        else
          S := IntToStr(m); }
        S := Mycharinfo.allcharinfo[m].MyChar;
        if SBMP.Height = MycharInfo.charheight then
          Alike := CMPBMP(SBMP, x, m)
        else
          Alike := CMPBMPPRO(SBMP, x, m);
      //DebugLog('m:'+s+'  '+'Alike:'+IntToStr(Alike));
        if Alike = 0 then
        begin
          Result := Result + S;
          //DebugLog('get_it:'+s);
          //DebugStr('GET_IT','GET '+S+ ' AS '+IntToStr(k+1)+ 'TH NUM','e:');

          Sort := False;
          break;
        end else
          SlAlike.Add(S + Sp + IntToStr(Alike));
      end;
    end;
    if Sort then
    begin
      SlQuickSort(SlAlike,0,SlAlike.Count-1);
      result := result + GetHead(SlAlike[0],Sp);
      //DebugLog('get_it_by_sort:'+GetHead(SlAlike[0],Sp));
      //DebugStr('GET_IT_SORT','GET '+GetHead(SlAlike[0],Sp)+ ' AS '+IntToStr(k)+ 'TH NUM','e:');

      //SlAlike.SaveToFile('f:\'+IntToStr(k)+'.txt');
    end;
  end;
  SlAlike.Free;
end;

function RecogOCR(var Success: Boolean; const ImageFile: String): String;
begin
  Success := False;
  try
    _BITMAP := nil;
    LastRecogTime := GetTickCount;
    _BITMAP := PIC2BMP(ImageFile);
    Result := GetStringFromImage(_BITMAP);
    LastRecogTime := GetTickCount-LastRecogTime;
    SaveBmp;
    _BITMAP.Free;
    Success := True;
    if SSCode = 1 then Result := SSUtils.RecogSuanshi(Result);
  except
    LastRecogTime := 0;
  end;
end;
end.

[muyfmuyfj]

ssutils单元:

unit SSUtils;

interface

uses Windows, SysUtils, CalcExpress;

function RecogSuanshi(const S: String): String;

implementation

function DeleteFh(const S: String; const Fh: Char): String;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(S) do
  begin
    if S[I] <> Fh then
    begin
      Result := Result + S[I];
    end;
  end;
end;

function RecogSuanshi(const S: String): String;
const
  argv: array [0..1] of Extended = (0,1);
var
  S2: String;
  cexp: TCalcExpress;
begin
  Result := '计算错误!';
  try
    cexp := TCalcExpress.Create(nil);
    try
      S2 := DeleteFh(S,'?');
      S2 := DeleteFh(S,'=');
      S2 := StringReplace(S2,'加','+',[rfReplaceAll]);
      S2 := StringReplace(S2,'减','-',[rfReplaceAll]);
      S2 := StringReplace(S2,'乘','*',[rfReplaceAll]);
      S2 := StringReplace(S2,'除','/',[rfReplaceAll]);
      S2 := StringReplace(S2,'×','*',[rfReplaceAll]);
      S2 := StringReplace(S2,'÷','/',[rfReplaceAll]);
      S2 := StringReplace(S2,'＋','+',[rfReplaceAll]);
      S2 := StringReplace(S2,'－','-',[rfReplaceAll]);

      cexp.Formula := S2;
      Result := IntToStr(Round(cexp.calc(argv)));
    except
    end;
  finally
    cexp.Free;
  end;
end;

end.

[cdchq]

不错，写个demo更好

[ADSLAN]

谢谢分享

[广州佬]

谢谢分享！摘录下来，慢慢理解、学习。

[Quote=引用 5 楼 的回复:]
学习一下先
[/Quote]
呵呵，蓝鸟哥这么谦虚啊。

[广州佬]

楼主分享代码，能让后来者得到启迪，若能提供下引用的单元在何处下载，那就更完美了。
不是懒得去搜索，主要是：如引用了同名而不同内容的单元时，就无法正确地使用和领略你以上的代码的编程风采了。

就如下列单元，是否即是你所引用的单元？还是仅同名而已？
AsphyreZlib.pas，我搜到的：http://www.bvbcode.com/code/28lypjot-1662551-down
Math.pas，我搜到的：http://bbs.cnpack.org/viewthread.php?tid=1858
PNGImage.pas，我搜到的：http://www.koders.com/delphi/fidF09E1376A88CB583BB67F5329E88B1BA3B570D79.aspx
（我认为PNGImage.pas源码有两个地方有误——见http://topic.csdn.net/u/20120602/19/2ef4450a-ac20-4ccb-823a-b721a431d151.html 一文，如没理解，可索取我修改后的代码）
GIFImage.pas，我搜到的：http://download.csdn.net/detail/doorsky123/3003816
CalcExpress.pas，我搜到的：http://read.pudn.com/downloads152/sourcecode/math/665167/Source.Net/CalcExpress.pas__.htm

再次谢谢楼主！

[广州佬]

再有，OCR单元中所加载的几个库，是从哪里可以得到呢？或它的结构是如何的？如果这些没弄清的话，同样也是无法学习和理解楼主的代码，楼主贴出代码，绝对不是为了招摇，所以，还望指点迷津。再三谢谢！！

[muyfmuyfj]

AsphyreZlib.pas就是zlibex.pas(zlibex组件包里),重命名一下就可以了
CalcExpress.pas是CalcExpress组件包
PNGImage是PNGImage组件包
GIFImage.pas是GIFImage组件包
Math.pas, delphi7自带的文件啊，如果没有，重装delphi!

[muyfmuyfj]

想要特征码dll,加我qq: 2484365584

[muyfmuyfj]

http://www.pudn.com/downloads457/sourcecode/graph/texture_mapping/115157719OcrCtrl.rar

[广州佬]

非常感谢的说

[fbiboss]

下载了不会用啊

[广州佬]

咦！奇哉怪哉！！5楼被人拆了。

[蓝色光芒]

分享代码太好了,多谢

[夜--太美]

[鐵蛋]

学习。。。。