?? ndocr3.dpr
字號:
if x2 > -1 then break;
end;
y1 := -1;
for n1:=0 to unitH-1 do
begin
for n2:=0 to unitW-1 do
begin
if unitAry[n1*unitW+n2] = 1 then
begin
y1 := n1;
break;
end;
end;
if y1 > -1 then break;
end;
y2 := -1;
for n1:=unitH-1 downto 0 do
begin
for n2:=0 to unitW-1 do
begin
if unitAry[n1*unitW+n2] = 1 then
begin
y2 := n1;
break;
end;
end;
if y2 > -1 then break;
end;
Dec(x2,x1-1);
Dec(y2,y1-1);
w := 40;
h := 40;
SetLength(ary,w*h);
for n1:=0 to w*h-1 do ary[n1] := 0;
if x2 > 1 then xp := (w-1)/(x2-1) else xp := w-1;
if y2 > 1 then yp := (h-1)/(y2-1) else yp := h-1;
flag := (xp>1) or (yp>1);
for n1:=0 to y2-1 do
begin
for n2:=0 to x2-1 do
begin
if unitAry[(n1+y1)*unitW+n2+x1] = 1 then
begin
x := Round(n2*xp);
y := Round(n1*yp);
ary[y*w+x] := 1;
if flag then
begin
if n2<x2-1 then unifyDrawLine(n2+1,n1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
if n1<y2-1 then
begin
unifyDrawLine(n2,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
if unitAry[(n1+y1+1)*unitW+n2+x1] = 0 then
begin
if (n2<x2-1) and (unitAry[(n1+y1)*unitW+n2+x1+1]=0) then
unifyDrawLine(n2+1,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
if (n2>0) and (unitAry[(n1+y1)*unitW+n2+x1-1]=0) then
unifyDrawLine(n2-1,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
end else begin
if (n2<x2-1) and (unitAry[(n1+y1)*unitW+n2+x1+1]=1) then
unifyDrawArea(n2+1,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
if (n2>0) and (unitAry[(n1+y1)*unitW+n2+x1-1]=1) then
unifyDrawArea(n2-1,n1+1,x,y,x1,y1,w,unitW,xp,yp,ary,unitAry);
end;
end;
end;
end;
end;
end;
unitW := w;
unitH := h;
unitAry := ary;
result := true;
end;
function osLen(var ary1,ary2:TI25Array):Integer;stdcall;
var
i,v: Integer;
begin
v := 0;
for i:=0 to 24 do Inc(v,(ary1[i]-ary2[i])*(ary1[i]-ary2[i]));
result := v;
end;
function unitIdentity(libName:pchar;mRound,bone,limit,unitW,unitH:Integer;var unitAry:TBArray):string;stdcall;
var
areaAry,ary2: TI25Array;
i1,i2,n1,n2: Integer;
c: string;
begin
c := '?';
if not unifyUnit(unitW,unitH,unitAry) then
begin
result := c;
exit;
end;
for n1:=0 to 24 do areaAry[n1] := 0;
for n1:=0 to unitH-1 do
begin
for n2:=0 to unitW-1 do
begin
if unitAry[n1*unitW+n2] = 1 then
begin
Inc(areaAry[(n1 shr 3)*5 + n2 shr 3]);
end;
end;
end;
n1 := limit + 1;
n2 := -1;
for i1:=0 to Length(libAry)-1 do
begin
if (StrComp(libName,'-')<>0) and (StrComp(libName,pchar(libAry[i1].LibName))<>0) then continue;
i2:=0;
while i2 < Length(libAry[i1].Ary) do
begin
for n1:=0 to 24 do ary2[n1] := libAry[i1].Ary[i2+1+n1];
n1 := osLen(areaAry,ary2);
if (n1<n2) or (n2=-1) then
begin
c := char(libAry[i1].Ary[i2]);
if n1 <= limit then break;
n2 := n1;
end;
Inc(i2,26);
end;
if (n1 <= limit) or (StrComp(libName,pchar(libAry[i1].LibName))=0) then break;
end;
result := c;
end;
function splitArea(spn,spx0,spy0,spuw,spuh,sppw,imgW:Integer;var imgAry:TBArray):TAAIArray;stdcall;
var
ary: TAAIArray;
n1,n2,n3,l: Integer;
begin
SetLength(ary,spn);
for n1:=0 to spn-1 do
begin
for n2:=0 to spuw-1 do
begin
for n3:=0 to spuh-1 do
begin
if imgAry[(n3+spy0)*imgW+n2+n1*(spuw+sppw)+spx0] = 1 then
begin
l := Length(ary[n1]);
SetLength(ary[n1],l+1);
ary[n1][l][0] := n2 + n1*spuw + spx0;
ary[n1][l][1] := n3 + spy0;
end;
end;
end;
end;
n2 := 0;
for n1:=0 to spn-1 do
begin
if Length(ary[n1]) = 0 then
Inc(n2)
else if n2 > 0 then
ary[n1-n2] := ary[n1];
end;
if n2 > 0 then SetLength(ary,Length(ary)-n2);
result := ary;
end;
procedure cutArea(var imgW,imgH:Integer;spx0,spy0,spw2,sph2:Integer;var imgAry:TBArray);
var
ary2: TBArray;
i,n: Integer;
begin
if spw2 <= 0 then spw2 := imgW + spw2;
if sph2 <= 0 then sph2 := imgH + sph2;
if spw2 > imgW then spw2 := imgW;
if sph2 > imgH then sph2 := imgH;
SetLength(ary2,spw2*sph2);
for i:=0 to sph2-1 do
begin
for n:=0 to spw2-1 do
begin
ary2[i*spw2+n] := imgAry[(i+spy0)*imgW+n+spx0];
end;
end;
imgAry := ary2;
imgW := spw2;
imgH := sph2;
end;
function identity(libName:pchar;mRound,bone,maxNoise,limit,spn,spx0,spy0,spuw,spuh,sppw,imgW,imgH:Integer;var imgAry:TBArray):pchar;stdcall;
var
ary: TAAIArray;
unitAry: TBArray;
n,n1,x1,y1,x2,y2,unitW,unitH: Integer;
rt: pchar;
begin
if spx0 < 0 then spx0 := 0;
if spy0 < 0 then spy0 := 0;
if spn = 0 then begin
if (spx0<>0) or (spy0<>0) or (spuw<>0) or (spuh<>0) then cutArea(imgW,imgH,spx0,spy0,spuw,spuh,imgAry);
ary := clearNoise(maxNoise,imgW,imgH,true,imgAry);
end else begin
clearNoise(maxNoise,imgW,imgH,false,imgAry);
n := (imgW-spx0-sppw) div (spuw+sppw);
if (spn = -1) or (spn > n) then spn := n;
ary := splitArea(spn,spx0,spy0,spuw,spuh,sppw,imgW,imgAry);
end;
GetMem(rt,Length(ary)+1);
for n:=0 to Length(ary)-1 do
begin
x1 := ary[n][0][0];
y1 := ary[n][0][1];
x2 := x1;
y2 := y1;
for n1:=1 to Length(ary[n])-1 do
begin
if ary[n][n1][0] < x1 then x1 := ary[n][n1][0];
if ary[n][n1][0] > x2 then x2 := ary[n][n1][0];
if ary[n][n1][1] < y1 then y1 := ary[n][n1][1];
if ary[n][n1][1] > y2 then y2 := ary[n][n1][1];
end;
unitW := x2 - x1 + 1;
unitH := y2 - y1 + 1;
SetLength(unitAry,unitW*unitH);
for n1:=0 to Length(unitAry)-1 do unitAry[n1] := 0;
for n1:=0 to Length(ary[n])-1 do
unitAry[(ary[n][n1][1]-y1)*unitW+ary[n][n1][0]-x1] := 1;
StrCopy(rt+n,pchar(unitIdentity(libName,mRound,bone,limit,unitW,unitH,unitAry)));
end;
result := rt;
end;
function getCode(var pImgAry:TBArray;imgW,imgH:Integer;para:pchar):pchar;stdcall;
var
n,j: Integer;
mRound,bone,lightKind,light1,light2,dots,limit,spn,spx0,spy0,spuw,spuh,sppw: Integer;
maxNoise: Double;
libName: string;
sl: TStringList;
imgAry:TBArray;
begin
SetLength(imgAry,imgW*imgH);
for n:=0 to imgW*imgH-1 do imgAry[n] := (pImgAry[3*n+2]*30 + pImgAry[3*n+1]*59 + pImgAry[3*n]*11) Div 100;
sl := TStringList.Create();
ExtractStrings([','],[],para,sl);
if sl.Count > 0 then
libName := LowerCase(sl[0])
else
libName := '-';
if sl.Count > 1 then begin
mRound := StrToInt(sl[1]);
bone := StrToInt(sl[2]);
lightKind := StrToInt(sl[3]);
light1 := StrToInt(sl[4]);
light2 := StrToInt(sl[5]);
dots := StrToInt(sl[6]);
maxNoise := StrToFloat(sl[7]);
limit := StrToInt(sl[8]);
spn := StrToInt(sl[9]);
spx0 := StrToInt(sl[10]);
spy0 := StrToInt(sl[11]);
spuw := StrToInt(sl[12]);
spuh := StrToInt(sl[13]);
sppw := StrToInt(sl[14]);
end else begin
mRound := 0;
bone := 0;
lightKind := 0;
light1 := 0;
light2 := -1;
dots := 1;
maxNoise := 3;
limit := 0;
spn := 0;
spx0 := 0;
spy0 := 0;
spuw := 0;
spuh := 0;
sppw := 0;
end;
sl.Free();
if libName <> '-' then
begin
j := Length(libAry);
for n:=0 to j-1 do
begin
if StrComp(pchar(libAry[n].LibName),pchar(libName)) = 0 then
begin
mRound := libAry[n].mRound;
bone := libAry[n].bone;
lightKind := libAry[n].lightKind;
light1 := libAry[n].light1;
light2 := libAry[n].light2;
dots := libAry[n].dots;
maxNoise := libAry[n].maxNoise;
limit := libAry[n].limit;
spn := libAry[n].spn;
spx0 := libAry[n].spx0;
spy0 := libAry[n].spy0;
spuw := libAry[n].spuw;
spuh := libAry[n].spuh;
sppw := libAry[n].sppw;
break;
end;
end;
end;
n := picTo01(lightKind,light1,light2,dots,imgW,imgH,imgAry);
if maxNoise < 1 then maxNoise := maxNoise * n;
result := identity(pchar(libName),mRound,bone,Round(maxNoise),limit,spn,spx0,spy0,spuw,spuh,sppw,imgW,imgH,imgAry);
end;
function loadLib_Str(var buf:TBArray;n,l:Integer):string;stdcall;
var
i: Integer;
s: string;
begin
s := '';
for i:=0 to l-1 do s := s + char(buf[n+i]);
result := s;
end;
function loadLib_Int(var buf:Array of byte;var i:Integer):Integer;stdcall;
begin
result := buf[i] + buf[i+1] shl 8 + buf[i+2] shl 16 + buf[i+3] shl 24;
Inc(i,4);
end;
function loadLibFile(fn,libName:pchar):Boolean;stdcall;
var
buf: TBArray;
n,i,j,k: Integer;
sLibName: string;
begin
result := false;
n := FileOpen(fn, fmOpenRead);
if n = -1 then exit;
i := FileSeek(n,0,2);
FileSeek(n,0,0);
SetLength(buf,i);
FileRead(n, buf[0], i);
FileClose(n);
if (loadLib_Str(buf,0,8) <> 'NdOcrLib') then exit;
if buf[8] <> 1 then exit;
if StrComp(libName,'') = 0 then
sLibName := loadLib_Str(buf,59,20)
else
sLibName := libName;
sLibName := LowerCase(sLibName);
j := Length(libAry);
for n:=0 to j-1 do
if StrComp(pchar(libAry[n].LibName),pchar(sLibName)) = 0 then exit;
SetLength(libAry,j+1);
with libAry[j] do
begin
mRound := buf[9];
bone := buf[10];
k := 11;
lightKind := loadLib_Int(buf,k);
light1 := loadLib_Int(buf,k);
light2 := loadLib_Int(buf,k);
dots := loadLib_Int(buf,k);
maxNoise := loadLib_Int(buf,k) / 1000;
limit := loadLib_Int(buf,k);
spn := loadLib_Int(buf,k);
spx0 := loadLib_Int(buf,k);
spy0 := loadLib_Int(buf,k);
spuw := loadLib_Int(buf,k);
spuh := loadLib_Int(buf,k);
sppw := loadLib_Int(buf,k);
end;
libAry[j].LibName := sLibName;
libAry[j].Ary := copy(buf,279,i-279);
result := true;
end;
function loadLib(fn,libName:pchar):Integer;stdcall;
var
sr: TSearchRec;
ret: Integer;
begin
result := 0;
if FileExists(fn) then begin
if loadLibFile(fn,libName) then result := 1;
end else begin
ret := FindFirst(fn+'\*.lib',faAnyFile,sr);
while Ret = 0 do
begin
if loadLibFile(pchar(fn+'\'+sr.Name),'') then Inc(result);
ret := FindNext(sr);
end;
FindClose(sr.FindHandle);
end;
end;
procedure freeLib();stdcall;
begin
SetLength(libAry,0);
end;
exports
loadLib,
freeLib,
getCode
;
begin
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -