⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 childwin.~pas

📁 轴承表面质量缺陷识别与统计系统,基于DELPHI 7.0
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
//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 + -