childwin.~pas

数字图像模式识别工程软件设计第1章基于图像分析的黄豆质量评估系统

//Designer: Jiang Xiangang    2007.8
unit CHILDWIN;

interface

uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Menus,
      math,Messages, SysUtils, Variants,Dialogs, ExtDlgs, ComCtrls, ToolWin,
  jpeg;
      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)
    BeanImage: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    ColorImageSum: TMenuItem;
    DistributionOfGray: TMenuItem;
    twovalue: TMenuItem;
    HoleFilling: TMenuItem;
    Erode: TMenuItem;
    Undo: TMenuItem;
    withdraw: TMenuItem;
    loadAgain: TMenuItem;
    BeanAreaShow: TMenuItem;
    BeanGeometryProperty: 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;
    Cluster: TMenuItem;
    GrayFCM: TMenuItem;
    ColorFCM: TMenuItem;
    RGB_KMeans: TMenuItem;
    HLS_KMeans: TMenuItem;
    ToolBar1: TToolBar;
    ClusterNumEdit: TEdit;
    IteriationTimeEdit: TEdit;
    ToolButton1: TToolButton;
    ClusterLabel: TLabel;
    IteriationNumLabel: TLabel;
    HCheckBox: TCheckBox;
    SCheckBox: TCheckBox;
    LCheckBox: TCheckBox;
    I1: TMenuItem;
    BeanImageCheckBox: TCheckBox;
    procedure ItinerateThresholdClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DistributionOfGrayClick(Sender: TObject);
    procedure twovalueClick(Sender: TObject);
    procedure connect(w,h, c,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 BeanImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BeanImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure BeanAreaShowClick(Sender: TObject);
    procedure BeanGeometryPropertyClick(Sender: TObject);
    procedure CellStatisticClick(Sender: TObject);
    procedure HSLClick(Sender: TObject);
    procedure removeimpurityClick(Sender: TObject);
    procedure BeanPropertyStatisticClick(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 InverseColorClick(Sender: TObject);
    procedure ContrastClick(Sender: TObject);
    procedure StrengthSaturationClick(Sender: TObject);
    procedure GrayFCMClick(Sender: TObject);
    procedure ColorFCMClick(Sender: TObject);
    procedure HLS_KMeansClick(Sender: TObject);
    procedure RGB_KMeansClick(Sender: TObject);
    procedure BeanImageCheckBoxClick(Sender: TObject);
  private
    { Private declarations }
  public
   function Distance(p,q:single):single;
    { 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;
  TempBmpPtr:array [0..1600] of PByteArray;
  Grayclass: array[0..255] of Integer;
   OriginalRangeRight,OriginalRangeLeft:Integer;
   AreaExpectedValue,AreaSquareErrorValue:double;
   CloseObjectNum,PixelCount:Integer;
implementation

uses Distribution, MAIN, HSL, DataModule, Stat, qrep;

{$R *.dfm}
function TMDIChild.Distance(p,q:single): single;
begin
   Result:=abs(p-q);
end;
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(BeanImage.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(BeanImage.Picture.Bitmap);
    withdraw.Enabled :=true;
    mainForm.ToolButton4.Enabled:=true;
    threshold:=strtoint(DistributionForm.Edit1.Text);
   //strtoint(DistributionForm.Edit1.Text);
    Bmp := TBitmap.Create;
    Bmp.Assign(BeanImage.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;
  BeanImage.Picture.Bitmap.Assign(Bmp);
    Bmp.Free;
     HoleFilling.Enabled :=true;
end;

procedure  TMDIChild.connect(w,h, c,x,y:Integer);    //t[]
begin
  if c=0 then
    begin
      TempBmpPtr[y][3*(x)]:=0;
      TempBmpPtr[y][3*(x)+1]:=0;
      TempBmpPtr[y][3*(x)+2]:=255;
    end else
    begin
      TempBmpPtr[y][3*(x)]:=0;
      TempBmpPtr[y][3*(x)+1]:=0;
      TempBmpPtr[y][3*(x)+2]:=0;
    end;

  if (y>0) and (x<W-1 ) then
    begin
    if (TempBmpPtr[y-1][3*(x+1)]=255) and (TempBmpPtr[y-1][3*(x+1)+1]=255) and (TempBmpPtr[y-1][3*(x+1)+2]=255) then
           connect(w,h,c,x+1,y-1);
    end;

  if (y>0) then
    begin
    if (TempBmpPtr[y-1][3*(x)]=255) and (TempBmpPtr[y-1][3*(x)+1]=255) and (TempBmpPtr[y-1][3*(x)+2]=255) then
           connect(w,h,c,x,y-1);
    end;

  if  (x>0) and (y>0) then
    begin
    if (TempBmpPtr[y-1][3*(x-1)]=255) and (TempBmpPtr[y-1][3*(x-1)+1]=255) and (TempBmpPtr[y-1][3*(x-1)+2]=255) then
           connect(w,h,c,x-1,y-1);
    end;

  if  (x>0) then
    begin
    if (TempBmpPtr[y][3*(x-1)]=255) and (TempBmpPtr[y][3*(x-1)+1]=255) and (TempBmpPtr[y][3*(x-1)+2]=255) then
           connect(w,h,c,x-1,y);
    end;

  if (x>0) and (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x-1)]=255) and (TempBmpPtr[y+1][3*(x-1)+1]=255) and (TempBmpPtr[y+1][3*(x-1)+2]=255) then
           connect(w,h,c,x-1,y+1);
    end;

  if (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x)]=255) and (TempBmpPtr[y+1][3*(x)+1]=255) and (TempBmpPtr[y+1][3*(x)+2]=255) then
           connect(w,h,c,x,y+1);
    end;

  if (x<w-1) and (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x+1)]=255) and (TempBmpPtr[y+1][3*(x+1)+1]=255) and (TempBmpPtr[y+1][3*(x+1)+2]=255) then
           connect(w,h,c,x+1,y+1);
    end;

  if (x<w-1)  then
    begin
    if (TempBmpPtr[y][3*(x+1)]=255) and (TempBmpPtr[y][3*(x+1)+1]=255) and (TempBmpPtr[y][3*(x+1)+2]=255) then
           connect(w,h,c,x+1,y);
    end;
end;

procedure TMDIChild.HoleFillingClick(Sender: TObject);
var
   Bmp: Tbitmap;    // 临时位图
   p: pByteArray;
   w,h,c,x,y: Integer;
begin
   Bmp := Tbitmap.Create;
   Bmp.Assign(BeanImage.Picture.Bitmap);
   w:= Bmp.Width ;
   H:= Bmp.Height ;
   withdrawBmp.Assign(BeanImage.Picture.Bitmap);
   withdraw.Enabled :=true;
   Bmp.PixelFormat := pf24bit;   //设置位图格式
   for y := 0 to Bmp.Height - 1 do  TempBmpPtr[y]:=Bmp.ScanLine[y];
   c:=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[3*x]=255) and (p[3*x+1]=255) and (p[3*x+2]=255)then     //clwhite;
           begin
             connect(w,h,c,x,y);
             c:=c+1;
            end;
      end;
   end;
   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]=0) and  (p[3*x+1]=0) and (p[3*x+2]=255))then
           begin
              p[3*x]:=255 ; p[3*x+1]:=255;  p[3*x+2]:=255;
            end;
        end;
    end;
   BeanImage.Picture.Bitmap.Assign(Bmp) ;
   Bmp.Free;
   erode.Enabled :=true;
end;

procedure TMDIChild.ErodeClick(Sender: TObject);
begin
   withdrawBmp.Assign(BeanImage.Picture.Bitmap);
   withdraw.Enabled :=true;
   if (BitmapErode(BeanImage.Picture.Bitmap, True)) then
   begin