func.pas

识别动网asp论坛的验证码 程序语言：delphi 7.0 作者：netdust 2007-12-4

unit func;

interface

uses
  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;
  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
  for n1:=0 to Length(ary)-1 do
  begin
    if ary[n1][0] = imgAry[i] then
    begin
      Inc(ary[n1][1]);
      exit;
    end;
  end;
  n1 := Length(ary);
  SetLength(ary,n1+1);
  ary[n1][0] := imgAry[i];
  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;
      for i:=0 to light1-1 do Inc(n1,ary[i][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);
  for i:=0 to l do
  begin
    n1 := imgAry[i];
    if lightKind < 3 then n1 := indexOfLightAry(n1,ary);
    if (n1>=light1) and (n1<=light2) then
    begin
      ary2[i] := 1;
      Inc(count);
    end else begin
      ary2[i] := 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]);