childwin.~pas

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

           or ((p1[3*(i+1)]=255) and (p1[3*(i+1)+1]=255) and (p1[3*(i+1)+2]=255))
           or ((p2[3*(i+1)]=255) and (p2[3*(i+1)+1]=255) and (p2[3*(i+1)+2]=255))
           or ((p3[3*(i+1)]=255) and (p3[3*(i+1)+1]=255) and (p3[3*(i+1)+2]=255))
           or ((p3[3*i]=255) and (p3[3*i+1]=255) and (p3[3*i+2]=255))
           then  begin
                 p[3 * i] := 255 ;
                 p[3 * i+1] := 255;
                 p[3 * i+2] := 255 ;
                 end;
          end;

          if ((p2[3 * j] = 0) and (p2[3 * j+1] = 0) and (p2[3 * j+2] = 0)) then
          begin
           if ((p1[3*j]=255) and (p1[3*j+1]=255)and(p1[3*j+2]=255))
           or ((p1[3*(j-1)]=255)and (p1[3*(j-1)+1]=255)and(p1[3*(j-1)+2]=255))
           or ((p2[3*(j-1)]=255)and  (p2[3*(j-1)+1]=255)and(p2[3*(j-1)+2]=255))
           or ((p3[3*(j-1)]=255)and  (p3[3*(j-1)+1]=255)and(p3[3*(j-1)+2]=255))
           or ((p3[3*j]=255)and (p3[3*j+1]=255)and(p3[3*j+2]=255))
           then  begin
                 p[3 * j] := 255 ;
                 p[3 * j+1] := 255;
                 p[3 * j+2] := 255 ;
                 end;
          end;
       end;
   end;

  p1:=b0.ScanLine [b0.height-1];
  p2:=b0.ScanLine [b0.height-2];
  p:=b0.ScanLine [b0.height-1];
  for i:=1 to (b0.Width-2)  do
       begin
         if p1[3*i]=0 then
         begin
           if (p1[3*(i-1)]=255) or (p1[3*(i+1)]=255)
              or (p2[3*(i-1)]=255) or(p2[3*i]=255)or(p2[3*(i+1)]=255)
            then  begin
                  p[3*i]:=255;
                  p[3*i+1]:=255;
                  p[3*i+2]:=255;
                  end;
         end;
        end;
   Bmp.Assign(b1);
   b1.Free;
   b0.Free;
end;
/////////////////////////////////////////////////////////////////////////////////////////////////
procedure  ConnectAreaSum(w,h, CloseObjectNum,x,y:Integer; var ObjectPixelNum:Integer);
begin //计算连通域的像素面积
   TempBmpPtr[y][3*(x)]:=255;   //将已计为面积的点设为底色（白色）
   TempBmpPtr[y][3*(x)+1]:=255; //将已计为面积的点设为底色（白色）
   TempBmpPtr[y][3*(x)+2]:=255; //将已计为面积的点设为底色（白色）
   ObjectPixelNum:=ObjectPixelNum+1; //像素面积积分
  if (y>0) and (x<W-1 ) then  //八连通区域置色和计数，黑色点为连通域的点
    begin
    if (TempBmpPtr[y-1][3*(x+1)]=0) and (TempBmpPtr[y-1][3*(x+1)+1]=0) and
     (TempBmpPtr[y-1][3*(x+1)+2]=0) then ConnectAreaSum(w,h,CloseObjectNum,x+1,y-1,ObjectPixelNum);
    end;
  if (y>0) then
    begin
    if (TempBmpPtr[y-1][3*(x)]=0) and (TempBmpPtr[y-1][3*(x)+1]=0) and
    (TempBmpPtr[y-1][3*(x)+2]=0) then ConnectAreaSum(w,h,CloseObjectNum,x,y-1,ObjectPixelNum);
    end;
  if  (x>0) and (y>0) then
    begin
    if (TempBmpPtr[y-1][3*(x-1)]=0) and (TempBmpPtr[y-1][3*(x-1)+1]=0) and
    (TempBmpPtr[y-1][3*(x-1)+2]=0) then  ConnectAreaSum(w,h,CloseObjectNum,x-1,y-1,ObjectPixelNum);
    end;
  if  (x>0) then
    begin
    if (TempBmpPtr[y][3*(x-1)]=0) and (TempBmpPtr[y][3*(x-1)+1]=0) and (TempBmpPtr[y][3*(x-1)+2]=0) then
           ConnectAreaSum(w,h,CloseObjectNum,x-1,y,ObjectPixelNum);
    end;
  if (x>0) and (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x-1)]=0) and (TempBmpPtr[y+1][3*(x-1)+1]=0) and
    (TempBmpPtr[y+1][3*(x-1)+2]=0) then  ConnectAreaSum(w,h,CloseObjectNum,x-1,y+1,ObjectPixelNum);
    end;
  if (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x)]=0) and (TempBmpPtr[y+1][3*(x)+1]=0) and
    (TempBmpPtr[y+1][3*(x)+2]=0) then  ConnectAreaSum(w,h,CloseObjectNum,x,y+1,ObjectPixelNum);
    end;
  if (x<w-1) and (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x+1)]=0) and (TempBmpPtr[y+1][3*(x+1)+1]=0) and
    (TempBmpPtr[y+1][3*(x+1)+2]=0) then  ConnectAreaSum(w,h,CloseObjectNum,x+1,y+1,ObjectPixelNum);
    end;
  if (x<w-1)  then
    begin
    if (TempBmpPtr[y][3*(x+1)]=0) and (TempBmpPtr[y][3*(x+1)+1]=0) and
    (TempBmpPtr[y][3*(x+1)+2]=0) then ConnectAreaSum(w,h,CloseObjectNum,x+1,y,ObjectPixelNum);
    end;
end;

procedure  connect11(w,h,x,y:Integer;var n:Integer );
begin
  n:=n+1;
  sx:=sx+x;
  sy:=sy+y;
  TempBmpPtr[y][3*(x)]:=255;
  TempBmpPtr[y][3*(x)+1]:=255;
  TempBmpPtr[y][3*(x)+2]:=255;
  if (y>0) and (x<W-1 ) then
    begin
    if (TempBmpPtr[y-1][3*(x+1)]=0) and (TempBmpPtr[y-1][3*(x+1)+1]=0) and (TempBmpPtr[y-1][3*(x+1)+2]=0) then
           connect11(w,h,x+1,y-1,n);
    end;
  if (y>0) then
    begin
    if (TempBmpPtr[y-1][3*(x)]=0) and (TempBmpPtr[y-1][3*(x)+1]=0) and (TempBmpPtr[y-1][3*(x)+2]=0) then
           connect11(w,h,x,y-1,n);
    end;
  if  (x>0) and (y>0) then
    begin
    if (TempBmpPtr[y-1][3*(x-1)]=0) and (TempBmpPtr[y-1][3*(x-1)+1]=0) and (TempBmpPtr[y-1][3*(x-1)+2]=0) then
           connect11(w,h,x-1,y-1,n);
    end;
  if  (x>0) then
    begin
    if (TempBmpPtr[y][3*(x-1)]=0) and (TempBmpPtr[y][3*(x-1)+1]=0) and (TempBmpPtr[y][3*(x-1)+2]=0) then
           connect11(w,h,x-1,y,n);
    end;
  if (x>0) and (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x-1)]=0) and (TempBmpPtr[y+1][3*(x-1)+1]=0) and (TempBmpPtr[y+1][3*(x-1)+2]=0) then
           connect11(w,h,x-1,y+1,n);
    end;
  if (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x)]=0) and (TempBmpPtr[y+1][3*(x)+1]=0) and (TempBmpPtr[y+1][3*(x)+2]=0) then
           connect11(w,h,x,y+1,n);
    end;
  if (x<w-1) and (y<h-1) then
    begin
    if (TempBmpPtr[y+1][3*(x+1)]=0) and (TempBmpPtr[y+1][3*(x+1)+1]=0) and (TempBmpPtr[y+1][3*(x+1)+2]=0) then
           connect11(w,h,x+1,y+1,n);
    end;
  if (x<w-1)  then
    begin
    if (TempBmpPtr[y][3*(x+1)]=0) and (TempBmpPtr[y][3*(x+1)+1]=0) and (TempBmpPtr[y][3*(x+1)+2]=0) then
           connect11(w,h,x+1,y,n);
    end;
end;
//////////////////////////////////////////////////////////////////////////////////
function ConnectRegionArea(BMP: TBitmap;ConnectBodyNum, x, y: integer): integer;
begin //四连通物体的面积计数并设置为白颜色（背景色）
  PixelCount := PixelCount + 1; //连通物体的像素总数
  Bmp.Canvas.Pixels[x,y]:=clWhite;  //给不同连通物赋上白颜色值
  if (BMP.Canvas.Pixels[x + 1,y] = clBlack) then   // 判断(x+1,y)方向点像素
    ConnectRegionArea(BMP,ConnectBodyNum, x + 1, y);
 if (BMP.Canvas.Pixels[x,y - 1] = clBlack) then  // 判断(x,y-1) 方向点像素
    ConnectRegionArea(BMP,ConnectBodyNum, x , y - 1);
  if (BMP.Canvas.Pixels[x,y + 1] = clBlack) then   //判断(x,y+1) 方向点像素
    ConnectRegionArea(BMP, ConnectBodyNum,x, y + 1);
  if (BMP.Canvas.Pixels[x-1,y] = clBlack) then //判断 (x-1,y) 方向点像素
    ConnectRegionArea(BMP,ConnectBodyNum, x-1, y);
  Result := PixelCount;
end;
//////////////////////////////////////////////////////////////////////////////////
procedure TMDIChild.BeanGeometryPropertyClick(Sender: TObject);
var  //计算黄豆图像特征和均方差等
  w,h,x,y,i,j,t1,
  ObjectPixelNum,EraseEdgeNum,GravityNum: Integer;
  ConnectObjectArray:array[1..3000] of Integer;
  Bmp1,Bmp2,Bmp3,Bmp4: Tbitmap;
  p: PByteArray;
begin
   CloseObjectNum:=0;
   withdrawBmp.Assign(BeanImage.Picture.Bitmap);
   withdraw.Enabled :=true;
   Bmp1:= Tbitmap.Create;
   Bmp1.Assign ( BeanImage.Picture.Bitmap);
   for i:=0 to 3000 do ConnectObjectArray[i]:=0;
   CloseObjectNum:=0 ;
  for y:=0 to Bmp1.Height-1 do
       begin
         p := Bmp1.ScanLine[y];
         for x := 0 to Bmp1.Width-1 do
          begin //连通区域为黑色
            if ((p[x*3]=0) and(p[x*3+1]=0) and(p[x*3+2]=0)) then
            begin
            PixelCount:=0; //连通区域开始点数为0，连通区域太小不计
            ObjectPixelNum:=ConnectRegionArea(Bmp1,CloseObjectNum, x, y);
            if ObjectPixelNum> 20 then CloseObjectNum := CloseObjectNum+1;
             ConnectObjectArray[CloseObjectNum] :=ObjectPixelNum;
            end;
         end;
     end;
//////计算面积统计期望值和均方差等////////////
     AreaExpectedValue:=0;AreaSquareErrorValue:=0;
     for i:=1 to CloseObjectNum  do
     begin //计算面积均值
     AreaExpectedValue:=AreaExpectedValue+ConnectObjectArray[i];
     end;
     AreaExpectedValue:=AreaExpectedValue/(CloseObjectNum-1);
     AreaExpectedValue:=AreaExpectedValue;
        for i:=1 to CloseObjectNum  do
        begin //计算面积均方差
     AreaSquareErrorValue:=  AreaSquareErrorValue+
     (ConnectObjectArray[i]-AreaExpectedValue)*(ConnectObjectArray[i]-AreaExpectedValue);
        end;
       AreaSquareErrorValue:=AreaSquareErrorValue/(CloseObjectNum-1);
       AreaSquareErrorValue:=Sqrt(AreaSquareErrorValue/(CloseObjectNum-1));
       BeanPropertyStatisticClick(Sender);//显示检验报告
       Bmp1.free;
end;
///////////////////////////////////////////////////////////////////////////////////////////////
procedure TMDIChild.CellStatisticClick(Sender: TObject);

var
   ObjectNum:array[0..256] of Integer;
   Bmp: Tbitmap;
   p1: pByteArray;
   w,h,i,n,c,x,y: Integer;
begin
 if application.MessageBox('腐蚀四次','目标数量统计',MB_YESNO)=IDYES THEN
   erode.Click;
    erode.Click;
     erode.Click;
      erode.Click;
  Bmp := Tbitmap.Create;
  Bmp.Assign(BeanImage.Picture.Bitmap);
  for y:=0 to Bmp.Height-1 do TempBmpPtr[y]:=Bmp.ScanLine[y];
  w:=Bmp.Width ;
  h:=Bmp.Height ;
  Bmp.PixelFormat := pf24bit;   //设置位图格式
  for i:=0 to 255  do  objectnum[i]:=0;
  c:=0; n:=0;
  for y := 1 to Bmp.Height - 2 do
   begin
     p1 := Bmp.ScanLine[y];
     for x := 1 to Bmp.Width - 3 do
       begin
         if p1[3*x]=clblack then
           begin
             n:=0;
             ConnectAreaSum(w,h,c,x,y,n);
             c:=c+1;
             ObjectNum[c]:=n;
           end;
      end;
   end;

  Bmp.Free;
   Statisticform.show;
   Statisticform.edit1.text:=inttostr(c);
   mainform.StatusBar1 .panels[2].Text :='黄豆总个数为:'+inttostr(c);
end;

procedure TMDIChild.HSLClick(Sender: TObject);
begin
  if application.MessageBox('请点击右键选取黄豆的一块颜色','系统提示',
  MB_YesNo)=IDYes THEN
      begin
     mark1:=true ; BeanImage.Cursor :=crcross;
      ProcessedBmp := TBitmap.Create;
      ProcessedBmp.Assign(BeanImage.Picture.Bitmap);
    end
    else mark1:=false; 
end;

procedure TMDIChild.removeimpurityClick(Sender: TObject);
var
   p: pbytearray;
   Bmp: tbitmap;
   w,h,c,t1,i,x,y,n:Integer ;
   Obectject_XY:array [0..1000] of Integer;
begin
   withdrawBmp.Assign(BeanImage.Picture.Bitmap);
   withdraw.Enabled :=true;
   Bmp:= Tbitmap.Create;
   Bmp.Assign ( BeanImage.Picture.Bitmap);

   for y:=0 to Bmp.Height-1 do TempBmpPtr[y] := Bmp.ScanLine[y];
   w:=Bmp.Width;
   h:=Bmp.Height ;

   c:=0;t1:=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]=0) and(p[x*3+1]=0) and(p[x*3+2]=0)) then
        begin
           n:=0;
           ConnectAreaSum(w,h,c,x,y,n);
           c := c+1;
           if n<100 then
           begin
              t1:=t1+1;
              Obectject_XY[2*t1-1]:=x;
              Obectject_XY[2*t1]:=y;
           end;
        end;
      end;
     end;
   Bmp.Assign ( BeanImage.Picture.Bitmap);
   for y:=0 to Bmp.Height-1 do TempBmpPtr[y] := Bmp.ScanLine[y];
   w:=Bmp.Width;
   h:=Bmp.Height ;

   for i:=1 to t1 do
   begin
     n:=0;
     ConnectAreaSum(w,h,c,Obectject_XY[2*i-1],Obectject_XY[2*i],n ) ;
   end;
   BeanImage.Picture.Bitmap.Assign(Bmp);
end;
///////////////////////////////////////////////////////////////////
procedure TMDIChild.BeanPropertyStatisticClick(Sender: TObject);
var //定义和显示黄豆等级报告的程序
   BeanQualityDegree:string;
begin
  qreport.BeanNum.Caption:=IntToStr(CloseObjectNum);
  qreport.avarea.Caption:=FloatToStr(AreaExpectedValue);
  qreport.SqErrArea.Caption:=FloatToStr(AreaSquareErrorValue);
    if  AreaSquareErrorValue>180 then BeanQualityDegree:='C级';
    if  (AreaSquareErrorValue<180) and (AreaSquareErrorValue>80) then BeanQualityDegree:='B级';
    if  AreaSquareErrorValue<80 then BeanQualityDegree:='A级';
     qreport.BeanQuality.Caption:=BeanQualityDegree;
  qreport.QRImage1.Picture.Assign(LoadedBmp);
  qreport.QuickRep1.Preview();  //显示检验报告qreport
end;
///////////////////////////////////////////////////////////////////////
procedure TMDIChild.loadAgainClick(Sender: TObject);
begin
  BeanImage.Picture.Bitmap.Assign(LoadedBmp);
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.LoadedBmp);
    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