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:<<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.