灰度处理
//计算数量
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);
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;