Delphi识别读取验证码

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 = ; //自动
  FMT_PNG = ; //png
  FMT_BMP = ; //bmp
  FMT_GIF = ; //gif
  FMT_JPEG = ; //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[.., ..] of byte;  //字符图像
  end;

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

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

 type
   TOcrVersionSng = array [..] of Byte;
   TOcrVersion = record    //版本号
    First,Minjor: Byte;   //版本
    Author: String[];   //作者
    Name: String[];     //特征码名称
  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', , 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 <>  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),#);
     MycharInfo.DivCmp := ;
     MycharInfo.DivColr := $7FFFFF;
     MycharInfo._CmpChr := True;
     MycharInfo._CmpBg := False;
     MycharInfo.X0 := ;
     MycharInfo.charwidth := ;
     MycharInfo.CusDiv := False;
     MycharInfo.charheight := ;
     FillChar(_Effect,SizeOf(RSpeicalEffects),#);
     _Effect.To1Line := False;
     _Effect.RemoveZD := False;
     Setting.SaveBMP := False;
     Setting.BmpPrefix := 'OCR';
     Setting.BmpSuffix := '';
     LastRecogTime := ;
   except
   end;
 end;

function FetchOCR(const StartIndex: Integer; const Width,Height: Integer; const AOCRName: String = ''): Integer;
 var
   I: Integer;
 begin
   Result := -;
   for I := StartIndex to Integer(Templates.Count) -  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())+'OCR.INI';
   try
     Templates.Count := ;
     SetLength(Templates.Names,);
     SetLength(Templates.OCRFiles,);
     Ini := TIniFile.Create(FileName);
     Templates.Count := Byte(Ini.ReadInteger('OCRLIB','TCNT',));
     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 :=  to Templates.Count -  do
     begin
       S := Ini.ReadString('OCRLIB','T'+IntToStr(I),'');
       if S <> '' then
       begin
         J := Pos(';',S);
         S2 := Copy(S,,J-);
         S := Copy(S,J+,Length(S)-J+);
         if UseDll then Templates.OCRFiles[I] := S2
         else Templates.OCRFiles[I] := ExtractFilePath(ParamStr())+S2;
         J := Pos(';',S);
         S2 := Copy(S,,J-);
         S := Copy(S,J+,Length(S)-J+);
         Templates.OCRSz[I].W := Byte(StrToInt(S2));
         J := Pos(';',S);
         S2 := Copy(S,,J-);
         S := Copy(S,J+,Length(S)-J+);
         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[] = Byte('O')) and (dat.Sng[] = Byte('C'));
   end;
 begin
   Result := False;
   try
     Fstrm := TFileStream.Create(ocrFile,fmOpenRead);
     strm := TMemoryStream.Create;
     try
       Fstrm.Position := ;
       ZDecompressStream(FStrm,strm);
       Fstrm.Free;

       strm.Position := ;
       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 :=
     else SSCode := ;
   except
   end;
 end;
 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 =  then Exit;
     Result := Data[];
     for I :=  to Count -  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 :=  to Chw -  do
     begin
       M := ;
       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,);
   end;
 begin
   SetLength(MinJL,CharL);
   Ch := TBitmap.Create;
   for X :=  to CharL -  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(,,Ch.Width,Ch.Height);
     Ch.Canvas.CopyRect(Rect(,,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(,,Ch.Width,Ch.Height));
   end;
   Ch.Free;
   SetLength(MinJL,);
 end;

function GetTail(str,sp : String): Integer;
 var
   Temp : String;
 begin
   Temp := Str;
   Delete(Temp,,Pos(sp,str)+length(sp)-);
   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 ],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 := ;
   For I :=  to L Do
    Begin
    Sum := Sum * ;
    If ( Ord(Hex[I]) >= Ord('')) and (Ord(Hex[I]) <= Ord('')) then
       Sum := Sum + Ord(Hex[I]) - Ord('')
    else If ( Ord(Hex[I]) >= Ord('A') ) and (Ord(Hex[I]) <= Ord('F')) then
       Sum := Sum + Ord(Hex[I]) - Ord('A') +
    else If ( Ord(Hex[I]) >= Ord('a') ) and ( Ord(Hex[I]) <= Ord('f')) then
       Sum := Sum + Ord(Hex[I]) - Ord('a') +
    else
       Begin
       Sum := -;
       break;
       End;
    End;
   Result := Sum;
 End;

function GetHead(str,sp : String):string;
 begin
   Result:=copy(str,,pos(sp,str)-);
 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 := ;
     if Count =  then Exit;
     for I :=  to Count -  do
     begin
       Result := Result + Data[I];
     end;
     Result := Round(Result/Count);
   end;
 begin
   bmp.PixelFormat := pf24bit;
   SetLength(arr,bmp.Height*bmp.Width);
   for Y :=  to bmp.Height -  do
   begin
     p := bmp.ScanLine[Y];
     J := ;
     while J < bmp.Width* do
     begin
       arr[(Y*bmp.Width)+J div ] := Round((p[J]+p[J+]+p[J+])/);
       Inc(J,);
     end;
   end;
   W := Byte(AverageArr(Arr,bmp.Height*bmp.Width));
   for Y :=  to bmp.Height -  do
   begin
     p := bmp.ScanLine[Y];
     J := ;
     while J < bmp.Width* do
     begin
       if Round((p[J]+p[J+]+p[J+])/) >= W then
       begin
         p[J] := ;
         p[J+] := ;
         p[J+] := ;
       end else
       begin
         p[J] := MaxByte;
         p[J+] := MaxByte;
         p[J+] := MaxByte;
       end;
       Inc(J,);
     end;
   end;
   SetLength(Arr,);
 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 :=  to bmp.Width -  do
   begin
     for Y :=  to bmp.Height -  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 :=  to bmp.Height -  do
   begin
     p := bmp.ScanLine[Y];
     J := ;
     while J < bmp.Width* do
     begin
       W := (P[J] *  + P[J+] * + P[J+] * );
       W := W shr ;
       P[J] := Byte(W);
       P[J+] := Byte(W);
       P[J+] := Byte(W);
       Inc(J,);
     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 := ;
         BMP.Assign(PNG);
       except
         //not png image
      end;
       PNG.Free;
     end else if FileEx = '.BMP' then
       try
         BMP.LoadFromFile(filename);
         _PicFormat := ;
       except
         //not bmp image
      end
     else if FileEx = '.GIF' then
     begin
       GIF := TGIFImage.Create;
       try
         GIF.LoadFromFile(filename);
         _PicFormat := ;
         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 := ;
         BMP.Assign(JPG);
       except
         //not jpg image
      end;
       JPG.Free;
     end;
     //
    if _PicFormat =  then
       try
         BMP.LoadFromFile(FileName);
         _PicFormat := ;
       except
       end;
     if _PicFormat =  then
     begin
       PNG := TPNGobject.Create;
       try
         PNG.LoadFromFile(FileName);
         _PicFormat := ;
         BMP.Assign(PNG);
       finally
         PNG.Free;
       end;
     end;
     if _PicFormat =  then
     begin
       GIF := TGIFImage.Create;
       try
         GIF.LoadFromFile(FileName);
         _PicFormat := ;
         BMP.Assign(GIF);
       finally
         GIF.Free;
       end;
     end;
     if _PicFormat =  then
     begin
       JPG := TJPEGImage.Create;
       try
         JPG.LoadFromFile(FileName);
         BMP.Assign(JPG);
         _PicFormat := ;
       finally
         JPG.Free;
       end;
     end;
     Result := True;
   except
   end;
 end;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 := ;
   FileEx := UpperCase(ExtractFileExt(filename));
   BMP := TBITMAP.Create;
   if FileEx = '.PNG' then
   begin
     PNG := TPNGobject.Create;
     try
       PNG.LoadFromFile(filename);
       _PicFormat := ;
       BMP.Assign(PNG);
     except
       //not png image
    end;
     PNG.Free;
   end else if FileEx = '.BMP' then
     try
       BMP.LoadFromFile(filename);
       _PicFormat := ;
     except
       //not bmp image
    end
   else if FileEx = '.GIF' then
   begin
     GIF := TGIFImage.Create;
     try
       GIF.LoadFromFile(filename);
       _PicFormat := ;
       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 := ;
       JPG.Grayscale := TRUE;
       BMP.Assign(JPG);
     except
       //not jpg image
    end;
     JPG.Free;
   end;
   //
  if _PicFormat =  then
     try
       BMP.LoadFromFile(FileName);
       _PicFormat := ;
     except
     end;
   if _PicFormat =  then
   begin
     PNG := TPNGobject.Create;
     try
       PNG.LoadFromFile(FileName);
       _PicFormat := ;
       BMP.Assign(PNG);
     finally
       PNG.Free;
     end;
   end;
   if _PicFormat =  then
   begin
     GIF := TGIFImage.Create;
     try
       GIF.LoadFromFile(FileName);
       _PicFormat := ;
       BMP.Assign(GIF);
     finally
       GIF.Free;
     end;
   end;
   if _PicFormat =  then
   begin
     JPG := TJPEGImage.Create;
     try
       JPG.LoadFromFile(FileName);
       JPG.Grayscale := TRUE;
       BMP.Assign(JPG);
       _PicFormat := ;
     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 :=  to BMP.Height -  do
     begin
       SrcRGB := BMP.ScanLine[j];
       for i :=  to BMP.Width -  do
       begin
         if MycharInfo._ClrRect then
         begin
           x := MycharInfo._RectLen;
           if (iBMP.Width--x)or(j>BMP.Height--x) then
           begin
             SrcRGB[i*]   := $ff;
             SrcRGB[i*+] := $ff;
             SrcRGB[i*+] := $ff;
             continue;
           end;
         end;
         ClPixel := HexToInt(IntToHex(SrcRGB[i*],)+
                               IntToHex(SrcRGB[i*+],)+
                               IntToHex(SrcRGB[i*+],));
         if MycharInfo.CusDiv then
         begin
           case MycharInfo.DivCmp of
           :  b := ClPixel > MycharInfo.DivColr;
           :  b := ClPixel = MycharInfo.DivColr;
           :  b := ClPixel < MycharInfo.DivColr;
           :  b := ClPixel <> MycharInfo.DivColr;
           end;
         end else
           b := ClPixel > MycharInfo.DivColr;
         if b then begin
           SrcRGB[i*]   := $ff;
           SrcRGB[i*+] := $ff;
           SrcRGB[i*+] := $ff;
         end else begin
           SrcRGB[i*]   := ;
           SrcRGB[i*+] := ;
           SrcRGB[i*+] := ;
         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 (iBMP.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 := ;
   for j :=  to MycharInfo.charheight - do
   begin
     SrcRGB := SBMP.ScanLine[j];
     for i :=  to MycharInfo.charwidth - do
     begin
       if MycharInfo._CmpChr and (SrcRGB[(x0+i)*] = ) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = ) then
         Inc(Result);
       if MycharInfo._CmpBg and (SrcRGB[(x0+i)*] > ) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = ) 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 := ;
   for xj :=  to _BITMAP.Height - MycharInfo.charheight do
   begin
     Ret := ;
     for j :=  to MycharInfo.charHeight -  do
     begin
       SrcRGB := SBMP.ScanLine[j+xj];
       for i :=  to MycharInfo.charwidth -  do
       begin
         if MycharInfo._CmpChr and (SrcRGB[(x0+i)*] = ) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = ) then
           Inc(Ret);
         if MycharInfo._CmpBg  and (SrcRGB[(x0+i)*] > ) and (MycharInfo.allcharinfo[m].MyCharInfo[i, j] = ) 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 [..] 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 :=  to MycharInfo.TotalChars -  do
   begin
     x := MycharInfo.X0 + MyCharInfo.charwidth * k;
     //DebugLog('k:'+IntToStr(k)+'  '+'x:'+IntToStr(x));
    SlAlike.Clear;
     Sort := True;
     for m :=  to  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 =  then
         begin
           Result := Result + S;
           //DebugLog('get_it:'+s);
          //DebugStr('GET_IT','GET '+S+ ' AS '+IntToStr(k+)+ 'TH NUM','e:');

           Sort := False;
           break;
         end else
           SlAlike.Add(S + Sp + IntToStr(Alike));
       end;
     end;
     if Sort then
     begin
       SlQuickSort(SlAlike,,SlAlike.Count-);
       result := result + GetHead(SlAlike[],Sp);
       //DebugLog('get_it_by_sort:'+GetHead(SlAlike[],Sp));
      //DebugStr('GET_IT_SORT','GET '+GetHead(SlAlike[],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 =  then Result := SSUtils.RecogSuanshi(Result);
   except
     LastRecogTime := ;
   end;
 end;
 end.
//----------------------------------------------------------
 //----------------------------------------------------------
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 :=  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 [..] of Extended = (,);
 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.