📄 mainunit.pas
字号:
unit MainUnit;
interface
uses
// Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
// Dialogs, Menus, ExtDlgs, ImgList, ComCtrls, ToolWin;
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons, ExtDlgs, Grids, DBGrids, ValEdit,
TeeProcs, TeEngine, Chart, DbChart, Series, TeeFunci, Menus, FileCtrl,
ImgList, ComCtrls, ToolWin,math, CheckLst;
type
XOrder=array[1..10] of integer;
TTextForm = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
FileOpenItem: TMenuItem;
FileListOpen: TMenuItem;
FileCloseItem: TMenuItem;
FileSaveItem: TMenuItem;
FileSaveAsItem: TMenuItem;
N1: TMenuItem;
FileExitItem: TMenuItem;
B3: TMenuItem;
NClearSide: TMenuItem;
NToCenter: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
ThinImage: TMenuItem;
N13: TMenuItem;
NomalTS: TMenuItem;
MomentProperty: TMenuItem;
Window1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
Help1: TMenuItem;
StatusBar1: TStatusBar;
ToolBar1: TToolBar;
ImageList1: TImageList;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
N4: TMenuItem;
N12: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
LetterXH2: TMenuItem;
ImageList2: TImageList;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
N5: TMenuItem;
ToolButton8: TToolButton;
N6: TMenuItem;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
N7: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
ostar1: TMenuItem;
N18: TMenuItem;
N19: TMenuItem;
N20: TMenuItem;
procedure FormShow(Sender: TObject);
procedure FileOpenItemClick(Sender: TObject);
procedure NomalTSClick(Sender: TObject);
procedure NClearSideClick(Sender: TObject);
procedure NToCenterClick(Sender: TObject);
procedure ImageTeZheng(Img:TImage);
procedure ViewData;
procedure Zoom(Image1,NormalImage:TImage);
procedure GuiYi(Img1,Img2,Img3:TImage);
procedure GetRegion(Bmp: TBitmap);
procedure CreateBmp(Left,Right,Top,Bottom: integer);
procedure FileExitItemClick(Sender: TObject);
procedure FileListOpenClick(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure GetBone(Img1,Img2:TImage);
procedure ThinFrame(bmp,bmp2:TBitMap);
procedure SubThinFrame(bmp:TBitMap;Ord:XOrder;XFlag:boolean);
procedure ThinImageClick(Sender: TObject);
// function Thin(Bitmap: TBitmap): Boolean;
procedure LetterXH2Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure ClearSmall(Sender:TObject;Img,Img2:TImage);
procedure FileSaveItemClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure ToolButton9Click(Sender: TObject);
procedure TeZhengBiaoZhun(var Tedata:array of double;num:integer);
procedure MomentPropertyClick(Sender: TObject);
procedure GetMoment(Img:TImage);
procedure N15Click(Sender: TObject);
procedure OtsuAlgorithmClick(Sender: TObject;BitMap:TBitmap);
procedure ostar1Click(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure N7Click(Sender: TObject);
private
{ Private declarations }
public
function Thin(Bitmap: TBitmap): Boolean;
end;
type
TRGBArray = array[0..32767] of TRGBTriple;
PRGBArray = ^TRGBArray;
var
TextForm: TTextForm;
RecognizeCharInPicture:Boolean;
FourColorCenterx,FourColorCentery: array[1..6] of double;
LineColorJmpS,RowColorJmpS,LineColorJmpE,RowColorJmpE:array[1..34] of double;
LineSum,RowSum:array[1..34] of double;
BlackWhiteX,BlackWhiteY:array[1..4800]of integer;
SqureNumber:array[1..30] of double;
optialT,BlackWhite:integer;
implementation
uses InformUnit, ChartUnit, FileListUnit, PictureViewUnit,
FileListOpenUnit, SaveUnit, NetUnit, DisRecUnit, HelpUnit;
{$R *.dfm}
procedure TTextForm.OtsuAlgorithmClick(Sender: TObject;BitMap:TBitmap); // ///////////
var //////////////////////最佳二值化处理函数
row, col:integer;
i, T:integer;
n,P, Sum_Pi,Sum_Pi_i: array[0..256] of double;
W1, W2, U1, U2, sumpixel:Double;
Sigma_1_square, Sigma_2_square, Sigma_w_square:double;
MinVariance :double;
ptr:pbytearray;
BlackNum,WhiteNum,T_optimal:integer;
bmp:TBitmap;
begin
MinVariance := 1.7e+308 ;
// 计算影像的总像素數
sumpixel := BitMap.Height*BitMap.Width;
// 统计影像中灰度值為i的像素數
for i := 0 to 256 do
n[i] := 0;
for row := 0 to BitMap.Height-1 do
begin
ptr := BitMap.ScanLine[row];
for col := 0 to BitMap.Width-1 do
n[ ptr[col] ]:=n[ ptr[col] ]+1;
end;
// 计算图像中灰度值为i的像素所出現的概率
for i := 0 to 255 do
P[i] := n[i] /sumpixel;
// 分別計算阀值为T时，Sum_Pi和Sum_Pi_i
Sum_Pi[0] := P[0];
Sum_Pi_i[0] := 0;
for i := 1 to 255 do
begin
Sum_Pi[i] := Sum_Pi[i-1] + P[i];
Sum_Pi_i[i] := Sum_Pi_i[i-1] + P[i] * i;
end ; // 检查所有的灰度值，使C1和C2的变异数和为最小时
// 即为所求的最佳阀值
for T := 1 to 254 do
begin
W1:= Sum_Pi[T];
// 加上最小值检查，避免除数为零
if (Abs(W1) < 1e-9) then
W1:= 1e-9;
W2 := 1 - W1;
// 加上最小值检查，避免除数为零
if (Abs(W2) < 1e-9) then W2 := 1e-9;
U1:= Sum_Pi_i[T] / W1;
U2 := (Sum_Pi_i[255] - Sum_Pi_i[T]) / W2;
Sigma_1_square:= 0;
for i:= 0 to T do
Sigma_1_square :=Sigma_1_square+(i - U1) * ( i - U1) * P[i];
Sigma_1_square := Sigma_1_square / W1;
Sigma_2_square := 0;
for i := T+1 to 255 do
begin
Sigma_2_square:= Sigma_2_square+(i- U2) * (i - U2) * P[i];
end ;
Sigma_2_square := Sigma_2_square / W2;
Sigma_w_square := W1 * Sigma_1_square + W2 * Sigma_2_square;
if(Sigma_w_square < MinVariance) then
begin
MinVariance := Sigma_w_square;
optialT:=T;
end;
end;
// 回传最佳阀值
//bestGrayLabel.Caption:=inttostr(optialT);
//Label1.Caption:=inttostr(optialT);
Bmp:=TBitmap.Create;
bmp.Assign(BitMap);
BlackNum:=0;WhiteNum:=0;
for row:=0 to BitMap.Height-1 do
begin
ptr:=Bmp.ScanLine[row];
for col:=0 to BitMap.Width-1 do
begin
if ptr[3*col]>optialT then
begin
ptr[3*col]:=255;
ptr[3*col+1]:=255;
ptr[3*col+2]:=255;
end else begin
ptr[3*col]:=0;
ptr[3*col+1]:=0;
ptr[3*col+2]:=0;
end;
end;
end;
Bitmap.Assign(bmp);
bmp.Free;
end;
procedure TTextForm.GetMoment(Img:TImage);
var
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;
Label loop;
begin
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; //伸展度
dd:=(squreNumber[8]-squreNumber[9])/(squreNumber[8]+squreNumber[9]);
SqureNumber[16]:=(dd+1)/2; //水平偏移度
dd:=(squreNumber[10]-squreNumber[11])/(squreNumber[10]+squreNumber[11]);
SqureNumber[17]:=(dd+1)/2; //垂直偏移度
dd:=(squreNumber[4]-squreNumber[5])/(squreNumber[4]+squreNumber[5]);
SqureNumber[18]:=(dd+1)/2; //水平伸展度度
dd:=(squreNumber[6]-squreNumber[7])/(squreNumber[6]+squreNumber[7]);
SqureNumber[19]:=(dd+1)/2; //垂直伸展度
Loop:;
end;
procedure TTextForm.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;
procedure TTextForm.ClearSmall(Sender:Tobject;Img,Img2:TImage);
var
x,y,x0,y0,x1,y1:integer;
bitp:TBitmap;
STX,STY:array[1..8000] of integer;
m,MAXST,MaxNumber,MaxColor:integer;
ClassNum:TColor;
begin
bitp:=TBitmap.Create;
bitp.Assign(Img.Picture.Bitmap);
bitp.PixelFormat:=pf24bit;
ClassNum:=Clblack;
MaxNumber:=0;
for y:=0 to bitp.Height-1 do
begin
for x:=0 to bitp.Width-1 do
begin
if bitp.Canvas.Pixels[x,y]<>clblack then continue;
ClassNum:=ClassNum+50;
bitp.Canvas.Pixels[x,y]:=ClassNum;
m:=1;STX[m]:=x;STY[m]:=y;MaxST:=0;
while m<>0 do
begin
x0:=STX[m];y0:=STY[m];dec(m);
// ListBox1.Items.Add(IntToStr(x0)+' '+IntTostr(y0));
x1:=x0+1;y1:=y0;
if (x1<bitp.Width)and(bitp.Canvas.Pixels[x1,y1]=0)then
begin
bitp.Canvas.Pixels[x1,y1]:=ClassNum;
inc(m);STX[m]:=x1;STY[m]:=y1;
end;
x1:=x0-1;y1:=y0;
if (x1>=0)and(bitp.Canvas.Pixels[x1,y1]=0)then
begin
bitp.Canvas.Pixels[x1,y1]:=ClassNum;
inc(m);STX[m]:=x1;STY[m]:=y1;
end;
x1:=x0;y1:=y0+1;
if (y1<bitp.Height)and(bitp.Canvas.Pixels[x1,y1]=0)then
begin
bitp.Canvas.Pixels[x1,y1]:=ClassNum;
inc(m);STX[m]:=x1;STY[m]:=y1;
end;
x1:=x0;y1:=y0-1;
if (y1>=0)and(bitp.Canvas.Pixels[x1,y1]=0)then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -