📄 disrecunit.~pas
字号:
unit DisRecUnit;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, ExtDlgs;
TYPE
RecDistance=array of array of integer;
CharPicture=array[1..30] of Tbitmap;
DistanceData=array of real;
type
TDisRecForm = class(TForm)
Panel1: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
RecComboBox: TComboBox;
GroupBox1: TGroupBox;
DiffPointdEdit: TLabeledEdit;
RelativedEdit: TLabeledEdit;
ViewMemo: TMemo;
Panel2: TPanel;
CharImage: TImage;
Panel3: TPanel;
MatchImage: TImage;
MatchBitBtn: TBitBtn;
BitBtn2: TBitBtn;
CharNumEdit: TEdit;
Button1: TButton;
disOpenPictureDialog: TOpenPictureDialog;
RESLabel: TLabel;
Panel4: TPanel;
Image1: TImage;
PointMatchRadioButton: TRadioButton;
DisMatchRadioButton: TRadioButton;
ListBox1: TListBox;
PropertyMatchRadioButton: TRadioButton;
Bevel1: TBevel;
BitBtn3: TBitBtn;
SaveDialog1: TSaveDialog;
SpeedButton1: TSpeedButton;
SaveMemo: TMemo;
PropertyedEdit: TLabeledEdit;
MomentMatchRadioButton: TRadioButton;
CheckBox1: TCheckBox;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtn2Click(Sender: TObject);
procedure MatchBitBtnClick(Sender: TObject);
procedure PointDisRec(bmp:TBitmap);
procedure RecComboBoxChange(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ClearSmall(Sender:Tobject;Img,Img2:TImage);
procedure GetRegion(Bmp: TBitmap);
procedure CreateBmp(Left,Right,Top,Bottom: integer;bmp1:TBitmap);
procedure Zoom(Image1,NormalImage:TImage);
procedure XDisRec(bmp:TBitmap;PCharPic:CharPicture);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PropertyRec(bmp:TBitmap;PCharPic:CharPicture);
procedure GetRelativeDis(bmp:TBitmap;var mindis:RecDistance;var N1:integer);
function ImageTeZheng(Img:TImage;Data:DistanceData):DistanceData;
procedure SpeedButton1Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure TeZhengBiaoZhun(var TeData:array of double;num:integer);
function Getsquare(Img:TImage):DistanceData;
procedure MomentRec(bmp:TBitmap;PCharPic:CharPicture);
private
{ Private declarations }
public
{ Public declarations }
end;
var
DisRecForm: TDisRecForm;
EFile:TStringList;
PictureOpen:boolean;
ChinesePic:CharPicture;
EnglishPic:CharPicture;
NumberPic: CharPicture;
implementation
uses MainUnit, ChartUnit, PictureViewUnit, FileListUnit, InformUnit;
{$R *.dfm}
function TDisRecForm.Getsquare(Img:TImage):distanceData;
var
i,x,y:integer;
pSum,dx,dy:double;
Bmp:TBitmap;
p:pbytearray;
xmax,xmin,ymax,ymin,xSum,ySum,PointSum:integer;
dd,n1,n2,xAve,yAve:double;
Data:DistanceData;
Label loop;
begin
SetLength(Data,10);
bmp:=TBitmap.Create;
bmp.Assign(img.Picture.Bitmap);
pSum:=bmp.Height*bmp.Width;
XSum:=0;ySum:=0;PointSum:=0;
xmin:=10000;ymin:=10000;xmax:=-1;ymax:=-1;
for y:=0 to bmp.Height-1 do
begin
p:=bmp.ScanLine[y];
for x:=0 to bmp.Width-1 do
begin
if p[3*x]=255 then continue;
XSum:=XSum+x;ySum:=ySum+y;inc(PointSum);
if x<xmin then xmin:=x;
if x>xmax then xmax:=x;
end;
if y<ymin then ymin:=y;
if y>ymax then ymax:=y;
end;
if pSum=0 then goto Loop;
XAve:=XSum/pSum;
yAve:=ySum/pSum;
///////////////////////////////////////////上面为计算x,y平均值
for x:=1 to 15 do SqureNumber[x]:=0;
// 11 20 02 21+ 21- 12+ 12- 30+ 30- 03+ 02-
for y:=0 to bmp.Height-1 do
begin
p:=bmp.ScanLine[y];
for x:=0 to bmp.Width-1 do
begin
if p[3*x]=255 then continue;
dx:=x-xAve;dy:=y-yAve;
SqureNumber[1]:=SqureNumber[1]+dx*dx; // 计算 u(11) 11
SqureNumber[2]:=SqureNumber[2]+dx*dx; // 计算 u(20) 20
SqureNumber[3]:=SqureNumber[3]+dy*dy; // 计算 u(02) 02
if dy>0 then
SqureNumber[4]:=SqureNumber[4]+dx*dx*dy // 计算 u(21)+ 21+
else
SqureNumber[5]:=SqureNumber[5]+dx*dx*dy; // 计算 u(21)- 21-
if dx>0 then
SqureNumber[6]:=SqureNumber[6]+dx*dy*dy // 计算 u(12)+ 12+
else
SqureNumber[7]:=SqureNumber[7]+dx*dy*dy; // 计算 u(12}- 12-
if dx>0 then
SqureNumber[8]:=SqureNumber[8]+dx*dx*dx // 计算 u(30)+ 30+
else
SqureNumber[9]:=SqureNumber[9]+dx*dx*dx; // 计算 u(30)- 30-
if dy>0 then
SqureNumber[10]:=SqureNumber[10]+dy*dy*dy // 计算 u(03)+ 03+
else
SqureNumber[11]:=SqureNumber[11]+dy*dy*dy;// 计算 u(03)- 03-
end;//end for x
end; // end for y;
for x:=1 to 11 do SqureNumber[x]:=SqureNumber[x]/pSum;
///////////////////////////////////////////////////////计算图像的各阶矩
for x:=12 to 20 do SqureNumber[x]:=0;
SqureNumber[12]:=((SqureNumber[2]-SqureNumber[3])/(SqureNumber[2]+SqureNumber[3]))/2; //长宽比特征
dd:=sqrt((SqureNumber[2]-SqureNumber[3])*(SqureNumber[2]-SqureNumber[3])+4*SqureNumber[1]*SqureNumber[1]);
dd:=dd+(SqureNumber[2]-SqureNumber[3]);
SqureNumber[13]:=2*arctan(dd/(2*SqureNumber[1]))/pi; ///字型倾斜度
dd:=sqrt((SqureNumber[2]-SqureNumber[3])*(SqureNumber[2]-SqureNumber[3])+4*SqureNumber[1]*SqureNumber[1]);
n1:=((SqureNumber[2]+SqureNumber[3])+dd)/2;
n2:=((SqureNumber[2]+SqureNumber[3])-dd)/2;
SqureNumber[14]:=(n1-n2)/(n1+n2); //拉长度
n1:=sqrt((ymax-ymin)*(xmax-xmin));
dd:=Sqrt((SqureNumber[2]+SqureNumber[3])/PointSum);
SqureNumber[15]:=dd/n1; //伸展度
if(squreNumber[8]+squreNumber[9])=0 then dd:=0 else
dd:=(squreNumber[8]-squreNumber[9])/(squreNumber[8]+squreNumber[9]);
SqureNumber[16]:=(dd+1)/2; //水平偏移度
if(squreNumber[10]+squreNumber[11])=0 then dd:=0 else
dd:=(squreNumber[10]-squreNumber[11])/(squreNumber[10]+squreNumber[11]);
SqureNumber[17]:=(dd+1)/2; //垂直偏移度
if(squreNumber[4]+squreNumber[5])=0 then dd:=0 else
dd:=(squreNumber[4]-squreNumber[5])/(squreNumber[4]+squreNumber[5]);
SqureNumber[18]:=(dd+1)/2; //水平伸展度度
if(squreNumber[6]+squreNumber[7])=0 then dd:=0 else
dd:=(squreNumber[6]-squreNumber[7])/(squreNumber[6]+squreNumber[7]);
SqureNumber[19]:=(dd+1)/2; //垂直伸展度
Loop:;
for i:=1 to 8 do Data[i]:=SqureNumber[i+11];
Result:=Data;
bmp.Free;
end;
/////////////////////////////////////////////////////////////////////////////////
procedure TDisRecForm.MomentRec(bmp:TBitmap;PCharPic:CharPicture);
var //矩特征计算比较程序
E:wideString;
FPas:string;
minRecNum,i,j,CharNum:Integer;
DisData1,DisData2:DistanceData;
Img:TImage;
sub1,sub2,Ave1,Ave2,SubDis,SubRecDis1,minRecDis,AveRecDis:double;
begin
setLength(Disdata1,10);
setLength(disdata2,10);
E:=EFile.Text;
charNum:=StrToInt(CharNumEdit.text)-1;
Img:=TImage.Create(Application);
Img.Picture.Assign(bmp);
for i:=1 to 8 do Disdata1[i]:=0;
DisData1:=Getsquare(Img);
Ave1:=0; sub1:=0;
minRecDis:=1000000;
ListBox1.Clear;
for i:=0 to CharNum do
begin
AveRecDis:=0;SubRecdis1:=0;
Img.Picture.Assign(PCHarPic[i+1]);
if CHeckBox1.Checked=True then TextForm.Thin(Img.Picture.Bitmap);
for j:=1 to 8 do Disdata2[j]:=0;
DisData2:=Getsquare(Img);
MatchImage.Picture:=Img.Picture;
ave2:=0;sub2:=0;
for j:=1 to 8 do AveRecDis:=AveRecDis+abs(DisData2[j]-DisData1[j]);
AveRecDis:=AveRecDis/8;
for j:=1 to 8 do
begin
SubDis:=abs(DisData2[j]-DisData1[j])-AveRecDis;
SubDis:=SubDis*SubDis;
SubRecDis1:=SubRecDis1+SubDis;
end;
SubRecDis1:=SubRecDis1/8;AveRecDis:=SubRecDis1;
ListBox1.Items.Add(E[i+1]+'：'+FloatToStr(AveRecDis));
if minRecDis>AveRecDis then
begin minRecDis:=AveRecDis; minRecNum:=i;end;
end;
PropertyedEdit.Text:=FloatTostr(minRecDis);
MatchImage.Picture.Bitmap.Assign(PCharPic[minRecNum+1]);
RESLabel.Caption:='匹配结果：'+E[minRecNum+1];
end;
/////////////////////////////////////////////////////////////////////////////////
procedure TDisRecForm.TeZhengBiaoZhun(var TeData:array of double;num:integer);
var
i:integer;
DataSum:double;
begin
DataSum:=0;
for i:=0 to num-1 do DataSum:=DataSum+TeData[i];
DataSum:=DataSum/num;
for i:=0 to num-1 do
if TeData[i]>DataSum then TeData[i]:=0.9
else TeData[i]:=0.1;
end;
function TDisRecForm.ImageTeZheng(Img:TImage;Data:DistanceData):DistanceData;
var
BW,k,m,x,y,i,j,JumpTemp:integer;
p:pbytearray;
bmp:TBitmap;
JumpEnd:boolean;
FourColorCenterx,FourColorCentery:array[1..6] of double;
LineJumpEnd:array[1..34] of boolean;
LineColorJmpS,RowColorJmpS,LineColorJmpE,RowColorJmpE:array[1..34] of double;
LineSum,RowSum:array[1..34] of double;
begin
bmp:=TBitmap.Create;
bmp.Assign(Img.Picture.Bitmap);
k:=0;m:=0;
for x:=0 to bmp.Width-1 do begin
LineSum[x+1]:=0;//列统计值归零
LineJumpEnd[x+1]:=False;
LineColorJmpS[x+1]:=0;
LineColorJmpE[x+1]:=0;
RowColorJmpS[x+1]:=0;
RowColorJmpE[x+1]:=0;
end;
for x:=1 to 4 do begin
FourColorCenterx[x]:=0;
FourColorCentery[x]:=0;
end;
BW:=0;
for y:=0 to bmp.Height-1 do
begin
p:=bmp.ScanLine[y];
JumpTemp:=0; //最后跳跃归零
RowSum[y+1]:=0; //行统计值归零
JumpEnd:=False;
for x:=0 to bmp.Width-1 do
begin
if p[3*x]=255 then continue;
inc(BW); BlackWhiteX[BW]:=x;BlackWhiteY[BW]:=y;
i:=(y div 16);j:=(x div 16); ////////
FourColorCenterx[i*2+j+1]:=FourColorCenterx[i*2+j+1]+x; // 统计四个中心点数
FourColorCentery[i*2+j+1]:=FourColorCentery[i*2+j+1]+y; // 统计四个中心点数
RowSum[y+1]:=RowSum[y+1]+1;;LineSum[x+1]:=LineSum[x+1]+1;//统计行列颜色值
if JumpEnd=False then//////////////////////////////////
begin //
RowColorJmpS[y+1]:=x; JumpEnd:=True; //行起终点统计
end; //
JumpTemp:=x;///////////////////////////////////////////
if LineJumpEnd[x+1]=False then ////////////////////////
begin //
LineColorJmpS[x+1]:=y;LineJumpEnd[x+1]:=True; //列起终点统计
end; //
if LineColorJmpE[x+1]<y then LineColorJmpE[x+1]:=y;////
end;//end for x
RowColorJmpE[y+1]:=JumpTemp;
end;//end for y
for i:=1 to 4 do
begin
FourColorCenterx[i]:=FourColorCenterx[i]/256;
FourColorCentery[i]:=FourColorCentery[i]/256;
end;
{TeZhengBiaoZhun(LineSum,32);
TeZhengBiaoZhun(RowSum,32);
TeZhengBiaoZhun(RowColorJmpS,32);
TeZhengBiaoZhun(RowColorJmpE,32);
TeZhengBiaoZhun(LineColorJmpS,32);
TeZhengBiaoZhun(LineColorJmpE,32);
TeZhengBiaoZhun(FourColorCenterx,4);
TeZhengBiaoZhun(FourColorCentery,4); }
for i:=1 to 32 do
begin
Data[i]:=LineSum[i];
Data[i+32]:=RowSum[i];
Data[i+64]:=LineColorJmpS[i];
Data[i+96]:=LineColorJmpE[i];
Data[i+128]:=RowColorJmpS[i];
Data[i+160]:=RowColorJmpE[i];
end;
for i:=1 to 4 do
begin
Data[i+192]:=FourColorCenterx[i];
Data[i+196]:=FourColorCentery[i];
end;
// for i:=1 to 200 do
// ListBox1.items.add(inttostr(i)+' fd '+FloatToStr(Data[i]));
bmp.Free;
Result:=Data;
end;
// ave2:=ave2/200;//求平均数
{ for j:=1 to 200 do sub2:=sub2+(disdata2[j]-ave2)*(disdata2[j]-ave2);
sub2:=sqrt(sub2/200); //计算方差
for j:=1 to 200 do
begin
subRecDis1:=subRecDis1+(disdata1[j]-ave1)*(disdata2[j]-ave2);
end; //计算协方差
SubRecdis1:=SubRecdis1/200;
AveRecDis:=SubRecDis1/(sub1*sub2); //计算相关系数}
//////////////////////////////////////////////////////////////////////////
procedure TDisRecForm.PropertyRec(bmp:TBitmap;PCharPic:CharPicture);
var //特征匹配程序段
E:wideString;
FPas:string;
minRecNum,i,j,CharNum:Integer;
DisData1,DisData2:DistanceData;
Img:TImage;
sub1,sub2,Ave1,Ave2,SubDis,SubRecDis1,minRecDis,AveRecDis:double;
begin
setLength(Disdata1,201);
setLength(disdata2,201);
E:=EFile.Text;
CharNum:=StrToInt(CharNumEdit.text)-1;
Img:=TImage.Create(Application);
Img.Picture.Assign(bmp);
for i:=1 to 200 do Disdata1[i]:=0;
ImageTeZheng(Img,DisData1);
Ave1:=0; sub1:=0;
minRecDis:=1000000;
ListBox1.Clear;
for i:=0 to CharNum do
begin
AveRecDis:=0;SubRecdis1:=0;
Img.Picture.Assign(PCHarPic[i+1]);
if CHeckBox1.Checked=True then TextForm.Thin(Img.Picture.Bitmap);
for j:=1 to 200 do Disdata2[j]:=0;
DisData2:=ImageTeZheng(Img,DisData2);
MatchImage.Picture:=Img.Picture;
ave2:=0;sub2:=0;
for j:=1 to 200 do AveRecDis:=AveRecDis+abs(DisData2[j]-DisData1[j]);
AveRecDis:=AveRecDis/200;
for j:=1 to 200 do
begin
SubDis:=abs(DisData2[j]-DisData1[j])-AveRecDis;
SubDis:=SubDis*SubDis;
SubRecDis1:=SubRecDis1+SubDis;
end;
SubRecDis1:=SubRecDis1/200;AveRecDis:=SubRecDis1;
ListBox1.Items.Add(E[i+1]+'：'+FloatToStr(AveRecDis));
if minRecDis>AveRecDis then
begin minRecDis:=AveRecDis; minRecNum:=i;end;
end;
PropertyedEdit.Text:=FloatTostr(minRecDis);
MatchImage.Picture.Bitmap.Assign(PCharPic[minRecNum+1]);
RESLabel.Caption:='匹配结果：'+E[minRecNum+1];
end;
procedure TDIsRecForm.GetRelativeDis(bmp:TBitmap;var mindis:RecDistance;var N1:integer);
var
E:Widestring;
FPas:String;
k,x,y,i,j,x0,y0,ZFNum:integer;
bmp1,bmp2:TBitmap;
p,q:pbytearray;
PiPeiNum,disColor,disTry,mindisTry:integer;
PiPeiSub,PiPeiDis,PiPeiMin:double;
Flag:boolean;
begin
bmp1:=TBitMap.Create;
bmp1.Assign(bmp);
setLength(mindis,(bmp.Height+1),(bmp.Width+1));
N1:=0;
for y:=0 to bmp1.Height-1 do
begin
p:=bmp1.ScanLine[y];
for x:=0 to bmp1.Width-1 do
begin
if p[3*x]=0 then begin mindis[y+1,x+1]:=0;inc(N1);end
else mindis[y+1,x+1]:=-1;
end;
end;
flag:=False;disColor:=0;
//计算图像各点离目标点的距离 MINDIS[I,J]为点(I,J)离最近目标点距离
while flag=False do
begin disColor:=disColor+40;
Flag:=True;
for y:=0 to bmp.Height-1 do
begin
p:=bmp1.ScanLine[y];
for x:=0 to bmp.Width-1 do
begin
if mindis[y+1,x+1]<>-1 then continue;
mindisTry:=1000;
for i:=-1 to 1 do
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -