childwin.~pas

轴承表面质量缺陷识别与统计系统,基于DELPHI 7.0

   Bearimage.Picture.Bitmap.Assign(Bmp);

   FindCenter.Enabled :=true;
end;


procedure TMDIChild.cellStatistic1Click(Sender: TObject);
begin
   Statisticform.show;
   Statisticform.edit1.text:=inttostr(numofcell);
   mainform.StatusBar1 .panels[2].Text :='红细胞总个数为:'+inttostr(numofcell);
end;

procedure TMDIChild.loadAgainClick(Sender: TObject);
begin
  Bearimage.Picture.Bitmap.Assign(loaderBmp);
end;

procedure TMDIChild.TwoMaxThresholdClick(Sender: TObject);
var
  intLoop,intSize,intPeak,intIndx,intPeak2,intIndx2,intValley:Integer;
  x, y, i: Integer;
  p: PByteArray;
  Gray: byte;
  Bmp:tbitmap;
  Child:TMDIChild;
begin
    for i:=0 to 255 do  intGrayLevel[i]:=0;
    Bmp:=tbitmap.create;
    Bmp.assign(datamodule.loaderBmp);
    randomize;
       Bmp.PixelFormat := pf24Bit;  //24位图处理
    for y := 0 to Bmp.Height - 1 do
    begin
        p := Bmp.scanline[y];
        for x := 0 to Bmp.Width - 1 do
        begin         //算出每一点的灰度值
            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
                    //统计出每一个灰度级上像素点的个数
                    intGrayLevel[i] := intGrayLevel[i] + 1;
                end;
            end;
        end;
    end;   //初始双峰值
    intPeak:=0;    intPeak2:=0;  //取得第一峰值
    for intLoop:=0 to 255 do
      if intPeak<=intGrayLevel[intLoop] then
      begin
        intPeak:=intGrayLevel[intLoop];
        intIndx:=intLoop;
      end;
//取得第二峰值
    for intLoop:=0 to 255 do
    Begin
      if (intPeak2<=intGrayLevel[intLoop]) and (intLoop<>intIndx) then
      begin
        intPeak2:=intGrayLevel[intLoop];
        intIndx2:=intLoop;
      end
    end;
//取得双峰之间的谷值
    intValley:=intSize;
    if intIndx2<intIndx then
      for intLoop:=intIndx2 to intIndx do
        if intValley>intGrayLevel[intLoop] then
        begin
          intValley:=intGrayLevel[intLoop];
            end;
  for y := 0 to Bmp.Height - 1 do
  begin
    p := Bmp.scanline[y];
    for x := 0 to Bmp.Width - 1 do
    begin
      Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x* 3]* 0.11);
      if gray>intindx2 then
      begin
        p[x * 3] := 0;  p[x * 3 + 1] := 0;     p[x * 3 + 2] := 0;
      end
      else
        begin
          p[x * 3] := 255;  p[x * 3 + 1] := 255;  p[x * 3 + 2] := 255;
        end;
    end;
  end;
  Child:=TMDIChild.Create(Application);
  Child.Caption:= '双峰法求阀值';
  Child.ErodeProcess.Enabled:=true;
  Child.expand.Enabled:=true;
  TMDIChild(Child).Bearimage.picture.bitmap.Assign (Bmp);
  Child.Width :=Child.Bearimage.picture.width+1;
  Child.height:=Child.Bearimage.picture.height+1;
  mainform.StatusBar1 .panels[3].Text :='阀值：'+inttostr( intindx2);
end;

procedure TMDIChild.ItinerateThresholdClick(Sender: TObject);
var
  intGrayLevel:array[0..255]of int64;
  intCurrentLevel,intThresholdVal2,intTotalGrayLevel,intLGrayLevel,intRGrayLevel:Integer;
  p: PByteArray;
  Gray, x, y, intThresholdVal,intLoop:Integer;
  intCount, intsize: Int64;
  Bmp: TBitmap;
  Child:TMDIChild;
begin
  for x:=0 to 255  do intGrayLevel[x]:=0;
  intsize:=0;
  Bmp := TBitmap.Create;
  Bmp.Assign(datamodule.loaderBmp);
      Bmp.PixelFormat := pf24Bit;//设置为24位真彩色
     for y := 0 to Bmp.Height - 1 do
         begin
        p := Bmp.scanline[y];
          for x := 0 to Bmp.Width - 1 do
             begin //求一个像素点灰度值
               Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x
                       * 3] * 0.11);
               inc(intsize);  inc(intGrayLevel[Gray]);
             end;
        end;
     intThresholdVal:=0;
     intThresholdVal2:=0;
  //总灰度值
  intTotalGrayLevel:=0;
  for intLoop:=0 to 255 do
    if intGrayLevel[intLoop]<>0 then
      intTotalGrayLevel:=intTotalGrayLevel+intLoop*intGrayLevel[intLoop];
  //求出初始最大灰度值
  for intLoop:=0 to 255 do
    if intGrayLevel[intLoop]>0 then
    begin
      intLGrayLevel:=intLoop;    intThresholdVal:=intLoop;
      break;
    end;
  //求出初始最小灰度值和初始阈值
  for intLoop:=255 downto 0 do
    if intGrayLevel[intLoop]>0 then
    begin
     intThresholdVal:=(intThresholdVal+intLoop)div 2;
      break;
    end;
  //迭代求解
  while intThresholdVal<>intThresholdVal2 do
    begin
      intThresholdVal2:=intThresholdVal;
      intCount:=0;
      intLGrayLevel:=0;
      for intLoop:=0 to intThresholdVal do
        if intGrayLevel[intLoop]<>0 then
        begin
          intCount:=intCount+intGrayLevel[intLoop];
          intLGrayLevel:=intLGrayLevel+intLoop*intGrayLevel[intLoop];
        end;
      intRGrayLevel:=intTotalGrayLevel-intLGrayLevel;
      intLGrayLevel:=intLGrayLevel div intCount;
      intRGrayLevel:=intRGrayLevel div (intSize-intCount);
      intThresholdVal:=(intLGrayLevel+intRGrayLevel)div 2;
    end;
         for y := 0 to Bmp.Height - 1 do
    begin
        p := Bmp.scanline[y];
        for x := 0 to Bmp.Width - 1 do
        begin  //求一个像素点灰度值
    Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x* 3] * 0.11);
            if Gray< intThresholdVal then  //由逼近值进行分割
            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;
  Child:=TMDIChild.Create(Application);
  Child.Caption:= '迭代法求阀值';
  TMDIChild(Child).Bearimage.picture.bitmap.Assign (Bmp);
  Child.Width :=Child.Bearimage.picture.width+1;
  Child.height:=Child.Bearimage.picture.height+1;
  Bmp.Free;
  Child.ErodeProcess.Enabled:=true;
  Child.expand.Enabled:=true;
  Mainform.StatusBar1 .panels[3].Text :='阀值：'+inttostr(  intThresholdVal);
end;

procedure TMDIChild.OtsuThresholdClick(Sender: TObject);
var
  GrayClass: array[0..255] of Integer;
  u,u0,w0,u1,w1,g,maxg:double;
  p: PByteArray;
  t,i,x,y,gray,threshold,Bmpsize:Integer;
  Bmp: TBitmap;
  Child:TMDIChild;
begin
  Bmp := TBitmap.Create;
  Bmp.Assign(datamodule.loaderBmp);
  Bmp.PixelFormat := pf24Bit; //设置为24位真彩色
  Bmpsize:=(Bmp.Width) * (Bmp.Height) ;
  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 //算出每一点的灰度值
             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;
  w0:=0.000001;w1:=0; u0:=0;u1:=0;maxg:=0;
  for t:=1 to 255 do
   begin
    for i:=0 to t-1 do
      begin
        w0:=w0+GrayClass[i];  u0:=u0+i*GrayClass[i];
      end;
    u0:=u0/(w0+0.001);  w0:=w0/(Bmpsize+0.001);
    for i:=t to 255 do
      begin
        u1:=u1+i*GrayClass[i];
      end;
    w1:=1-w0;
    u1:=u1/(Bmpsize*w1+0.001);u:=w0*u0+w1*u1;
    g:=w0*(u0-u)*(u0-u)+w1*(u1-u)*(u1-u);
    if g>=maxg then
      begin
        maxg:=g;     threshold:=t;
      end;
  end;
  for y := 0 to Bmp.Height - 1 do
    begin
      p := Bmp.scanline[y];
      for x := 0 to Bmp.Width - 1 do
        begin   //算出每一点的灰度值
  Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x* 3] * 0.11);
          if Gray> threshold then
          begin
            p[x * 3] := 0; p[x * 3 + 1] := 0; p[x * 3 + 2] := 0;
          end
          else
            begin
                p[x * 3] := 255;
                p[x * 3 + 1] := 255;
                p[x * 3 + 2] := 255;
            end;
        end;
    end;

  Child:=TMDIChild.Create(Application);
  Child.Caption:= '大津法';
  TMDIChild(Child).Bearimage.picture.bitmap:=Bmp;
  Child.Width :=Child.Bearimage.picture.width+1;
  Child.height:=Child.Bearimage.picture.height+1;
  Bmp.Free;
  Child.ErodeProcess.Enabled:=true;
  Child.expand.Enabled:=true;
  mainform.StatusBar1 .panels[3].Text :='阀值：'+inttostr(threshold);
end;

