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 = 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
     char byte; //字符宽度
    charheight: byte; //字符高度
    X0: byte; //第一个字符开始x偏移
    TotalChars: byte; //图象字符总数
    CusDiv : boolean;  //自定义二值化运算
    DivCmp : Byte; //  0:>  1:=  2:<<br>     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;
 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;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 (iBMP.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 (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 := 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.
//----------------------------------------------------------
 //----------------------------------------------------------
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.