小弟水平低，代碼寫的很亂，請諒解
需用到calcexprress,pngimage和gifimage，這里不再提供!
unit OCR;
interface
uses Windows, SysUtils, Graphics, Classes, PNGImage, GIFImage, JPEG, Math, AsphyreZlib;
type
TOCRLibSetting = record //驗證碼庫設定
SaveBMP: Boolean; //存盤轉換后的Bmp檔案
BmpPath: String; //Bmp存盤路徑
BmpPrefix: String; //Bmp檔案前綴
BmpSuffix: String; //Bmp檔案后綴
end;
type
//影像大小類
TOCRSz = record
W,H: Byte; //寬，高
end;
//特征碼模板庫類
TOCRTemplates = record
Count: Byte; //數量
Names: array of String; //名稱
OCRFiles: array of String; //檔案名/路徑
OCRSz: array of TOCRSz; //影像大小
YaoqiuSS: array of Byte; //是否為算式
end;
//初始化驗證碼庫
function InitOCRLib: Boolean;
//取消使用Dll
procedure CancelUseDLL;
//加載驗證碼模板庫
function LoadOCRLib(const AFileName: String = ''): Boolean;
//影像轉換為BMP
function ALL2BMP(const Filename : String; const Bmp: TBitmap): Boolean;
//加載資源dll
function LoadOCRResourceDLL(const ADllName: String): Boolean;
//識別驗證碼
function RecogOCR(var Success: Boolean; const ImageFile: String): String;
//更改特征碼模板
function LoadOCRTemplate(const TmplID: Integer): Boolean;
//加載特征碼檔案
function LoadOCRFile(const ocrFile: String; const IsAutoSS: Boolean = False): Boolean;
//查找驗證碼特征檔案
function FetchOCR(const StartIndex: Integer; const Width,Height: Integer; const AOCRName: String = ''): Integer;
//驗證碼庫設定
function SetOCRLib(const ASetting: TOCRLibSetting): Boolean;
//獲得驗證碼庫設定
function GetOCRLibSetting: TOCRLibSetting;
//獲得驗證碼模板庫
function GetOCRTemplates: TOCRTemplates;
//獲取最后識別時間(毫秒)
function GetLastRecogTime: DWORD;
//呼叫AspriseOcr
//function RecogOCRByOCRLib(const FileName: String): String;
//釋放驗證碼庫/清除特征碼檔案
function FreeOcr: Boolean;
//procedure SetPicFormat(Format: Byte);
const
FMT_AUTO = 4; //自動
FMT_PNG = 2; //png
FMT_BMP = 1; //bmp
FMT_GIF = 3; //gif
FMT_JPEG = 0; //jpg/jpeg
implementation
uses IniFiles, SSUtils;
type
RSpeicalEffects = record //特殊效果
To1Line: Boolean; //字符歸位
RemoveZD: Boolean; //消除噪點
Y0: Byte; //Y軸偏移
XcZD: Byte; //噪點閥值
end;
type //字符特征碼
RChar = record
MyChar: char; //字符
used: Boolean; //已使用
MyCharInfo: array[0..49, 0..49] of byte; //字符影像
end;
type //字符特征檔案
RCharInfo = record
charwidth: byte; //字符寬度
charheight: byte; //字符高度
X0: byte; //第一個字符開始x偏移
TotalChars: byte; //圖象字符總數
CusDiv : boolean; //自定義二值化運算
DivCmp : Byte; // 0:> 1:= 2:<
DivColr : TColor; //二值化閥值
_CmpChr,_CmpBg: Boolean; //比較字符(黑色),比較背景(白色)
_ClrRect: Boolean; //清除矩形
_RectLen: Byte; //矩形長度
allcharinfo: array[0..42] of RChar; //字符特征碼串列
end;
type
TOcrVersionSng = array [0..1] of Byte;
TOcrVersion = record //版本號
First,Minjor: Byte; //版本
Author: String[10]; //作者
Name: String[20]; //特征碼名稱
end;
ROcrLibFile = record
Sng: TOcrVersionSng; //版本標識
Ver: TOcrVersion; //版本
W,H: Byte; //影像寬,高
Effect: RSpeicalEffects; //特殊效果
CharInfo: RCharInfo; //特征碼
EffectBLW: Boolean; //通用二值化
end;
TOcrLibDllInfo = record
DllFile: String;
MDLRPrefix: String;
MDLRType: String;
end;
var
_BITMAP: TBitmap; //識別影像
MycharInfo: RCharInfo; //特征碼
_Effect: RSpeicalEffects; //特效
_EffBLW: Boolean; //通用二值化
SSCode: Byte; //是否為算式
var
BmW,BmH: Integer; //特征碼影像寬,高
OcrName: String; //特征碼名稱
_PicFormat: Byte; //影像格式
_PicWidth,_PicHeight: Byte; //實際影像寬,高
Templates: TOCRTemplates; //模板串列
Setting: TOCRLibSetting;
LastRecogTime: DWORD;
var
UseDll: Boolean;
DllInfo: TOcrLibDllInfo;
const
SP = '@';
procedure CancelUseDLL;
begin
UseDll := False;
end;
function GetLastRecogTime: DWORD;
begin
Result := LastRecogTime;
end;
function GetOCRLibSetting: TOCRLibSetting;
begin
Result := Setting;
end;
function GetOCRTemplates: TOCRTemplates;
begin
Result := Templates;
end;
function LoadOCRResourceDLL(const ADllName: String): Boolean;
var
strm: TResourceStream;
hDll: THandle;
S: String;
function GetTempPathFileName: String;
var
SPath, SFile : PChar;
begin
SPath := AllocMem(MAX_PATH);
SFile := AllocMem(MAX_PATH);
GetTempPath(MAX_PATH, SPath);
GetTempFileName(SPath, '~OC', 0, SFile);
Result := String(SFile);
FreeMem(SPath, MAX_PATH);
FreeMem(SFile, MAX_PATH);
DeleteFile(Result);
end;
begin
Result := False;
try
hDll := LoadLibrary(PChar(ADllName));
if hDll <> 0 then
begin
try
strm := TResourceStream.Create(hDll,
'SDSOFT_OCR',
PChar('OCR'));
S := GetTempPathFileName;
strm.SaveToFile(S);
try
UseDll := True;
Result := LoadOCRLib(S);
except
UseDll := False;
end;
if Result = False then UseDll := False;
if UseDll = True then DllInfo.DllFile := ADllName;
DeleteFile(S);
finally
FreeLibrary(hDll);
end;
end;
Result := True;
except
end;
end;
function SetOCRLib(const ASetting: TOCRLibSetting): Boolean;
begin
Result := False;
try
Setting := ASetting;
Result := True;
except
end;
end;
function InitOCRLib: Boolean;
begin
Result := False;
try
UseDll := False;
DllInfo.DllFile := '';
DllInfo.MDLRPrefix := '';
DllInfo.MDLRType := '';
_BITMAP := nil;
FillChar(MycharInfo,SizeOf(RCharInfo),#0);
MycharInfo.DivCmp := 3;
MycharInfo.DivColr := $7FFFFF;
MycharInfo._CmpChr := True;
MycharInfo._CmpBg := False;
MycharInfo.X0 := 0;
MycharInfo.charwidth := 0;
MycharInfo.CusDiv := False;
MycharInfo.charheight := 0;
FillChar(_Effect,SizeOf(RSpeicalEffects),#0);
_Effect.To1Line := False;
_Effect.RemoveZD := False;
Setting.SaveBMP := False;
Setting.BmpPrefix := 'OCR';
Setting.BmpSuffix := '';
LastRecogTime := 0;
except
end;
end;
function FetchOCR(const StartIndex: Integer; const Width,Height: Integer; const AOCRName: String = ''): Integer;
var
I: Integer;
begin
Result := -1;
for I := StartIndex to Integer(Templates.Count) - 1 do
begin
if (Templates.Names[I] = AOCRName) or
((Templates.OCRSz[I].W = Width) and (Templates.OCRSz[I].H = Height))
then
begin
Result := I;
Break;
end;
end;
end;
function LoadOCRLib(const AFileName: String = ''): Boolean;
var
Ini: TIniFile;
S,S2: String;
I,J: Integer;
FileName: String;
begin
Result := False;
FileName := AFileName;
if FileName = '' then
FileName := ExtractFilePath(ParamStr(0))+'OCR.INI';
try
Templates.Count := 0;
SetLength(Templates.Names,0);
SetLength(Templates.OCRFiles,0);
Ini := TIniFile.Create(FileName);
Templates.Count := Byte(Ini.ReadInteger('OCRLIB','TCNT',0));
SetLength(Templates.Names,Templates.Count*SizeOf(String));
SetLength(Templates.OCRFiles,Templates.Count*SizeOf(String));
SetLength(Templates.OCRSz,Templates.Count*SizeOf(TOCRSz));
SetLength(Templates.YaoqiuSS,Templates.Count*SizeOf(Byte));
for I := 0 to Templates.Count - 1 do
begin
S := Ini.ReadString('OCRLIB','T'+IntToStr(I),'');
if S <> '' then
begin
J := Pos(';',S);
S2 := Copy(S,1,J-1);
S := Copy(S,J+1,Length(S)-J+1);
if UseDll then Templates.OCRFiles[I] := S2
else Templates.OCRFiles[I] := ExtractFilePath(ParamStr(0))+S2;
J := Pos(';',S);
S2 := Copy(S,1,J-1);
S := Copy(S,J+1,Length(S)-J+1);
Templates.OCRSz[I].W := Byte(StrToInt(S2));
J := Pos(';',S);
S2 := Copy(S,1,J-1);
S := Copy(S,J+1,Length(S)-J+1);
Templates.OCRSz[I].H := Byte(StrToInt(S2));
Templates.YaoqiuSS[I] := Byte(StrToInt(S));
Templates.Names[I] := Ini.ReadString('OCRNAME','T'+IntToStr(I),'');
end;
end;
if UseDll = True then
begin
DllInfo.MDLRPrefix := Ini.ReadString('DLLSETTING','Prefix','');
DllInfo.MDLRType := Ini.ReadString('DLLSETTING','ResourceType','OCR');
end;
Ini.Free;
Result := True;
except
end;
end;
function LoadOCRFile(const ocrFile: String; const IsAutoSS: Boolean = False): Boolean;
var
Fstrm: TFileStream;
strm: TMemoryStream;
dat: ROcrLibFile;
function VersVerify: Boolean;
begin
Result := (dat.Sng[0] = Byte('O')) and (dat.Sng[1] = Byte('C'));
end;
begin
Result := False;
try
Fstrm := TFileStream.Create(ocrFile,fmOpenRead);
strm := TMemoryStream.Create;
try
Fstrm.Position := 0;
ZDecompressStream(FStrm,strm);
Fstrm.Free;
strm.Position := 0;
strm.Read(dat,SizeOf(ROcrLibFile));
if VersVerify = True then
begin
MycharInfo := dat.CharInfo;
_Effect := dat.Effect;
BmW := dat.W;
BmH := dat.H;
OcrName := dat.Ver.Name;
_EffBLW := dat.EffectBLW;
Result := True;
end;
finally
strm.Free;
end;
if IsAutoSS = True then SSCode := 1
else SSCode := 0;
except
end;
end;
uj5u.com熱心網友回復：
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;
uj5u.com熱心網友回復：
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.
uj5u.com熱心網友回復：
ssutils單元:
unit SSUtils;
interface
uses Windows, SysUtils, CalcExpress;
function RecogSuanshi(const S: String): String;
implementation
function DeleteFh(const S: String; const Fh: Char): String;
var
I: Integer;
begin
Result := '';
for I := 1 to Length(S) do
begin
if S[I] <> Fh then
begin
Result := Result + S[I];
end;
end;
end;
function RecogSuanshi(const S: String): String;
const
argv: array [0..1] of Extended = (0,1);
var
S2: String;
cexp: TCalcExpress;
begin
Result := '計算錯誤!';
try
cexp := TCalcExpress.Create(nil);
try
S2 := DeleteFh(S,'?');
S2 := DeleteFh(S,'=');
S2 := StringReplace(S2,'加','+',[rfReplaceAll]);
S2 := StringReplace(S2,'減','-',[rfReplaceAll]);
S2 := StringReplace(S2,'乘','*',[rfReplaceAll]);
S2 := StringReplace(S2,'除','/',[rfReplaceAll]);
S2 := StringReplace(S2,'×','*',[rfReplaceAll]);
S2 := StringReplace(S2,'÷','/',[rfReplaceAll]);
S2 := StringReplace(S2,'＋','+',[rfReplaceAll]);
S2 := StringReplace(S2,'－','-',[rfReplaceAll]);
cexp.Formula := S2;
Result := IntToStr(Round(cexp.calc(argv)));
except
end;
finally
cexp.Free;
end;
end;
end.
uj5u.com熱心網友回復：
不錯，寫個demo更好uj5u.com熱心網友回復：
謝謝分享uj5u.com熱心網友回復：
謝謝分享！摘錄下來，慢慢理解、學習。呵呵，藍鳥哥這么謙虛啊。
uj5u.com熱心網友回復：
樓主分享代碼，能讓后來者得到啟迪，若能提供下參考的單元在何處下載，那就更完美了。不是懶得去搜索，主要是：如參考了同名而不同內容的單元時，就無法正確地使用和領略你以上的代碼的編程風采了。
就如下列單元，是否即是你所參考的單元？還是僅同名而已？
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
再次謝謝樓主！
uj5u.com熱心網友回復：
再有，OCR單元中所加載的幾個庫，是從哪里可以得到呢？或它的結構是如何的？如果這些沒弄清的話，同樣也是無法學習和理解樓主的代碼，樓主貼出代碼，絕對不是為了招搖，所以，還望指點迷津。再三謝謝！！uj5u.com熱心網友回復：
AsphyreZlib.pas就是zlibex.pas(zlibex組件包里),重命名一下就可以了CalcExpress.pas是CalcExpress組件包
PNGImage是PNGImage組件包
GIFImage.pas是GIFImage組件包
Math.pas, delphi7自帶的檔案啊，如果沒有，重裝delphi!
uj5u.com熱心網友回復：
想要特征碼dll,加我qq: 2484365584uj5u.com熱心網友回復：
http://www.pudn.com/downloads457/sourcecode/graph/texture_mapping/115157719OcrCtrl.raruj5u.com熱心網友回復：
非常感謝的說uj5u.com熱心網友回復：
下載了不會用啊uj5u.com熱心網友回復：
咦！奇哉怪哉！！5樓被人拆了。uj5u.com熱心網友回復：
分享代碼太好了,多謝uj5u.com熱心網友回復：
uj5u.com熱心網友回復：
學習。。。。轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/118732.html
下一篇：二維碼運行出錯呀