procedure TMDIChild.TotalThresholdClick(Sender: TObject);
var
    p: PByteArray;
    Gray, x, y: Integer;
    Bmp: TBitmap;
    Child:TMDIChild;
begin
    Bmp := TBitmap.Create;
    Bmp.Assign(datamodule.loaderBmp);
    //设置为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 //算出每一点的灰度值
 Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x* 3] * 0.11);
            if Gray >68 then //全局阀值68
            begin
                p[x * 3] := 0; p[x * 3 + 1] := 0;  p[x * 3 + 2] := 0;
            end
            else
            begin
                p[x * 3] := 255; p[x * 3 + 1] := 255;  p[x * 3 + 2] := 255;
            end;
        end;
    end;
  Child:=TMDIChild.Create(Application);
  Child.Caption:= '全值阀值法(灰度图像)';
  TMDIChild(Child).Bearimage.picture.bitmap:=Bmp;
  Child.Width :=Child.Bearimage.picture.width+1;
  Child.height:=Child.Bearimage.picture.height+1;
  Bmp.Free;
  Child.ErodeProcess.Enabled:=true;
  Child.expand.Enabled:=true;
end;

procedure TMDIChild.ErodeProcessClick(Sender: TObject);
begin
if (BitmapErode(Bearimage.Picture.Bitmap, True)) then
   begin
      Bearimage.Picture.Assign(Bearimage.Picture.Bitmap);
   end  else  showmessage('腐蚀失败');
end;

function TMDIChild.BitmapDilate(Bitmap: TBitmap; Hori: Boolean): Boolean;
 var
   X, Y: Integer;
   O, P, Q, R: pByteArray;
   NewBmp: TBitmap;
begin
   NewBmp := TBitmap.Create;
   NewBmp.Assign(bitmap);
   Hori := True;
   if (Hori) then
   begin
      for Y := 1 to NewBmp.Height - 2 do
      begin
         O := bitmap.ScanLine[Y];
         P := NewBmp.ScanLine[Y - 1];
         Q := NewBmp.ScanLine[Y];
         R := NewBmp.ScanLine[Y + 1];
         for X := 1 to NewBmp.Width - 2 do
         begin
            if ((O[3 * X] = 255) and (O[3 * X + 1] = 255) and (O[3 * X
               + 2] = 255)) then
            begin
               if (((Q[3 * (X - 1)] = 0) and (Q[3 * (X - 1) + 1] = 0)
                  and (Q[3 * (X - 1) + 2] = 0)) or ((Q[3 * (X + 1)]
                  = 0)
                  and (Q[3 * (X + 1) + 1] = 0) and
                  (Q[3 * (X + 1) + 2] = 0)) or ((P[3 * X] = 0) and
                  (P[3 * X + 1] = 0) and (P[3 * X + 2] = 0))
                  or ((R[3 * X] = 0) and (R[3 * X + 1] = 0) and
                  (R[3 * X + 2] = 0))) then
               begin
                  O[3 * X] := 0; O[3 * X + 1] := 0; O[3 * X + 2] := 0;
               end;

            end;
         end;
      end;
   end
   else
      for Y := 1 to NewBmp.Height - 2 do
      begin
         O := bitmap.ScanLine[Y];
         Q := NewBmp.ScanLine[Y];
         for X := 1 to NewBmp.Width - 2 do
         begin
            if ((O[3 * X] = 255) and (O[3 * X + 1] = 255) and (O[3 * X
               + 2] = 255)) then
            begin
               if (((Q[3 * (X - 1)] = 0) and (Q[3 * (X - 1) + 1] = 0)
                  and (Q[3 * (X - 1) + 2] = 0)) or ((Q[3 * (X + 1)]
                  = 0)
                  and (Q[3 * (X + 1) + 1] = 0) and
                  (Q[3 * (X + 1) + 2] = 0))) then
                  O[3 * X] := 0; O[3 * X + 1] := 0;  O[3 * X + 2] := 0;
            end;
         end;

      end;
   result := True;
end;


procedure TMDIChild.expandClick(Sender: TObject);
begin
  if (BitmapDilate(Bearimage.Picture.Bitmap, False)) then
   begin
      Bearimage.Picture.Assign(Bearimage.Picture.Bitmap);
   end
   else
      showmessage('膨胀失败');
end;

procedure TMDIChild.zzlbClick(Sender: TObject);
var
  Bmp1, Bmp2: Tbitmap;
  p1, p2, p3, p4: pbytearray;
  i, j: Integer;
  RvalueArray, GvalueArray, BvalueArray: array[0..8] of Integer;

procedure SelectionSort(var a: array of Integer);
var
  i, j, t: Integer;
begin
  for i := low(a) to high(a) - 1 do
    for j := high(a) downto i + 1 do
      if a[i] > a[j] then