这个包是别人写，是用来识别图形到文本的，请问如何实例调用？谢了。。
unit func;interfaceuses
Windows,SysUtils,Classes,Math,comm;procedure roundUnit(var unitW,unitH:Integer;var unitAry:TBArray); //采集点灰度
procedure boneUnit(unitW,unitH:Integer;var unitAry:TBArray); //图片抽骨 (实际效果不好，基本未使用)
function unifyUnit(var unitW,unitH:Integer;var unitAry:TBArray):Boolean; //统一到40*40大小，返回为false时表示没有任何点
function osLen(var ary1,ary2:TI25Array):Integer; //数组的欧氏距离
procedure cutArea(var imgW,imgH:Integer;spx0,spy0,spw2,sph2:Integer;var imgAry:TBArray); //剪裁目标区域
function clearNoise(maxNoise,rlL,rlH,ruW,imgW,imgH:Integer;rtnFlag:Boolean;var imgAry:TBArray):TAAIArray; //消除噪声
function splitArea(spn,spx0,spy0,spuw,spuh,sppw,imgW:Integer;var imgAry:TBArray):TAAIArray; //按照指定区域进行分隔
function picTo01(lightKind:byte;light1,light2,dots,imgW,imgH:Integer;var imgAry:TBArray):Integer;//二值化图像数组，返回有效点总数
function loadLib_Str(var buf:TBArray;n,l:Integer):string;
function loadLib_Int(var buf:Array of byte;var i:Integer):Integer;
procedure to8(x,y,imgW,imgH:Integer;var ary:TAIArray;var imgAry:TBArray); //寻找点集时用的
function loadLibFile(kind,fn:pchar):Boolean;implementation//采集点灰度
procedure setLightAry(i:Integer;var ary:TAIArray;var imgAry:TBArray);
var
n1: Integer;
begin
{or n1:=0 to Length(ary)-1 do
begin
if ary[n1][0]= imgAry then
begin
Inc(ary[n1][1]);
exit;
end;
end;
n1 := Length(ary);
SetLength(ary,n1+1);
ary[n1][0] := imgAry;
ary[n1][1] := 1; }
end;//对采集的点灰度进行排序
procedure sortLightAry(var ary:TAIArray;lightKind:byte);
var
n1,n2,n3,n4,l,kind:Integer;
begin
l := Length(ary) - 1;
if (lightKind = 2) or (lightKind = 4) then
kind := 1 //按数量降序
else
kind := 0; //按灰度降序
for n1:=0 to l-1 do
begin
n3 := ary[n1][kind];
n4 := n1;
for n2:=n1+1 to l do
begin
if n3 < ary[n2][kind] then
begin
n3 := ary[n2][kind];
n4 := n2;
end;
end;
if n4 <> n1 then
begin
n2 := ary[n1][0];
n3 := ary[n1][1];
ary[n1][0] := ary[n4][0];
ary[n1][1] := ary[n4][1];
ary[n4][0] := n2;
ary[n4][1] := n3;
end;
end;
end;//返回在灰度数组中的位置
function indexOfLightAry(c:Integer;var ary:TAIArray):Integer;
var
n:Integer;
begin
for n:=0 to Length(ary)-1 do
begin
if ary[n][0] = c then
begin
result := n;
exit;
end;
end;
result := -1;
end;//返回由otsu确定的分界点
function otsuIndex(var ary:TAIArray):Integer;
var
sum,csum,fmax,m1,m2,sb: Double;
n,k,n1,n2: Integer;
begin
result := 1;
if Length(ary) < 3 then exit;
sum := 0;
csum := 0;
n := 0;
for k:=0 to Length(ary)-1 do
begin
sum := sum + ary[k][0]*ary[k][1];
n := n + ary[k][1];
end;
fmax := -1;
n1 := 0;
for k:=0 to Length(ary)-1 do
begin
n1 := n1 + ary[k][1];
n2 := n - n1;
if n2 = 0 then break;
csum := csum + ary[k][0]*ary[k][1];
m1 := csum / n1;
m2 := (sum-csum) / n2;
sb := n1*n2*(m1-m2)*(m1-m2);
if sb > fmax then
begin
fmax := sb;
result := k + 1;
end;
end;
end;//二值化图像数组，返回有效点总数
//lightKind：0 灰度otsu 1 灰度顺序范围 2 数量顺序范围 3 灰度数值范围 4 数量数值范围
//light1,light2指定归为有效点的分界 (0-n)
//dots 平均每多少个点进行一次采样
function picTo01(lightKind:byte;light1,light2,dots,imgW,imgH:Integer;var imgAry:TBArray):Integer;
var
ary:TAIArray;
ary2:TBArray;
i,l,n1,count:Integer;
begin
//采集
Randomize();
i := 0;
l := imgW*imgH - 1;
count := 0;
while i <= l do
begin
Inc(count);
setLightAry(i,ary,imgAry);
if dots > 2 then
begin
Inc(i,dots+Random(5)-2);
end else begin
Inc(i,dots);
end;
end;
//排序
sortLightAry(ary,lightKind);
//确定分界
if lightKind = 0 then begin
light1 := otsuIndex(ary);
if light2 = -1 then begin
n1 := 0;
{or i:=0 to light1-1 do Inc(n1,ary[1]);
if n1*2 >= count then
light2 := Length(ary)
else begin
light2 := light1;
light1 := 0;
end; }
end;
end else if lightKind < 3 then begin
if light1 = -1 then light1 := Length(ary);
if light2 = -1 then light2 := Length(ary);
end else begin
if light1 = -1 then light1 := imgW * imgH;
if light2 = -1 then light2 := imgW * imgH;
end; //二值化
count := 0;
SetLength(ary2,imgW*imgH);
{or i:=0 to l do
begin
n1 := imgAry;
if lightKind < 3 then n1 := indexOfLightAry(n1,ary);
if (n1>=light1) and (n1<=light2) then
begin
ary2 := 1;
Inc(count);
end else begin
ary2 := 0;
end;
end;} imgAry:=ary2;
result := count;
end;//寻找点集时用的
procedure to8(x,y,imgW,imgH:Integer;var ary:TAIArray;var imgAry:TBArray);
var l:Integer;
begin
if (x>=0) and (x<imgW) and (y>=0) and (y<imgH) and (imgAry[y*imgW+x]=1) then
begin
imgAry[y*imgW+x] := 2;
l := Length(ary);
SetLength(ary,l+1);
ary[l][0] := x;
ary[l][1] := y;
end;
end;//消除噪声
//maxNoise噪声上限
//思路：先将找到的点集设为2，然后判断是否是噪声，噪声则设为0，否则设为3，最后恢复为1
//再根据分离的数量对不当的分离集合进行组合或分离，使结果趋向正确
function clearNoise(maxNoise,rlL,rlH,ruW,imgW,imgH:Integer;rtnFlag:Boolean;var imgAry:TBArray):TAAIArray;
var
n1,n2,n3,n4,x,y,xMin,xMax: Integer;
dbl: Double;
ary,ary2,xBound: TAIArray;
rtnAry: TAAIArray;
begin
if rtnFlag then
begin
SetLength(rtnAry,0);
SetLength(xBound,0);
end;
for n2:=0 to imgW-1 do
begin
for n1:=0 to imgH-1 do
begin
if imgAry[n1*imgW+n2] = 1 then
begin
SetLength(ary,1);
ary[0][0] := n2;
ary[0][1] := n1;
imgAry[n1*imgW+n2] := 2;
n3 := 0;
SetLength(ary2,1);
xMin := n2;
xMax := n2;
While Length(ary2) > 0 do
begin
SetLength(ary2,0);
for n4:=n3 to Length(ary)-1 do
begin
x := ary[n4][0];
y := ary[n4][1];
to8(x-1,y-1,imgW,imgH,ary2,imgAry);
to8(x,y-1,imgW,imgH,ary2,imgAry);
to8(x+1,y-1,imgW,imgH,ary2,imgAry);
to8(x-1,y,imgW,imgH,ary2,imgAry);
to8(x+1,y,imgW,imgH,ary2,imgAry);
to8(x-1,y+1,imgW,imgH,ary2,imgAry);
to8(x,y+1,imgW,imgH,ary2,imgAry);
to8(x+1,y+1,imgW,imgH,ary2,imgAry);
end;
n3 := Length(ary);
SetLength(ary,n3+Length(ary2));
for n4:=0 to Length(ary2)-1 do
begin
ary[n3+n4] := ary2[n4];
if ary2[n4][0] < xMin then xMin := ary2[n4][0];
if ary2[n4][0] > xMax then xMax := ary2[n4][0];
end;
end;
if Length(ary) > maxNoise then
begin
n4 := 3;
if rtnFlag then
begin
n3 := Length(rtnAry);
SetLength(rtnAry,n3+1);
rtnAry[n3] := ary;
SetLength(xBound,n3+1);
xBound[n3][0] := xMin;
xBound[n3][1] := xMax;
end;
end else
n4 := 0;
for n3:=0 to Length(ary)-1 do
imgAry[ary[n3][0]+ary[n3][1]*imgW] := n4;
end;
end;
end;
n2 := imgW*imgH-1;
for n1:=0 to n2 do
if imgAry[n1] = 3 then imgAry[n1] := 1; if rtnFlag then
begin
//对不适当分割进行合并
while (rlH <> 0) and (Length(rtnAry) > rlH) do
begin
//寻找合并后宽度变化最小的2个单元
n2 := imgW;
n1 := 0;
for n3:=0 to Length(rtnAry)-2 do
begin
n4 := Max(xBound[n3][1],xBound[n3+1][1]) - xBound[n3][0] - Max(xBound[n3][1]-xBound[n3][0],xBound[n3+1][1]-xBound[n3+1][0]);
if n4 < n2 then
begin
n2 := n4;
n1 := n3;
end;
end; //进行合并
n2 := Length(rtnAry[n1]);
SetLength(rtnAry[n1],n2+Length(rtnAry[n1+1]));
for n3:=n2 to Length(rtnAry[n1])-1 do
rtnAry[n1][n3] := rtnAry[n1+1][n3-n2];
xBound[n1][1] := xBound[n1+1][1]; //把后面的向前调整
for n2:=n1+1 to Length(rtnAry)-2 do
begin
rtnAry[n2] := rtnAry[n2+1];
xBound[n2] := xBound[n2+1];
end;
SetLength(rtnAry,Length(rtnAry)-1);
SetLength(xBound,Length(xBound)-1);
end;
unit func;interfaceuses
Windows,SysUtils,Classes,Math,comm;procedure roundUnit(var unitW,unitH:Integer;var unitAry:TBArray); //采集点灰度
procedure boneUnit(unitW,unitH:Integer;var unitAry:TBArray); //图片抽骨 (实际效果不好，基本未使用)
function unifyUnit(var unitW,unitH:Integer;var unitAry:TBArray):Boolean; //统一到40*40大小，返回为false时表示没有任何点
function osLen(var ary1,ary2:TI25Array):Integer; //数组的欧氏距离
procedure cutArea(var imgW,imgH:Integer;spx0,spy0,spw2,sph2:Integer;var imgAry:TBArray); //剪裁目标区域
function clearNoise(maxNoise,rlL,rlH,ruW,imgW,imgH:Integer;rtnFlag:Boolean;var imgAry:TBArray):TAAIArray; //消除噪声
function splitArea(spn,spx0,spy0,spuw,spuh,sppw,imgW:Integer;var imgAry:TBArray):TAAIArray; //按照指定区域进行分隔
function picTo01(lightKind:byte;light1,light2,dots,imgW,imgH:Integer;var imgAry:TBArray):Integer;//二值化图像数组，返回有效点总数
function loadLib_Str(var buf:TBArray;n,l:Integer):string;
function loadLib_Int(var buf:Array of byte;var i:Integer):Integer;
procedure to8(x,y,imgW,imgH:Integer;var ary:TAIArray;var imgAry:TBArray); //寻找点集时用的
function loadLibFile(kind,fn:pchar):Boolean;implementation//采集点灰度
procedure setLightAry(i:Integer;var ary:TAIArray;var imgAry:TBArray);
var
n1: Integer;
begin
{or n1:=0 to Length(ary)-1 do
begin
if ary[n1][0]= imgAry then
begin
Inc(ary[n1][1]);
exit;
end;
end;
n1 := Length(ary);
SetLength(ary,n1+1);
ary[n1][0] := imgAry;
ary[n1][1] := 1; }
end;//对采集的点灰度进行排序
procedure sortLightAry(var ary:TAIArray;lightKind:byte);
var
n1,n2,n3,n4,l,kind:Integer;
begin
l := Length(ary) - 1;
if (lightKind = 2) or (lightKind = 4) then
kind := 1 //按数量降序
else
kind := 0; //按灰度降序
for n1:=0 to l-1 do
begin
n3 := ary[n1][kind];
n4 := n1;
for n2:=n1+1 to l do
begin
if n3 < ary[n2][kind] then
begin
n3 := ary[n2][kind];
n4 := n2;
end;
end;
if n4 <> n1 then
begin
n2 := ary[n1][0];
n3 := ary[n1][1];
ary[n1][0] := ary[n4][0];
ary[n1][1] := ary[n4][1];
ary[n4][0] := n2;
ary[n4][1] := n3;
end;
end;
end;//返回在灰度数组中的位置
function indexOfLightAry(c:Integer;var ary:TAIArray):Integer;
var
n:Integer;
begin
for n:=0 to Length(ary)-1 do
begin
if ary[n][0] = c then
begin
result := n;
exit;
end;
end;
result := -1;
end;//返回由otsu确定的分界点
function otsuIndex(var ary:TAIArray):Integer;
var
sum,csum,fmax,m1,m2,sb: Double;
n,k,n1,n2: Integer;
begin
result := 1;
if Length(ary) < 3 then exit;
sum := 0;
csum := 0;
n := 0;
for k:=0 to Length(ary)-1 do
begin
sum := sum + ary[k][0]*ary[k][1];
n := n + ary[k][1];
end;
fmax := -1;
n1 := 0;
for k:=0 to Length(ary)-1 do
begin
n1 := n1 + ary[k][1];
n2 := n - n1;
if n2 = 0 then break;
csum := csum + ary[k][0]*ary[k][1];
m1 := csum / n1;
m2 := (sum-csum) / n2;
sb := n1*n2*(m1-m2)*(m1-m2);
if sb > fmax then
begin
fmax := sb;
result := k + 1;
end;
end;
end;//二值化图像数组，返回有效点总数
//lightKind：0 灰度otsu 1 灰度顺序范围 2 数量顺序范围 3 灰度数值范围 4 数量数值范围
//light1,light2指定归为有效点的分界 (0-n)
//dots 平均每多少个点进行一次采样
function picTo01(lightKind:byte;light1,light2,dots,imgW,imgH:Integer;var imgAry:TBArray):Integer;
var
ary:TAIArray;
ary2:TBArray;
i,l,n1,count:Integer;
begin
//采集
Randomize();
i := 0;
l := imgW*imgH - 1;
count := 0;
while i <= l do
begin
Inc(count);
setLightAry(i,ary,imgAry);
if dots > 2 then
begin
Inc(i,dots+Random(5)-2);
end else begin
Inc(i,dots);
end;
end;
//排序
sortLightAry(ary,lightKind);
//确定分界
if lightKind = 0 then begin
light1 := otsuIndex(ary);
if light2 = -1 then begin
n1 := 0;
{or i:=0 to light1-1 do Inc(n1,ary[1]);
if n1*2 >= count then
light2 := Length(ary)
else begin
light2 := light1;
light1 := 0;
end; }
end;
end else if lightKind < 3 then begin
if light1 = -1 then light1 := Length(ary);
if light2 = -1 then light2 := Length(ary);
end else begin
if light1 = -1 then light1 := imgW * imgH;
if light2 = -1 then light2 := imgW * imgH;
end; //二值化
count := 0;
SetLength(ary2,imgW*imgH);
{or i:=0 to l do
begin
n1 := imgAry;
if lightKind < 3 then n1 := indexOfLightAry(n1,ary);
if (n1>=light1) and (n1<=light2) then
begin
ary2 := 1;
Inc(count);
end else begin
ary2 := 0;
end;
end;} imgAry:=ary2;
result := count;
end;//寻找点集时用的
procedure to8(x,y,imgW,imgH:Integer;var ary:TAIArray;var imgAry:TBArray);
var l:Integer;
begin
if (x>=0) and (x<imgW) and (y>=0) and (y<imgH) and (imgAry[y*imgW+x]=1) then
begin
imgAry[y*imgW+x] := 2;
l := Length(ary);
SetLength(ary,l+1);
ary[l][0] := x;
ary[l][1] := y;
end;
end;//消除噪声
//maxNoise噪声上限
//思路：先将找到的点集设为2，然后判断是否是噪声，噪声则设为0，否则设为3，最后恢复为1
//再根据分离的数量对不当的分离集合进行组合或分离，使结果趋向正确
function clearNoise(maxNoise,rlL,rlH,ruW,imgW,imgH:Integer;rtnFlag:Boolean;var imgAry:TBArray):TAAIArray;
var
n1,n2,n3,n4,x,y,xMin,xMax: Integer;
dbl: Double;
ary,ary2,xBound: TAIArray;
rtnAry: TAAIArray;
begin
if rtnFlag then
begin
SetLength(rtnAry,0);
SetLength(xBound,0);
end;
for n2:=0 to imgW-1 do
begin
for n1:=0 to imgH-1 do
begin
if imgAry[n1*imgW+n2] = 1 then
begin
SetLength(ary,1);
ary[0][0] := n2;
ary[0][1] := n1;
imgAry[n1*imgW+n2] := 2;
n3 := 0;
SetLength(ary2,1);
xMin := n2;
xMax := n2;
While Length(ary2) > 0 do
begin
SetLength(ary2,0);
for n4:=n3 to Length(ary)-1 do
begin
x := ary[n4][0];
y := ary[n4][1];
to8(x-1,y-1,imgW,imgH,ary2,imgAry);
to8(x,y-1,imgW,imgH,ary2,imgAry);
to8(x+1,y-1,imgW,imgH,ary2,imgAry);
to8(x-1,y,imgW,imgH,ary2,imgAry);
to8(x+1,y,imgW,imgH,ary2,imgAry);
to8(x-1,y+1,imgW,imgH,ary2,imgAry);
to8(x,y+1,imgW,imgH,ary2,imgAry);
to8(x+1,y+1,imgW,imgH,ary2,imgAry);
end;
n3 := Length(ary);
SetLength(ary,n3+Length(ary2));
for n4:=0 to Length(ary2)-1 do
begin
ary[n3+n4] := ary2[n4];
if ary2[n4][0] < xMin then xMin := ary2[n4][0];
if ary2[n4][0] > xMax then xMax := ary2[n4][0];
end;
end;
if Length(ary) > maxNoise then
begin
n4 := 3;
if rtnFlag then
begin
n3 := Length(rtnAry);
SetLength(rtnAry,n3+1);
rtnAry[n3] := ary;
SetLength(xBound,n3+1);
xBound[n3][0] := xMin;
xBound[n3][1] := xMax;
end;
end else
n4 := 0;
for n3:=0 to Length(ary)-1 do
imgAry[ary[n3][0]+ary[n3][1]*imgW] := n4;
end;
end;
end;
n2 := imgW*imgH-1;
for n1:=0 to n2 do
if imgAry[n1] = 3 then imgAry[n1] := 1; if rtnFlag then
begin
//对不适当分割进行合并
while (rlH <> 0) and (Length(rtnAry) > rlH) do
begin
//寻找合并后宽度变化最小的2个单元
n2 := imgW;
n1 := 0;
for n3:=0 to Length(rtnAry)-2 do
begin
n4 := Max(xBound[n3][1],xBound[n3+1][1]) - xBound[n3][0] - Max(xBound[n3][1]-xBound[n3][0],xBound[n3+1][1]-xBound[n3+1][0]);
if n4 < n2 then
begin
n2 := n4;
n1 := n3;
end;
end; //进行合并
n2 := Length(rtnAry[n1]);
SetLength(rtnAry[n1],n2+Length(rtnAry[n1+1]));
for n3:=n2 to Length(rtnAry[n1])-1 do
rtnAry[n1][n3] := rtnAry[n1+1][n3-n2];
xBound[n1][1] := xBound[n1+1][1]; //把后面的向前调整
for n2:=n1+1 to Length(rtnAry)-2 do
begin
rtnAry[n2] := rtnAry[n2+1];
xBound[n2] := xBound[n2+1];
end;
SetLength(rtnAry,Length(rtnAry)-1);
SetLength(xBound,Length(xBound)-1);
end;
//对联体进行分割(简单的在中间分割)
while (rlL <> 0) and (Length(rtnAry) > 0) and (Length(rtnAry) < rlL) do
begin
//寻找最大宽度的单元
n1 := Length(rtnAry[0]);
n2 := 0;
for n3:=1 to Length(rtnAry)-1 do
begin
if Length(rtnAry[n3]) > n1 then
begin
n1 := Length(rtnAry[n3]);
n2 := n3;
end;
end; //估算分割为几部分
if ruW <> 0 then
begin
n4 := Max(Min(Round(n1/ruW),rlL-Length(rtnAry)+1),2)
end else
n4 := 2; //分割前，向后推移，中间插值
SetLength(rtnAry,Length(rtnAry)+n4-1);
SetLength(xBound,Length(xBound)+n4-1);
for n3:=Length(rtnAry)-1 downto n2+n4 do
begin
rtnAry[n3] := rtnAry[n3-n4+1];
xBound[n3] := xBound[n3-n4+1];
end; //分配新分割的横向区域
dbl := (xBound[n2][1] - xBound[n2][0]) / n4;
xBound[n2+n4-1][1] := xBound[n2][1];
xBound[n2][1] := xBound[n2][0] + Round(dbl) - 1;
for n3:=2 to n4-1 do
begin
xBound[n2+n3-1][0] := xBound[n2+n3-2][1] + 1;
xBound[n2+n3-1][1] := xBound[n2][0] + Round(dbl*n3) - 1;
end;
xBound[n2+n4-1][0] := xBound[n2+n4-2][1] + 1; //对分割点进行重新分配
ary := rtnAry[n2];
for n3:=1 to n4 do SetLength(rtnAry[n2+n3-1],0);
for n3:=0 to Length(ary)-1 do
begin
for n1:=n2 to n2+n4-1 do
if (ary[n3][0]>=xBound[n1][0]) and (ary[n3][0]<=xBound[n1][1]) then
break;
if n1 <= n2+n4-1 then
begin
SetLength(rtnAry[n1],Length(rtnAry[n1])+1);
rtnAry[n1][Length(rtnAry[n1])-1][0] := ary[n3][0];
rtnAry[n1][Length(rtnAry[n1])-1][1] := ary[n3][1];
end;
end;
end; //把可能出现的空单元删除
for n1:=0 to Length(rtnAry)-1 do
begin
if Length(rtnAry[n1]) = 0 then
begin
for n3:=n1 to Length(rtnAry)-2 do
begin
rtnAry[n3] := rtnAry[n3+1];
xBound[n3] := xBound[n3+1];
end;
SetLength(rtnAry,Length(rtnAry)-1);
SetLength(xBound,Length(xBound)-1);
end;
end;
end; result := rtnAry;
end;//图片修整
procedure fixUnit(unitW,unitH:Integer;var unitAry:TBArray);
var
ary: Array of Integer;
n1,n2,n3: Integer;
begin
SetLength(ary,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
//去除周围只有一个邻居的点
n3 := 0;
if n1 > 0 then
begin
Inc(n3,unitAry[(n1-1)*unitW+n2]);
if n2 > 0 then Inc(n3,unitAry[(n1-1)*unitW+n2-1]);
if n2 < unitW-1 then Inc(n3,unitAry[(n1-1)*unitW+n2+1]);
end;
if n1 < unitH-1 then
begin
Inc(n3,unitAry[(n1+1)*unitW+n2]);
if n2 > 0 then Inc(n3,unitAry[(n1+1)*unitW+n2-1]);
if n2 < unitW-1 then Inc(n3,unitAry[(n1+1)*unitW+n2+1]);
end;
if n2 > 0 then Inc(n3,unitAry[n1*unitW+n2-1]);
if n2 < unitW-1 then Inc(n3,unitAry[n1*unitW+n2+1]);
if n3 = 1 then
begin
n3 := Length(ary);
SetLength(ary,n3+1);
ary[n3] := n1*unitW+n2;
end;
end else begin
//添补4个正方向被堵死的点
n3 := 0;
if n1 > 0 then Inc(n3,unitAry[(n1-1)*unitW+n2]);
if n1 < unitH-1 then Inc(n3,unitAry[(n1+1)*unitW+n2]);
if n2 > 0 then Inc(n3,unitAry[n1*unitW+n2-1]);
if n2 < unitW-1 then Inc(n3,unitAry[n1*unitW+n2+1]);
if n3 = 4 then unitAry[n1*unitW+n2] := 1;
end;
end;
end;
for n1:=0 to Length(ary)-1 do unitAry[ary[n1]] := 0; //去除周围有2个邻居，且相连的点
//去除周围有3个邻居，且在同一方向的点
SetLength(ary,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
n3 := 0;
if n1 > 0 then
begin
if n2 > 0 then Inc(n3,unitAry[(n1-1)*unitW+n2-1]);
Inc(n3,unitAry[(n1-1)*unitW+n2] shl 1);
if n2 < unitW-1 then Inc(n3,unitAry[(n1-1)*unitW+n2+1] shl 2);
end;
if n2 > 0 then Inc(n3,unitAry[n1*unitW+n2-1] shl 3);
if n2 < unitW-1 then Inc(n3,unitAry[n1*unitW+n2+1] shl 4);
if n1 < unitH-1 then
begin
if n2 > 0 then Inc(n3,unitAry[(n1+1)*unitW+n2-1] shl 5);
Inc(n3,unitAry[(n1+1)*unitW+n2] shl 6);
if n2 < unitW-1 then Inc(n3,unitAry[(n1+1)*unitW+n2+1] shl 7);
end;
if (n3=3) or (n3=6) or (n3=20) or (n3=144) or (n3=192) or (n3=96) or (n3=40) or (n3=9)
or (n3=7) or (n3=148) or (n3=41) or (n3=224) then
begin
n3 := Length(ary);
SetLength(ary,n3+1);
ary[n3] := n1*unitW+n2;
end;
end;
end;
end;
for n1:=0 to Length(ary)-1 do unitAry[ary[n1]] := 0;
end;//旋转图片，使旋转干扰失效
procedure roundUnit(var unitW,unitH:Integer;var unitAry:TBArray);
begin
//未实现
end;//根据骨线模板对点进行标记
procedure boneDeal(tn,w,h,i,n,unitW,unitH:Integer;var unitAry:TBArray;var dotF:Boolean);
var
i1,i2,v: Integer;
begin
for i1:=1 to w do
begin
for i2:=1 to h do
begin
v := boneTp[tn][(i2-1)*w+i1-1];
if (v<>-1) and (unitAry[(i+i2-2)*unitW+(n+i1-2)]<>v) then exit;
end;
end;
dotF := true;
end;//图片抽骨 (实际效果不好，基本未使用)
procedure boneUnit(unitW,unitH:Integer;var unitAry:TBArray);
var
i,n: Integer;
flag,dotF: Boolean;
begin
flag := true;
while flag do
begin
flag := false;
for i:=1 to unitH-2 do
begin
for n:=1 to unitW-2 do
begin
if unitAry[i*unitW+n] = 1 then
begin
dotF := false;
if n < unitW-2 then
begin
if not dotF then boneDeal(0,4,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(1,4,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(2,4,3,i,n,unitW,unitH,unitAry,dotF);
end;
if not dotF then boneDeal(3,3,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(4,3,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(5,3,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(6,3,3,i,n,unitW,unitH,unitAry,dotF);
if (i<unitH-2) and (not dotF) then boneDeal(7,3,4,i,n,unitW,unitH,unitAry,dotF);
if dotF then
begin
unitAry[i*unitW+n] := 0;
if not flag then flag := true;
end;
end;
end;
end;
end;
//使用2个紧缩模板再进行一轮细化
for i:=1 to unitH-2 do
begin
for n:=1 to unitW-2 do
begin
if unitAry[i*unitW+n] = 1 then
begin
dotF := false;
if not dotF then boneDeal(8,3,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(9,3,3,i,n,unitW,unitH,unitAry,dotF);
if dotF then unitAry[i*unitW+n] := 0;
end;
end;
end;
end;//标准化连线
procedure unifyDrawLine(toX,toY,x,y,x1,y1,w,unitW:Integer;xp,yp:Double;var ary,unitAry:TBArray);
var
dx,dy,dt,n: Integer;
begin
if unitAry[(toY+y1)*unitW+toX+x1] = 0 then exit;
toX := Round(toX*xp);
toY := Round(toY*yp);
dx := toX - x;
dy := toY - y;
if Abs(dx) > Abs(dy) then dt := Abs(dx) else dt := Abs(dy);
for n:=1 to dt-1 do ary[(y+Round(n*dy/dt))*w+x+Round(n*dx/dt)] := 1;
end;//标准化填区域
procedure unifyDrawArea(toX,toY,x,y,x1,y1,w,unitW:Integer;xp,yp:Double;var ary,unitAry:TBArray);
var
dx,dy,n1,n2: Integer;
begin
if unitAry[(toY+y1)*unitW+toX+x1] = 0 then exit;
toX := Round(toX*xp);
toY := Round(toY*yp);
dx := toX - x;
dy := toY - y;
for n1:=1 to Abs(dy)-1 do
for n2:=1 to Abs(dx)-1 do
ary[(y+n1*Sign(dy))*w+x+n2*Sign(dx)] := 1;
end;
while (rlL <> 0) and (Length(rtnAry) > 0) and (Length(rtnAry) < rlL) do
begin
//寻找最大宽度的单元
n1 := Length(rtnAry[0]);
n2 := 0;
for n3:=1 to Length(rtnAry)-1 do
begin
if Length(rtnAry[n3]) > n1 then
begin
n1 := Length(rtnAry[n3]);
n2 := n3;
end;
end; //估算分割为几部分
if ruW <> 0 then
begin
n4 := Max(Min(Round(n1/ruW),rlL-Length(rtnAry)+1),2)
end else
n4 := 2; //分割前，向后推移，中间插值
SetLength(rtnAry,Length(rtnAry)+n4-1);
SetLength(xBound,Length(xBound)+n4-1);
for n3:=Length(rtnAry)-1 downto n2+n4 do
begin
rtnAry[n3] := rtnAry[n3-n4+1];
xBound[n3] := xBound[n3-n4+1];
end; //分配新分割的横向区域
dbl := (xBound[n2][1] - xBound[n2][0]) / n4;
xBound[n2+n4-1][1] := xBound[n2][1];
xBound[n2][1] := xBound[n2][0] + Round(dbl) - 1;
for n3:=2 to n4-1 do
begin
xBound[n2+n3-1][0] := xBound[n2+n3-2][1] + 1;
xBound[n2+n3-1][1] := xBound[n2][0] + Round(dbl*n3) - 1;
end;
xBound[n2+n4-1][0] := xBound[n2+n4-2][1] + 1; //对分割点进行重新分配
ary := rtnAry[n2];
for n3:=1 to n4 do SetLength(rtnAry[n2+n3-1],0);
for n3:=0 to Length(ary)-1 do
begin
for n1:=n2 to n2+n4-1 do
if (ary[n3][0]>=xBound[n1][0]) and (ary[n3][0]<=xBound[n1][1]) then
break;
if n1 <= n2+n4-1 then
begin
SetLength(rtnAry[n1],Length(rtnAry[n1])+1);
rtnAry[n1][Length(rtnAry[n1])-1][0] := ary[n3][0];
rtnAry[n1][Length(rtnAry[n1])-1][1] := ary[n3][1];
end;
end;
end; //把可能出现的空单元删除
for n1:=0 to Length(rtnAry)-1 do
begin
if Length(rtnAry[n1]) = 0 then
begin
for n3:=n1 to Length(rtnAry)-2 do
begin
rtnAry[n3] := rtnAry[n3+1];
xBound[n3] := xBound[n3+1];
end;
SetLength(rtnAry,Length(rtnAry)-1);
SetLength(xBound,Length(xBound)-1);
end;
end;
end; result := rtnAry;
end;//图片修整
procedure fixUnit(unitW,unitH:Integer;var unitAry:TBArray);
var
ary: Array of Integer;
n1,n2,n3: Integer;
begin
SetLength(ary,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
//去除周围只有一个邻居的点
n3 := 0;
if n1 > 0 then
begin
Inc(n3,unitAry[(n1-1)*unitW+n2]);
if n2 > 0 then Inc(n3,unitAry[(n1-1)*unitW+n2-1]);
if n2 < unitW-1 then Inc(n3,unitAry[(n1-1)*unitW+n2+1]);
end;
if n1 < unitH-1 then
begin
Inc(n3,unitAry[(n1+1)*unitW+n2]);
if n2 > 0 then Inc(n3,unitAry[(n1+1)*unitW+n2-1]);
if n2 < unitW-1 then Inc(n3,unitAry[(n1+1)*unitW+n2+1]);
end;
if n2 > 0 then Inc(n3,unitAry[n1*unitW+n2-1]);
if n2 < unitW-1 then Inc(n3,unitAry[n1*unitW+n2+1]);
if n3 = 1 then
begin
n3 := Length(ary);
SetLength(ary,n3+1);
ary[n3] := n1*unitW+n2;
end;
end else begin
//添补4个正方向被堵死的点
n3 := 0;
if n1 > 0 then Inc(n3,unitAry[(n1-1)*unitW+n2]);
if n1 < unitH-1 then Inc(n3,unitAry[(n1+1)*unitW+n2]);
if n2 > 0 then Inc(n3,unitAry[n1*unitW+n2-1]);
if n2 < unitW-1 then Inc(n3,unitAry[n1*unitW+n2+1]);
if n3 = 4 then unitAry[n1*unitW+n2] := 1;
end;
end;
end;
for n1:=0 to Length(ary)-1 do unitAry[ary[n1]] := 0; //去除周围有2个邻居，且相连的点
//去除周围有3个邻居，且在同一方向的点
SetLength(ary,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
n3 := 0;
if n1 > 0 then
begin
if n2 > 0 then Inc(n3,unitAry[(n1-1)*unitW+n2-1]);
Inc(n3,unitAry[(n1-1)*unitW+n2] shl 1);
if n2 < unitW-1 then Inc(n3,unitAry[(n1-1)*unitW+n2+1] shl 2);
end;
if n2 > 0 then Inc(n3,unitAry[n1*unitW+n2-1] shl 3);
if n2 < unitW-1 then Inc(n3,unitAry[n1*unitW+n2+1] shl 4);
if n1 < unitH-1 then
begin
if n2 > 0 then Inc(n3,unitAry[(n1+1)*unitW+n2-1] shl 5);
Inc(n3,unitAry[(n1+1)*unitW+n2] shl 6);
if n2 < unitW-1 then Inc(n3,unitAry[(n1+1)*unitW+n2+1] shl 7);
end;
if (n3=3) or (n3=6) or (n3=20) or (n3=144) or (n3=192) or (n3=96) or (n3=40) or (n3=9)
or (n3=7) or (n3=148) or (n3=41) or (n3=224) then
begin
n3 := Length(ary);
SetLength(ary,n3+1);
ary[n3] := n1*unitW+n2;
end;
end;
end;
end;
for n1:=0 to Length(ary)-1 do unitAry[ary[n1]] := 0;
end;//旋转图片，使旋转干扰失效
procedure roundUnit(var unitW,unitH:Integer;var unitAry:TBArray);
begin
//未实现
end;//根据骨线模板对点进行标记
procedure boneDeal(tn,w,h,i,n,unitW,unitH:Integer;var unitAry:TBArray;var dotF:Boolean);
var
i1,i2,v: Integer;
begin
for i1:=1 to w do
begin
for i2:=1 to h do
begin
v := boneTp[tn][(i2-1)*w+i1-1];
if (v<>-1) and (unitAry[(i+i2-2)*unitW+(n+i1-2)]<>v) then exit;
end;
end;
dotF := true;
end;//图片抽骨 (实际效果不好，基本未使用)
procedure boneUnit(unitW,unitH:Integer;var unitAry:TBArray);
var
i,n: Integer;
flag,dotF: Boolean;
begin
flag := true;
while flag do
begin
flag := false;
for i:=1 to unitH-2 do
begin
for n:=1 to unitW-2 do
begin
if unitAry[i*unitW+n] = 1 then
begin
dotF := false;
if n < unitW-2 then
begin
if not dotF then boneDeal(0,4,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(1,4,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(2,4,3,i,n,unitW,unitH,unitAry,dotF);
end;
if not dotF then boneDeal(3,3,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(4,3,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(5,3,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(6,3,3,i,n,unitW,unitH,unitAry,dotF);
if (i<unitH-2) and (not dotF) then boneDeal(7,3,4,i,n,unitW,unitH,unitAry,dotF);
if dotF then
begin
unitAry[i*unitW+n] := 0;
if not flag then flag := true;
end;
end;
end;
end;
end;
//使用2个紧缩模板再进行一轮细化
for i:=1 to unitH-2 do
begin
for n:=1 to unitW-2 do
begin
if unitAry[i*unitW+n] = 1 then
begin
dotF := false;
if not dotF then boneDeal(8,3,3,i,n,unitW,unitH,unitAry,dotF);
if not dotF then boneDeal(9,3,3,i,n,unitW,unitH,unitAry,dotF);
if dotF then unitAry[i*unitW+n] := 0;
end;
end;
end;
end;//标准化连线
procedure unifyDrawLine(toX,toY,x,y,x1,y1,w,unitW:Integer;xp,yp:Double;var ary,unitAry:TBArray);
var
dx,dy,dt,n: Integer;
begin
if unitAry[(toY+y1)*unitW+toX+x1] = 0 then exit;
toX := Round(toX*xp);
toY := Round(toY*yp);
dx := toX - x;
dy := toY - y;
if Abs(dx) > Abs(dy) then dt := Abs(dx) else dt := Abs(dy);
for n:=1 to dt-1 do ary[(y+Round(n*dy/dt))*w+x+Round(n*dx/dt)] := 1;
end;
//标准化填区域
procedure unifyDrawArea(toX,toY,x,y,x1,y1,w,unitW:Integer;xp,yp:Double;var ary,unitAry:TBArray);
var
dx,dy,n1,n2: Integer;
begin
if unitAry[(toY+y1)*unitW+toX+x1] = 0 then exit;
toX := Round(toX*xp);
toY := Round(toY*yp);
dx := toX - x;
dy := toY - y;
for n1:=1 to Abs(dy)-1 do
for n2:=1 to Abs(dx)-1 do
ary[(y+n1*Sign(dy))*w+x+n2*Sign(dx)] := 1;
end;
//统一到40*40大小，返回为false时表示没有任何点
function unifyUnit(var unitW,unitH:Integer;var unitAry:TBArray):Boolean;
var
ary: TBArray;
n1,n2,x,y,x1,x2,y1,y2,w,h: Integer;
xp,yp: Double;
flag: Boolean;
begin
//舍弃周围空白
x1 := -1;
for n1:=0 to unitW-1 do
begin
for n2:=0 to unitH-1 do
begin
if unitAry[n2*unitW+n1] = 1 then
begin
x1 := n1;
break;
end;
end;
if x1 > -1 then break;
end;
if x1 = -1 then
begin
result := false;
exit;
end;
x2 := -1;
for n1:=unitW-1 downto 0 do
begin
for n2:=0 to unitH-1 do
begin
if unitAry[n2*unitW+n1] = 1 then
begin
x2 := n1;
break;
end;
end;
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;//按照指定区域进行分隔
//spn: 0 自动分隔，否则按指定区域分隔; -1 最大可分隔数; >0 限制在最大分隔数内
//spx0,spy0:从0开始的
function splitArea(spn,spx0,spy0,spuw,spuh,sppw,imgW:Integer;var imgAry:TBArray):TAAIArray;
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 loadLib_Str(var buf:TBArray;n,l:Integer):string;
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;
begin
//sult := buf + buf[i+1] shl 8 + buf[i+2] shl 16 + buf[i+3] shl 24;
Inc(i,4);
end;function loadLibFile(kind,fn:pchar):Boolean;
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; //版本
sLibName := loadLib_Str(buf,71,20);
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);
rlL := loadLib_Int(buf,k);
rlH := loadLib_Int(buf,k);
ruW := loadLib_Int(buf,k);
end;
libAry[j].LibName := sLibName;
libAry[j].Ary := copy(buf,291,i-291);
result := true;
end;end.
我是楼主：另一个单元，comm.pas代码：
unit comm;interfacetype
TBArray = Array of byte;
TABArray = Array of TBArray;
TAIArray = Array of Array[0..1] of Integer;
TAAIArray = Array of TAIArray;
TI25Array = Array[0..24] of byte;
TLib = record
LibName: string;
mRound,bone,lightKind,light1,light2,dots,limit,spn,spx0,spy0,spuw,spuh,sppw,rlL,rlH,ruW: Integer;
maxNoise: Double;
Ary: TBArray;
end;const
boneTp: Array[0..9] of Array[0..11] of Integer =
(
(0,-1,1,-1,0,1,1,1,0,-1,1,-1),
(0,0,-1,-1,0,1,1,1,-1,1,1,-1),
(-1,1,1,-1,0,1,1,1,0,0,-1,-1),
(1,1,1,-1,1,-1,0,0,0,99,99,99),
(1,-1,0,1,1,0,1,-1,0,99,99,99),
(-1,0,0,1,1,0,-1,1,-1,99,99,99),
(-1,1,-1,1,1,0,-1,0,0,99,99,99),
(0,0,0,-1,1,-1,1,1,1,-1,1,-1),
(0,0,0,0,1,0,1,1,1,99,99,99),
(0,0,1,0,1,1,0,0,1,99,99,99)
);var
libAry: Array of TLib;implementationend.
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs，func,comm;
调用的时候，如用在本单元函数一样调用
要写出实例的话，要先要理解各个函数的功能，还要明白完成整个功能使用函数的顺序(如可能得先调用loadLibFile)，以及参数的用法等。
像这样的接口一般要有文档说明的。