childwin.~pas

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

        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 ((p2[3*i]=255) and  (p2[3*i+1]=255) and (p2[3*i+2]=255))
        or ((p2[3*(i+1)]=255) and (p2[3*(i+1)+1]=255) and (p2[3*(i+1)+2]=255))
        then
    begin
       p[3*i]:=255;
       p[3*i+1]:=255;
       p[3*i+2]:=255;
    end;
    end;
  end;
   for k := 1 to b0.Height - 2 do
   begin
      p1 := b0.ScanLine[k - 1];
      p2 := b0.ScanLine[k];
      p3 := b0.ScanLine[k + 1];
      p := b1.ScanLine[k];   //提取后的像素
      i:=0; j:=b0.Width -1;
      begin
         if ((p2[3 * i] = 0) and (p2[3 * i+1] = 0) and (p2[3 * i+2] = 0)) then
         begin
           if ((p1[3*i]=255) and (p1[3*i+1]=255) and (p1[3*i+2]=255))
           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
   t[y][3*(x)]:=255;
   t[y][3*(x)+1]:=255;
   t[y][3*(x)+2]:=255;
   ObjectPixelNum:=ObjectPixelNum+1;
  if (y>0) and (x<W-1 ) then
    begin
    if (t[y-1][3*(x+1)]=0) and (t[y-1][3*(x+1)+1]=0) and (t[y-1][3*(x+1)+2]=0) then
           ConnectAreaSum(w,h,CloseObjectNum,x+1,y-1,ObjectPixelNum);
    end;
  if (y>0) then
    begin
    if (t[y-1][3*(x)]=0) and (t[y-1][3*(x)+1]=0) and (t[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 (t[y-1][3*(x-1)]=0) and (t[y-1][3*(x-1)+1]=0) and (t[y-1][3*(x-1)+2]=0) then
           ConnectAreaSum(w,h,CloseObjectNum,x-1,y-1,ObjectPixelNum);
    end;
  if  (x>0) then
    begin
    if (t[y][3*(x-1)]=0) and (t[y][3*(x-1)+1]=0) and (t[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 (t[y+1][3*(x-1)]=0) and (t[y+1][3*(x-1)+1]=0) and (t[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 (t[y+1][3*(x)]=0) and (t[y+1][3*(x)+1]=0) and (t[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 (t[y+1][3*(x+1)]=0) and (t[y+1][3*(x+1)+1]=0) and (t[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 (t[y][3*(x+1)]=0) and (t[y][3*(x+1)+1]=0) and (t[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;
  t[y][3*(x)]:=0;
  t[y][3*(x)+1]:=0;
  t[y][3*(x)+2]:=255;

  if (y>0) and (x<W-1 ) then
    begin
    if (t[y-1][3*(x+1)]=0) and (t[y-1][3*(x+1)+1]=0) and (t[y-1][3*(x+1)+2]=0) then
           connect11(w,h,x+1,y-1,n);
    end;

  if (y>0) then
    begin
    if (t[y-1][3*(x)]=0) and (t[y-1][3*(x)+1]=0) and (t[y-1][3*(x)+2]=0) then
           connect11(w,h,x,y-1,n);
    end;

  if  (x>0) and (y>0) then
    begin
    if (t[y-1][3*(x-1)]=0) and (t[y-1][3*(x-1)+1]=0) and (t[y-1][3*(x-1)+2]=0) then
           connect11(w,h,x-1,y-1,n);
    end;

  if  (x>0) then
    begin
    if (t[y][3*(x-1)]=0) and (t[y][3*(x-1)+1]=0) and (t[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 (t[y+1][3*(x-1)]=0) and (t[y+1][3*(x-1)+1]=0) and (t[y+1][3*(x-1)+2]=0) then
           connect11(w,h,x-1,y+1,n);
    end;

  if (y<h-1) then
    begin
    if (t[y+1][3*(x)]=0) and (t[y+1][3*(x)+1]=0) and (t[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 (t[y+1][3*(x+1)]=0) and (t[y+1][3*(x+1)+1]=0) and (t[y+1][3*(x+1)+2]=0) then
           connect11(w,h,x+1,y+1,n);
    end;

  if (x<w-1)  then
    begin
    if (t[y][3*(x+1)]=0) and (t[y][3*(x+1)+1]=0) and (t[y][3*(x+1)+2]=0) then
           connect11(w,h,x+1,y,n);
    end;
end;

procedure TMDIChild.FindCenterClick(Sender: TObject);
var
  w,h,CloseObjectNum,x,y,i,j,t1,
  ObjectPixelNum,EraseEdgeNum,GravityNum: Integer;
  ConnectObjectArray:array[1..1256] of Integer;
  Bmp1,Bmp2,Bmp3,Bmp4: Tbitmap;
  p: PByteArray;
  Obectject_XY:array [0..1000] of Integer;
begin
   NumofCell:=0;
   withdrawBmp.Assign(Bearimage.Picture.Bitmap);
   withdraw.Enabled :=true;
   GravityNum:=0;
   for I:=0 to 1000 do Obectject_XY[i]:=0;
   Bmp3:= Tbitmap.Create;
   Bmp3.Assign (Bearimage.Picture.Bitmap);
   Bmp1:= Tbitmap.Create;
   Bmp1.Assign ( Bearimage.Picture.Bitmap);
   Bmp2:= Tbitmap.Create;
   for EraseedgeNum:=0 to 30 do //腐蚀次数
   begin
     edge(Bmp1) ;
     Bmp2.Assign ( Bmp1);
     for i:=0 to 1000 do ConnectObjectArray[i]:=0;
     CloseObjectNum:=1 ; t1:=0;
     for y:=0 to Bmp1.Height-1 do t[y]:=Bmp1.ScanLine[y];
     W:=Bmp1.Width ;
     H:=Bmp1.Height ;
     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
                ObjectPixelNum:=0;sx:=0;sy:=0;
                ConnectAreaSum(w,h,CloseObjectNum,x,y,ObjectPixelNum);
                ConnectObjectArray[CloseObjectNum] :=ObjectPixelNum;
                CloseObjectNum := CloseObjectNum+1;
                if ObjectPixelNum<20 then begin
                          t1:=t1+1;
                          Obectject_XY[2*t1-1]:=x;
                          Obectject_XY[2*t1]:=y;
                         end;
             end;
         end;
     end;
     Bmp1.Assign(Bmp2);
     for y:=0 to Bmp1.Height-1 do t[y]:=Bmp1.ScanLine[y];
     w:=Bmp1.Width ;
     h:=Bmp1.Height ;
     for i:=1 to t1 do
     begin
       GravityNum:=GravityNum+1;
       ObjectPixelNum:=0; sx:=0;sy:=0;
       connect11(w,h,Obectject_XY[2*i-1],Obectject_XY[2*i],ObjectPixelNum ) ;
       pCenter[GravityNum].x:=Round(sx/ObjectPixelNum);  //  x轴重心坐标
       pCenter[GravityNum].y:=Round(sy/ObjectPixelNum);
       pCenter[GravityNum].r:=EraseEdgeNum+Round (ObjectPixelNum/5)+3;
     end;
  end;
  Bearimage.Picture.Bitmap.assign(ProcessedBmp);
   for i:=1 to GravityNum-1 do
     for j:=i+1 to GravityNum do
       if  (((pCenter[i].x-pCenter[j].x)*(pCenter[i].x-pCenter[j].x))
         +((pCenter[i].y-pCenter[j].y)*(pCenter[i].y-pCenter[j].y)) ) <150
     then begin
            pCenter[j].x:=pCenter[i].x ;
            pCenter[j].y:=pCenter[i].y ;
            pCenter[j].r:=pCenter[i].r ;
            end;
     for I:=1 to GravityNum do
  begin
   with  Bearimage do
   begin
     canvas.Brush.Style:=bsclear;
     Canvas.Pen.Color:=clBlue;
     if pCenter[i].r>4 then
     begin
       NumofCell:=NumofCell+1;
       Canvas.Ellipse(pCenter[i].x-pCenter[i].r ,pCenter[i].y-pCenter[i].r ,
       PCenter[i].x+pCenter[i].r ,pCenter[i].y+pCenter[i].r ) ;
     end;
   end;
 //  CellStatistic1.Enabled :=true;
  end;
end;


procedure TMDIChild.CellStatisticClick(Sender: TObject);

var
   ObjectNum:array[0..256] of Integer;
   Bmp: Tbitmap;
   p1: pByteArray;
   w,h,i,n,ConnectObjectNum,x,y: Integer;
begin
{ if application.MessageBox('腐蚀四次','目标数量统计',MB_YESNO)=IDYES THEN
   erode.Click;
    erode.Click;
     erode.Click;
      erode.Click;  }

  Bmp := Tbitmap.Create;
  Bmp.Assign(Bearimage.Picture.Bitmap);
  for y:=0 to Bmp.Height-1 do t[y]:=Bmp.ScanLine[y];
  w:=Bmp.Width ;
  h:=Bmp.Height ;
  Bmp.PixelFormat := pf24bit;   //设置位图格式
  for i:=0 to 255  do  objectnum[i]:=0;
  ConnectObjectNum:=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,ConnectObjectNum,x,y,n);
             ConnectObjectNum:=ConnectObjectNum+1;
             ObjectNum[ConnectObjectNum]:=n;
           end;
      end;
   end;

  Bmp.Free;
   Statisticform.show;
   Statisticform.edit1.text:=inttostr(ConnectObjectNum);
   mainform.StatusBar1 .panels[2].Text :='红细胞总个数为:'+inttostr(ConnectObjectNum);
   AllNum:=ConnectObjectNum;
end;

procedure TMDIChild.CellStatisticshow(Sender: TObject);

var
   ObjectNum:array[0..256] of Integer;
   Bmp: Tbitmap;
   p1: pByteArray;
   w,h,i,n,ConnectObjectNum,x,y: Integer;
begin
  Bmp := Tbitmap.Create;
  Bmp.Assign(Bearimage.Picture.Bitmap);
  for y:=0 to Bmp.Height-1 do t[y]:=Bmp.ScanLine[y];
  w:=Bmp.Width ;
  h:=Bmp.Height ;
  Bmp.PixelFormat := pf24bit;   //设置位图格式
  for i:=0 to 255  do  objectnum[i]:=0;
  ConnectObjectNum:=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,ConnectObjectNum,x,y,n);
             ConnectObjectNum:=ConnectObjectNum+1;
             ObjectNum[ConnectObjectNum]:=n;
           end;
      end;
   end;
  Bmp.Free;
  AllNum:=ConnectObjectNum;
end;

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

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

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

   ConnectObjectNum:=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,ConnectObjectNum,x,y,n);
           ConnectObjectNum:= ConnectObjectNum+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 ( Bearimage.Picture.Bitmap);
   for y:=0 to Bmp.Height-1 do t[y] := Bmp.ScanLine[y];
   w:=Bmp.Width;
   h:=Bmp.Height ;

   for i:=1 to t1 do
   begin
     n:=0;
     ConnectAreaSum(w,h,ConnectObjectNum,Obectject_XY[2*i-1],Obectject_XY[2*i],n ) ;
   end;