📄 childwin.pas
字号:
//Designer: Jiang Xiangang 2005.8
unit CHILDWIN;
interface
uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Menus,
math,Messages, SysUtils, Variants,Dialogs, ExtDlgs, ComCtrls,FatureManage,
ToolWin, ActnMan, ActnCtrls, ImgList,activex;
var
TempNum:integer=0;
AllNum:integer=0;
areas:array[0..1256] of integer;
IsDrawing:boolean ;
r:array [1..100,1..100] of double;
ObjectArea:array[0..1256] of integer;
const
MaxPixelCount = 65536;
type
Center=record
r:Integer;
x:Integer;
y:Integer
end;
pRGBTripleArray = ^TRGBTripleArray;
TRGBTripleArray = array[0..MaxPixelCount - 1] of TRGBTriple;
type
TMDIChild = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
ColorImageSum: TMenuItem;
DistributionOfGray: TMenuItem;
twovalue: TMenuItem;
HoleFilling: TMenuItem;
Erode: TMenuItem;
Undo: TMenuItem;
withdraw: TMenuItem;
loadAgain: TMenuItem;
twovalue1: TMenuItem;
FindCenter: TMenuItem;
HSL: TMenuItem;
removeimpurity: TMenuItem;
ImageProcess: TMenuItem;
TwoValueMethod: TMenuItem;
TwoMaxThreshold: TMenuItem;
OtsuThreshold: TMenuItem;
TotalThreshold: TMenuItem;
ErodeProcess: TMenuItem;
expand: TMenuItem;
ItinerateThreshold: TMenuItem;
TotalThresholdInColor: TMenuItem;
HSL1: TMenuItem;
Gray: TMenuItem;
FillHole: TMenuItem;
MiddleValueFilter: TMenuItem;
GrayStrech: TMenuItem;
Contrast: TMenuItem;
StrengthSaturation: TMenuItem;
N2: TMenuItem;
count: TMenuItem;
savetofile: TMenuItem;
GroupBox1: TGroupBox;
Label2: TLabel;
NumberEdit: TEdit;
Label3: TLabel;
NumberIndexEdit: TEdit;
Button1: TButton;
FeatureEdit: TEdit;
invert: TMenuItem;
circ: TMenuItem;
area: TMenuItem;
Centerpoint: TMenuItem;
Label6: TLabel;
StartIndexDisplayEdit: TEdit;
Label7: TLabel;
IndexDisplayButton: TButton;
ratio: TMenuItem;
Image1: TImage;
GroupBox2: TGroupBox;
RichEdit1: TRichEdit;
Label1: TLabel;
Label4: TLabel;
Label5: TLabel;
Label8: TLabel;
Label9: TLabel;
traceEdit: TEdit;
areaEdit: TEdit;
redioEdit: TEdit;
centerEdit: TEdit;
ToolBar1: TToolBar;
Label10: TLabel;
longshortEdit: TEdit;
GroupBox3: TGroupBox;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
RadioButton3: TRadioButton;
RadioButton4: TRadioButton;
studybutton: TToolButton;
ImageList1: TImageList;
recogToolbutton: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
CellStatistic: TMenuItem;
GroupBox4: TGroupBox;
Label11: TLabel;
NumberResultEdit: TEdit;
Label13: TLabel;
RecogButton: TButton;
GroupBox5: TGroupBox;
Allcount: TButton;
Button3: TButton;
Featureprint: TButton;
MinRectanglecount: TMenuItem;
Label12: TLabel;
rateEdit: TEdit;
N3: TMenuItem;
ToolButton1: TToolButton;
Moment: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
Bearimage: TImage;
Rectrate: TMenuItem;
Label14: TLabel;
Label15: TLabel;
NumEdit: TEdit;
Button2: TButton;
procedure ItinerateThresholdClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure DistributionOfGrayClick(Sender: TObject);
procedure twovalueClick(Sender: TObject);
procedure connect(w,h, ConnectObjectNum,x,y:Integer);
procedure HoleFillingClick(Sender: TObject);
procedure ErodeClick(Sender: TObject);
function BitmapErode(Bitmap: TBitmap; Horic: Boolean): Boolean;
procedure withdrawClick(Sender: TObject);
procedure HSIClick(Sender: TObject);
procedure BearimageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BearimageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure twovalue1Click(Sender: TObject);
procedure FindCenterClick(Sender: TObject);
procedure CellStatisticClick(Sender: TObject);
procedure HSLClick(Sender: TObject);
procedure removeimpurityClick(Sender: TObject);
procedure cellStatistic1Click(Sender: TObject);
procedure loadAgainClick(Sender: TObject);
procedure TwoMaxThresholdClick(Sender: TObject);
procedure OtsuThresholdClick(Sender: TObject);
procedure TotalThresholdClick(Sender: TObject);
procedure ErodeProcessClick(Sender: TObject);
procedure expandClick(Sender: TObject);
function BitmapDilate(Bitmap: TBitmap; Hori: Boolean): Boolean;
procedure zzlbClick(Sender: TObject);
procedure TotalThresholdInColorClick(Sender: TObject);
procedure HSL1Click(Sender: TObject);
procedure GrayClick(Sender: TObject);
procedure FillHoleClick(Sender: TObject);
procedure MiddleValueFilterClick(Sender: TObject);
procedure SelectionSort(var a: array of Integer);
procedure RGB_TO_HSL(R,G,B:Integer;VAR H,S,L:Integer);
procedure HSL_to_RGB(H, S, L: Integer; var R, G, B: Integer);
procedure GrayStrechClick(Sender: TObject);
procedure GetParam(Bmp:TBitmap);
procedure ContrastClick(Sender: TObject);
procedure StrengthSaturationClick(Sender: TObject);
procedure savetofileClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure IndexDisplayButtonClick(Sender: TObject);
procedure invertClick(Sender: TObject);
function link(BMP: TBitmap;ConnectObjectNum, x, y: integer): integer;
function Trace(bmp: Tbitmap; ConnectObjectNum, x, y: integer): double;
procedure Button3Click(Sender: TObject);
procedure circclick(Sender: TObject);
procedure profileClick(Sender: TObject);
procedure areaclick(Sender: TObject);
procedure ratioclick(Sender: TObject);
procedure FeatureCount;
procedure CenterpointClick(Sender: TObject);
procedure studybuttonClick(Sender: TObject);
procedure recogToolbuttonClick(Sender: TObject);
procedure AllcountClick(Sender: TObject);
procedure RecogButtonClick(Sender: TObject);
procedure FeatureprintClick(Sender: TObject);
procedure MinRectanglecountclick(Sender: TObject);
function momentarea(BMP: TBitmap;ConnectObjectNum, x, y: integer): integer;
procedure N3Click(Sender: TObject);
procedure Getsquare(Img:TImage);
procedure MomentClick(Sender: TObject);
procedure CellStatisticshow(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure RectrateClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MDIChild:TMDIChild;
ProcessedBmp:tbitmap;
h1,s1,l1,hp,lp,sp,hf,sf,lf,sx,sy,numofcell:Integer;
pCenter:array[0..1000] of Center;
intGrayLevel: array[0..255] of Integer;
RvalueArray, GvalueArray, BvalueArray: array[0..8] of Integer;
t:array [0..800] of PByteArray;
Grayclass: array[0..255] of Integer;
OriginalRangeRight,OriginalRangeLeft:Integer;
FeatureValue: array[1..20] of real;
Pattern:array [0..3] of NumCharPattern;
RecogOrStudy: boolean;
c1,bx,by,count1:integer;
long,short,Length1,ObjectLength,longshort1:Array [0..255] of double;
L:double;
cbx,cby:array[0..1256] of Integer;
u02,u11,u20:integer;
ObjectCircRate,TempEolng,ObjectEolng:Array [0..500] of double;
ObjectCenter1,ObjectCenter2:array[0..100] of integer;
ObjectRectRate,RectArea:array [1..1256] of double;
top1,low1,rig1,left1:integer;
top2,low2,rig2,left2:array of integer;
sx1,sy1,sx2,sy2:integer;
tx,ty:array of integer;
SqureNumber:array[1..30] of double;
implementation
uses Distribution, MAIN, HSL, DataModule, Stat, QuickReport;
{$R *.dfm}
procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TMDIChild.DistributionOfGrayClick(Sender: TObject);
var
Bmp,Bmp1:TBitmap;
x,y,i,j,gray,MaxValue:Integer;
p: PByteArray;
GrayClass:array [0..260] of Integer;
begin
DistributionForm.Show;
Bmp := TBitmap.Create;
Bmp.Assign(Bearimage.Picture.Bitmap);
Bmp.PixelFormat := pf24Bit;
for i := 0 to 255 do GrayClass[i]:=0;
for y := 0 to Bmp.Height - 1 do
begin
p := Bmp.scanline[y];
for x := 0 to Bmp.Width - 1 do
begin //算出每一点的灰度值
if (p[x * 3 + 2])=(p[x * 3 + 1]) then
Gray := Round(p[x * 3 + 2])
else
Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x* 3] * 0.11);
for i := 0 to 255 do
begin
if Gray = i then
begin //统计出每一个灰度级上像素点的个数
GrayClass[i] := GrayClass[i] + 1;
end;
end;
end;
end;
Bmp.Free;
//初始化最大值变量
MaxValue := GrayClass[0];
DistributionForm.Image.Canvas.Brush.Color := clSkyBlue;
//填充背景
DistributionForm.Image.Canvas.FillRect(rect(0, 0, DistributionForm.Image.Width, DistributionForm.Image.Height));
DistributionForm.Image.Canvas.Pen.Color := clyellow;
for i := 1 to 255 do
begin
if MaxValue < GrayClass[i] then
begin //获取某个灰度值上最大像素点数
MaxValue := GrayClass[i];
end;
end;
//开始绘制
for i := 0 to 255 do
begin
//选用灰度渐变的画笔
DistributionForm.Image.Canvas.Pen.Color := RGB(i, i, i);
DistributionForm.Image.Canvas.MoveTo(64, 320);
DistributionForm.Image.Canvas.LineTo(64,0);
DistributionForm.Image.Canvas.MoveTo(128, 320);
DistributionForm.Image.Canvas.LineTo(128,0);
DistributionForm.Image.Canvas.MoveTo(192, 320);
DistributionForm.Image.Canvas.LineTo(192,0);
DistributionForm.Image.Canvas.MoveTo(256, 320);
DistributionForm.Image.Canvas.LineTo(256,0);
DistributionForm.Image.Canvas.MoveTo(320, 320);
DistributionForm.Image.Canvas.LineTo(320,0);
DistributionForm.Image.Canvas.MoveTo(384, 320);
DistributionForm.Image.Canvas.LineTo(384,0);
DistributionForm.Image.Canvas.MoveTo(448, 320);
DistributionForm.Image.Canvas.LineTo(448,0);
DistributionForm.Image.Canvas.MoveTo(2*i, 320);
DistributionForm.Image.Canvas.LineTo(2*i, 320-Round(50 *(log10(GrayClass[i]+ 1.0))));
//统计的数据进行对数降级
end;
Bmp1 := Tbitmap.Create;
Bmp1.Width := DistributionForm.Image1.Width;
Bmp1.Height := DistributionForm.Image1.Height;
//在Image上绘制256级灰度分布图
for i := 0 to 2*Bmp1.Width do
begin
Color := RGB(i, i, i);
for j := 0 to Bmp1.Height do
begin
Bmp1.Canvas.Pixels[2*i, j] := Color;
Bmp1.Canvas.Pixels[2*i-1, j] := Color;
end;
end;
DistributionForm.Image1.Picture.Bitmap.Assign(Bmp1);
Bmp1.Free;
DistributionForm.Label4.Caption := '各灰度级上最大像素点数是:' + ' ';
DistributionForm.Label5.Caption := inttostr(MaxValue);
twovalue.Enabled :=true;
end;
procedure TMDIChild.TwoValueClick(Sender: TObject);
var
p: PByteArray;
Gray, x, y,threshold: Integer;
Bmp: TBitmap;
begin
withdrawBmp.Assign(Bearimage.Picture.Bitmap);
withdraw.Enabled :=true;
mainForm.ToolButton4.Enabled:=true;
threshold:=strtoint(DistributionForm.Edit1.Text);
//strtoint(DistributionForm.Edit1.Text);
Bmp := TBitmap.Create;
Bmp.Assign(Bearimage.Picture.Bitmap);
//设置为24位真彩色
Bmp.PixelFormat := pf24Bit;
randomize;
for y := 0 to Bmp.Height - 1 do
begin
p := Bmp.scanline[y];
for x := 0 to Bmp.Width - 1 do
begin //算出每一点的灰度值
if (p[x * 3 + 2])=(p[x * 3 + 1]) then
Gray := Round(p[x * 3 + 2])
else
Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x* 3] * 0.11);
if gray > threshold then //全局阀值128
begin
p[x * 3] :=255; p[x * 3 + 1] :=255; p[x * 3 + 2] :=255;
end
else
begin
p[x * 3] :=0; p[x * 3 + 1] := 0; p[x * 3 + 2] := 0;
end;
end;
end;
Bearimage.Picture.Bitmap.Assign(Bmp);
Bmp.Free;
HoleFilling.Enabled :=true;
end;
procedure TMDIChild.connect(w,h,ConnectObjectNum,x,y:Integer);
begin
if ConnectObjectNum=0 then
begin
t[y][3*(x)]:=0;
t[y][3*(x)+1]:=0;
t[y][3*(x)+2]:=255;
end else
begin
t[y][3*(x)]:=0;
t[y][3*(x)+1]:=0;
t[y][3*(x)+2]:=0;
end;
if (y>0) and (x<W-1 ) then
begin
if (t[y-1][3*(x+1)]=255) and (t[y-1][3*(x+1)+1]=255) and (t[y-1][3*(x+1)+2]=255) then
connect(w,h,ConnectObjectNum,x+1,y-1);
end;
if (y>0) then
begin
if (t[y-1][3*(x)]=255) and (t[y-1][3*(x)+1]=255) and (t[y-1][3*(x)+2]=255) then
connect(w,h,ConnectObjectNum,x,y-1);
end;
if (x>0) and (y>0) then
begin
if (t[y-1][3*(x-1)]=255) and (t[y-1][3*(x-1)+1]=255) and (t[y-1][3*(x-1)+2]=255) then
connect(w,h,ConnectObjectNum,x-1,y-1);
end;
if (x>0) then
begin
if (t[y][3*(x-1)]=255) and (t[y][3*(x-1)+1]=255) and (t[y][3*(x-1)+2]=255) then
connect(w,h,ConnectObjectNum,x-1,y);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -