除了汉字，需要制作太多的模版，字母和数字，都是可以的。

OCR的，一般性方法。

灰度处理---中值滤波---细化---平滑---然后模版比对覆盖率




灰度处理
//计算数量
  m:=0;
  for y:=0 to FHeight -1 do
    for x:=0 to FHeight -1 do
    begin
      r :=((Buf[y*FHeight+x] and $F800) shr 11) * 256   div   32;
      g :=((Buf[y*FHeight+x] and $07E0) shr 5)  * 256   div   64;
      b :=( Buf[y*FHeight+x] and $001F) * 256   div   32;
      //灰度算法一
      n:=0.212671*R   +   0.715160*G   +   0.072169*B ;
      //灰度算法二  随便哪个算法结果似乎都一样。
      //n:=0.114*R   +   0.587*G   +   0.299*B ;
      if n>k  then m:=m+1;
    end;

平滑
procedure TPictureTools.SmothPixel(X,Y:integer);
var
A:Array[0..2,0..2] of Integer;
Z:integer;
i,J:integer;
N:integer;
begin
   A[0,0] := 1; A[0,1] := 2; A[0,2] := 1;
   A[1,0] := 2; A[1,1] := 4; A[1,2] := 2;
   A[2,0] := 1; A[2,1] := 2; A[2,2] := 1;
   z := 16;
   N:=0;
   For I:=-1 to 1 do
   begin
        For J:=-1 to 1 do
        if Self.GetPixel(X+J,Y+I)=ForeGroundPoint then
        begin
           N:=N+A[I+1,J+1];
        end;
   end;
   if N<8 then Self.setPixel(X,Y);
end;

细化
procedure TPicturetools.InterThin;
var
   X, Y: integer;
   nb: array[1..3, 1..3] of byte;
   c1, c2, c3, c4: boolean;
   ncount: integer;
begin
   for X:= 1 to FWidth - 2 do
   begin
      for Y := 1 to FHeight - 2 do
      begin
         if Self.GetPixel(X,Y)=BackGroundPoint then Continue;
         c1 := false;
         c2 := false;
         c3 := false;
         c4 := false;
         // 设立四个条件的初始值
         nb[1, 1] := self.GetPixel(X-1,Y-1);
         nb[1, 2] := self.GetPixel(X-1,Y);
         nb[1, 3] := self.GetPixel(X-1,Y+1);
         nb[2, 1] := self.GetPixel(X,Y-1);
         nb[2, 2] := self.GetPixel(X,Y);
         nb[2, 3] := self.GetPixel(X,Y+1);
         nb[3, 1] := self.GetPixel(X+1,Y-1);
         nb[3, 2] := self.GetPixel(X+1,Y);
         nb[3, 3] := self.GetPixel(X+1,Y+1);
         //将[x,y]周围的八个象素点和它自己0-1化
         nCount := nb[1, 1] + nb[1, 2] + nb[1, 3]
            + nb[2, 1] + nb[2, 3]
            + nb[3, 1] + nb[3, 2] + nb[3, 3];
         // 获得ncount的值
         if (ncount >= 2) and (ncount <= 6) then
            c1 := True;
         //condition1
         ncount := 0;
         if (nb[1, 1] = 0) and (nb[1, 2] = 1) then
            inc(ncount);
         if (nb[1, 2] = 0) and (nb[1, 3] = 1) then
            inc(ncount);
         if (nb[1, 3] = 0) and (nb[2, 3] = 1) then
            inc(ncount);
         if (nb[2, 3] = 0) and (nb[3, 3] = 1) then
            inc(ncount);
         if (nb[3, 3] = 0) and (nb[3, 2] = 1) then
            inc(ncount);
         if (nb[3, 2] = 0) and (nb[3, 1] = 1) then
            inc(ncount);
         if (nb[3, 1] = 0) and (nb[2, 1] = 1) then
            inc(ncount);
         if (nb[2, 1] = 0) and (nb[1, 1] = 1) then
            inc(ncount);
         if ncount = 1 then
            c2 := true;
         //condition2
         if (nb[1, 2] * nb[3, 2] * nb[2, 3] = 0) then
            c3 := true;
         // condition3
         if (nb[2, 1] * nb[2, 3] * nb[3, 2] = 0) then
            c4 := true;
         //condition4
         if (c1 and c2 and c3 and c4) then
         begin
            self.SetPixel(X,y)
            //设置O[X]为白色
         end;
      end;
   end;
end;

procedure TPictureTools.RotateByAngle(Angle:integer);
var
C1x,C1Y,P1x,P1y:integer;
C2x,C2y,P2x,P2y:integer;
N:integer;
Bx,BY:integer;
NewPic:Array of Array of Byte;
R,alpha,Beta:real;
V1,V2,V3,V4:byte;
begin
    N:=Max(FWidth,Fheight);
    setlength(NewPic,N,N);
    for P2x:=0 to N-1 do
    for P2y:=0 to N-1 do
    Newpic[p2x,p2y]:=BackGRoundPoint;
//    FillMemory(Newpic[0],N*N,1);
    Beta:=Angle * PI / 180;
    C1x:=Fwidth div 2;
    C1y:=FHeight div 2;
    C2x:=N div 2;
    C2y:=N div 2;
    N:=Max(C2x,C2y);
    dec(N);
    for P2x:=0 to N do
    begin
        for P2y:=0 to N do
        begin
            if p2x = 0 then alpha := pi / 2
            else  alpha := arctan2(p2y,p2x);
            R := sqrt(sqr(p2x) + sqr(p2y));
            p1x := round(R * cos(Beta + alpha));
            p1y := round(R * sin(Beta + alpha));
            V1 := self.GetPixel(c1x + p1x, c1y + p1y);
            V2 := self.GetPixel(c1x - p1x, c1y - p1y);
            V3 := self.GetPixel(c1x + p1y, c1y - p1x);
            V4 := self.GetPixel(c1x - p1y, c1y + p1x);

            Newpic[c2x + p2x, c2y + p2y]:= V1;
            NewPic[c2x - p2x, c2y - p2y]:= V2;
            NewPic[c2x + p2y, c2y - p2x]:= V3;
            Newpic[c2x - p2y, c2y + p2x]:= V4;

        end;
    end;
    Bx:=C2x-(FWidth div 2);
    By:=C2Y-(Fheight div 2);
    for P1x:=1 to Fwidth-2 do
    begin
        for P1y:=1 to Fheight-2 do
        begin
            setvalue(P1x,P1y,Newpic[Bx+P1x,By+P1y]);
        end;
    end;
end;

中值滤波
procedure TPictureTools.FilterPixel(x,y,Num:integer;T:integer=2);
var
N,i,j:integer;
begin
    if (Y<=1) or (X<=1) or(X>=FWidth-2) or (Y>=Fheight-2) then
    begin
        SetPixel(X,Y);
        exit;
    end;
    N:=0;
    for I:=X-NUM to X+NUM do
    begin
        for J:=Y-NUM to Y+NUM do
        begin
            if Self.GetPixel(I,J)=ForeGroundPoint then inc(N);
        end;
    end;
    if N<(sqr(2*NUM+1) div (T*Num)) then SetPixel(X,Y)
//    else setPixel(x,Y);
end;

//矫正
procedure TpictureTools.Rectifer;
var
Bak:PByte;
V1,V2:integer;
D1,D2,D3:integer;
begin
    //保存原图象的副本
    GetMem(Bak,FMemSize);
    copyMemory(bak,FPoints,FMemSize);

    GetDataV(V1,V2);
    D1:=V2-V1;
    if D1>DataWidthKey then
    begin
         CopyMemory(Fpoints,Bak,FMemSize);
         RotateByAngle(MinAngle);
         GetDataV(V1,V2);
         D2:=V2-V1;
         if (D2>D1) then
         begin
                CopyMemory(Fpoints,Bak,FMemSize);
                RotateByAngle(-1*MinAngle);
                GetDataV(V1,V2);
                D3:=V2-V1;
                if D3<=DataWidthKey then
                begin
                    FreeMem(Bak);
                    exit;
                end;
         end
         else   begin
                    FreeMem(Bak);
                    exit;
                end;
    end;
    FreeMem(Bak);
end;

最后，根据覆盖率，识别。
function COCR.GetFuGaiLv (x,y,ModeIdx,N:integer):single;
var
  i,j,k,M : integer;
begin
  result :=0; k:=0; M:=0;
  for i:=0 to MinLetterHeight -1 do
    for j:=0 to MinLetterWidth -1 do
    begin
      if (x+j)>=MinLetterWidth*(N+1) then continue;
      if (y+i)>=MinLetterHeight  then continue;
      m:=M+1;
      if (PicMode[ModeIdx].buf[i*MinLetterWidth+j]=SrcPicBuf[(y+i)*FWidth+(x+j)]) then
        //and (SrcPicBuf[(y+i)*FWidth+(x+j)]=ForeGroundPoint) then
        k:=k+1;
    end;
  //result :=k / PicMode[ModeIdx].ForePointNum ;
  result :=k / m ;
end;

//识别算法
function COCR.GetLetter(N : integer;Memo: TMemo;Edit:TEdit) :string;
var
  k :integer ;
  Flv,MaxFlv : single;
begin
  result :='9' ;
  MaxFlv :=0;
  Memo.Lines.Add('====='+inttostr(N)+'=====');
  Edit.Color :=clRed;
      for k:=0 to nPicMode -1 do
      begin
        Flv :=GetFuGaiLv(N*MinLetterWidth,0,k,N);
        if (Flv>MaxFlv) and (FLV>0.8) then
        begin
          MaxFlv :=Flv ;

          result :=PicMode[k].Letter ;
          Memo.Lines.Add(format('L=%s,Flv=%.2f,K=%d',[result,Flv,k]));
          if Flv>0.995 then
            Edit.Color :=clWindow ;
        end;
      end;

end;

[课程]FART 脱壳王！加量不加价！FART作者讲授！

上传的附件：

• 111.jpg （117.64kb，4次下载）
• 112.jpg （32.54kb，2次下载）
• 113.jpg （35.65kb，1次下载）