小弟水平低,代码写的很乱,请谅解
需用到calcexprress,pngimage和gifimage,这里不再提供!unit OCR;interfaceuses 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/jpegimplementationuses 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;

解决方案 »

  1.   


    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;
      

  2.   


    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.
      

  3.   

    ssutils单元:unit SSUtils;interfaceuses Windows, SysUtils, CalcExpress;function RecogSuanshi(const S: String): String;implementationfunction 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.
      

  4.   

    不错,写个demo更好
      

  5.   

    楼主分享代码,能让后来者得到启迪,若能提供下引用的单元在何处下载,那就更完美了。
    不是懒得去搜索,主要是:如引用了同名而不同内容的单元时,就无法正确地使用和领略你以上的代码的编程风采了。就如下列单元,是否即是你所引用的单元?还是仅同名而已?
    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再次谢谢楼主!
      

  6.   

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

  7.   

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

  8.   

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