childwin.~pas

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

    end;
  if (x>0) and (y<h-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<h-1) 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<w-1) and (y<h-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 (x<w-1)  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);
    end;
end;

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

procedure TMDIChild.ErodeClick(Sender: TObject);
begin
   withdrawBmp.Assign(Bearimage.Picture.Bitmap);
   withdraw.Enabled :=true;
   if (BitmapErode(Bearimage.Picture.Bitmap, True)) then
   begin
      Bearimage.Picture.Assign(Bearimage.Picture.Bitmap);
   //   cellStatistic.Enabled :=true;
   end
   else
      showmessage('腐蚀失败');
end;
function TMDIChild.BitmapErode(Bitmap: TBitmap; Horic: Boolean): Boolean;
var
   X, Y: Integer;
   NewBmp: TBitmap;
   P, Q, R, O: pByteArray;
begin
   NewBmp := TBitmap.Create;   //动态创建位图
   NewBmp.Assign(bitmap);
        if (Horic) 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] = 0) and (O[3*X + 1] = 0) and (O[3*X + 2] = 0)) then
            begin  // 判断黑点左右邻居是否有白色点,有则腐蚀,置该点为白色
               // 白色点则保持不变
               if (((Q[3*(X - 1)]= 255) and (Q[3*(X - 1)+ 1] =255)
                  and (Q[3*(X - 1)+2] = 255)) or ((Q[3*(X + 1)] = 255)
                  and (Q[3*(X + 1)+1] = 255) and
                  (Q[3*(X + 1) + 2] = 255)) or ((P[3*X] = 0) and
                  (P[3*X + 1] = 255) and (P[3*X + 2] = 255))
                  or ((R[3*X] = 255) and (R[3*X + 1] = 255) and
                  (R[3*X + 2] = 255))) then
               begin
                  O[3*X] := 255; O[3*X + 1] := 255; O[3*X + 2] := 255;
                  // 将满足条件的黑色点置为白色
               end;
            end;
         end;
      end;
   end
   else
   begin
      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] = 0) and (O[3 * X + 1] = 0) and (O[3 * X + 2]
               = 0)) then
            begin
               if (((Q[3 * (X - 1)] = 255) and (Q[3 * (X - 1) + 1] =
                  255) and (Q[3 * (X - 1) + 2] = 255)) or ((Q[3 * (X+1)] = 255)
                  and (Q[3 * (X + 1) + 1] = 255) and
                  (Q[3 * (X + 1) + 2] = 255)))   then
               begin
                  O[3 * X] := 255; O[3 * X + 1] := 255; O[3 * X + 2] := 255;
                  // 将满足条件的黑色点置为白色
               end;
            end;
         end;
      end;
   end;
   result := True;
end;


procedure TMDIChild.withdrawClick(Sender: TObject);
begin
  Bearimage.Picture .bitmap.Assign(withdrawBmp);
  withdraw.Enabled :=false;
end;

procedure TMDIChild.HSIClick(Sender: TObject);
begin
  if MessageDlg('请点击鼠标选取一块颜色',
         mtConfirmation, [mbYes, mbNo],0)=mryes then
    begin
      mark1:=true ;Bearimage.cursor:=crcross;
    end else mark1:=false;
end;

procedure  TMDIChild.RGB_TO_HSl(R,G,B:Integer;VAR H,S,L:Integer);
var
  delta:double;
  cmax,cmin:double;
  red,green,blue,hue,sat,lum:double;
begin
  red:=r/255;
  green:=g/255;
  blue:=b/255;
  cmax:=max(red,max(green,blue));
  cmin:=min(red,min(green,blue));
  Lum:=(cmax+cmin)/2;
  if cmax=cmin then
    begin
      sat:=0;
      hue:=0;
   end
  else
  begin
    if lum<0.5 then
    sat:=(cmax-cmin)/(cmax+cmin)
    else sat:=(cmax-cmin)/(2-cmax-cmin);
        delta:=cmax-cmin;
        if red=cmax then
           hue:=(green-blue)/delta
           else
             if green =cmax then
               hue:=2+(blue-red)/delta
                else
                  hue:=4.0+(red-green)/delta ;
                  hue:=hue/6;
                  if hue<0 then
                  hue:=hue+1;
                  end;
  h:=Round(hue*360);
  s:=Round(sat*100);
  l:=Round(lum*100);
end;

procedure TMDIChild.BearimageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  h,s,l,RColor,GColor,BColor:array [0..130] of Integer;
  i,t,j,Gray:Integer;
begin
  if ((mark1=true) or (mark2=true)) then
  begin
    if mark1=true then
    begin
      RColor[0]:=getrvalue(Bearimage.Canvas.Pixels[x, y]);
      GColor[0]:=getgvalue(Bearimage.Canvas.Pixels[x, y]);
      bColor[0]:=getbvalue(Bearimage.Canvas.Pixels[x, y]);

      RColor[1]:=getrvalue(Bearimage.Canvas.Pixels[x, y-1]);
      GColor[1]:=getgvalue(Bearimage.Canvas.Pixels[x, y-1]);
      bColor[1]:=getbvalue(Bearimage.Canvas.Pixels[x, y-1]);

      RColor[2]:=getrvalue(Bearimage.Canvas.Pixels[x+1, y]);
      GColor[2]:=getgvalue(Bearimage.Canvas.Pixels[x+1, y]);
      bColor[2]:=getbvalue(Bearimage.Canvas.Pixels[x+1, y]);

      RColor[3]:=getrvalue(Bearimage.Canvas.Pixels[x, y+1]);
      GColor[3]:=getgvalue(Bearimage.Canvas.Pixels[x, y+1]);
      bColor[3]:=getbvalue(Bearimage.Canvas.Pixels[x, y+1]);

      RColor[4]:=getrvalue(Bearimage.Canvas.Pixels[x-1, y]);
      GColor[4]:=getgvalue(Bearimage.Canvas.Pixels[x-1, y]);
      bColor[4]:=getbvalue(Bearimage.Canvas.Pixels[x-1, y]);

      RColor[5]:=getrvalue(Bearimage.Canvas.Pixels[x+1, y-1]);
      GColor[5]:=getgvalue(Bearimage.Canvas.Pixels[x+1, y-1]);
      bColor[5]:=getbvalue(Bearimage.Canvas.Pixels[x+1, y-1]);

      RColor[6]:=getrvalue(Bearimage.Canvas.Pixels[x+1, y+1]);
      GColor[6]:=getgvalue(Bearimage.Canvas.Pixels[x+1, y+1]);
      bColor[6]:=getbvalue(Bearimage.Canvas.Pixels[x+1, y+1]);

      RColor[7]:=getrvalue(Bearimage.Canvas.Pixels[x-1, y+1]);
      GColor[7]:=getgvalue(Bearimage.Canvas.Pixels[x-1, y+1]);
      bColor[7]:=getbvalue(Bearimage.Canvas.Pixels[x-1, y+1]);

      RColor[8]:=getrvalue(Bearimage.Canvas.Pixels[x-1, y-1]);
      GColor[8]:=getgvalue(Bearimage.Canvas.Pixels[x-1, y-1]);
      bColor[8]:=getbvalue(Bearimage.Canvas.Pixels[x-1, y-1]);

      hp:=0;lp:=0;sp:=0;
      for i:=0 to 8 do
      begin
        RGB_TO_HSL(RColor[i],GColor[i],BColor[i],  H[i],S[i],L[i]);
        hp:=hp+h[i];lp:=lp+l[i];sp:=sp+s[i];
      end;
      hp:=Round(hp/9); lp:=Round(lp/9); sp:=Round(sp/9);
      mark1:=false;
    end;

  if mark2=true  then
  begin
    canvas.Brush.Style:=bsclear;
    canvas.Rectangle(x-5,y-5,x+5,y+5) ;
    t:=0;
    for i:=-5 to 5 do
      for j:=-5 to 5 do
        begin
          RColor[t]:=getrvalue(Bearimage.Canvas.Pixels[x+i, y+j]);
          GColor[t]:=getgvalue(Bearimage.Canvas.Pixels[x+i, y+j]);
          bColor[t]:=getbvalue(Bearimage.Canvas.Pixels[x+i, y+j]);
          t:=t+1;
        end;
   hp:=0;lp:=0;sp:=0;
   for i:=0 to 120 do
   begin
     RGB_TO_HSL(RColor[i],GColor[i],BColor[i],  H[i],S[i],L[i]);
     hp:=hp+h[i];lp:=lp+l[i];sp:=sp+s[i];
   end;
   hp:=Round(hp/121); lp:=Round(lp/121); sp:=Round(sp/121);
   mark2:=false;
 end;
  HSLform.Show ;
  hslform.h.Caption :=inttostr(hp);
  hslform.s.Caption :=inttostr(sp);
  hslform.l.Caption :=inttostr(lp);
  Bearimage.cursor:=crDefault;
  TwoValue1.enabled:=true;
 end;
end;



procedure TMDIChild.BearimageMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var RColor,GColor,BColor,H,L,S,gray:Integer;
begin
  mainform.StatusBar1.panels[0].Text :='位置：'+inttostr(x)+','+inttostr(y)+'';
  RColor:=getrvalue(Bearimage.Canvas.Pixels[x, y]);
  GColor:=getgvalue(Bearimage.Canvas.Pixels[x, y]);
  BColor:=getbvalue(Bearimage.Canvas.Pixels[x, y]);
   if (rColor=gColor) then  gray:=rColor else
   Gray :=Round( RColor * 0.3 + GColor * 0.59 + BColor * 0.11);
   RGB_TO_HSL(RColor,GColor,BColor,H,S,L);
   mainform.StatusBar1 .panels[1].Text :='色度:'+inttostr(h)+' ,饱和度:'+inttostr(s)+' ,亮度:'+inttostr(l)+' ,灰度:'+inttostr(Gray);
   Bearimage.Hint:='色度:'+inttostr(h)+' ,饱和度:'+inttostr(s)+' ,亮度:'+inttostr(l) +' ,灰度:'+inttostr(Gray);
end;

procedure TMDIChild.TwoValue1Click(Sender: TObject);
var
  Bmp : TBitmap ;
  p: PByteArray;
  x,y:Integer;
  HueMax1,HueMax2,HueMin1,HueMin2,
  SaturationMax,Saturationmin,LightnessMax,Lightnessmin:Integer;
begin
  withdrawBmp.Assign(Bearimage.Picture.Bitmap);
  withdraw.Enabled :=true;
  mainForm.ToolButton4.Enabled:=true;
  hf:=strtoint(HSLform.edit1.text);
  lf:=strtoint(HSLform.edit2.text);
  sf:=strtoint(HSLform.edit3.text);
  Bmp := TBitmap.Create;
  Bmp.Assign(Self.Bearimage.Picture.Bitmap); //24位图处理
  Bmp.PixelFormat := pf24Bit;
  SaturationMax:=min((sp+sf),100);  Saturationmin:=Max((sp-sf),0);
  LightnessMax:=min((lp+lf),100);   Lightnessmin:=Max((lp-lf),0);
      if (hp+hf)>=360 then begin
  HueMin1:=0;HueMax1:=(hp+hf)-360;
  HueMax2:=360;HueMin2:=hp-hf;
      end;
      if (hp-hf)<=0 then
  begin
  HueMin1:=0;   HueMax1:=hp+hf;
  HueMin2:=360+(hp-hf); HueMax2:=360;
      end;
  for y := 0 to Bmp.Height - 1 do
    begin
        p := Bmp.scanline[y];
        for x := 0 to Bmp.Width - 1 do
        begin
            //算出每一点的灰度值
         RGB_TO_HSL (p[x * 3 + 2],p[x * 3 + 1],p[x* 3],h1,s1,l1);
          if (((h1<=HueMax1)and(h1>=HueMin1))and((l1<=LightnessMax)and(l1>=Lightnessmin))
     and ((s1<=SaturationMax)and(s1>=Saturationmin)))      or
          (((h1<=HueMax2)and(h1>=HueMin2))and((l1<=LightnessMax)and(l1>=Lightnessmin))
          and ((s1<=SaturationMax)and(s1>=Saturationmin)))
            then  begin
                    p[x * 3 + 2]:=0;
                    p[x * 3 + 1]:=0;
                    p[x* 3]:=0;
                  end else
                  begin
           p[x * 3 + 2]:=255;p[x * 3 + 1]:=255; p[x* 3]:=255;
                  end;
        end;
    end;
    Bearimage.Picture .Bitmap .Assign(Bmp);
    Bmp.Free;
    removeimpurity.Enabled :=true;
end;

procedure edge(Bmp:Tbitmap);
var
   b0, b1: Tbitmap;
   i, j,k: Integer;
   p1, p2, p3, p: pbyteArray;
begin
   b0 :=Tbitmap.Create;
   b0.Assign (Bmp);
   b1 :=Tbitmap.Create ;
   b1.Assign (Bmp);
   b0.PixelFormat := pf24bit;
   b1.PixelFormat := pf24bit;
   for i := 1 to b0.Height - 2 do
   begin
      p1 := b0.ScanLine[i - 1];
      p2 := b0.ScanLine[i];
      p3 := b0.ScanLine[i + 1];
      p := b1.ScanLine[i];   //提取后的像素
      for j := 1 to  b0.Width - 2 do
      begin
        if(p2[3 * j] = 0) and (p2[3 * j + 2] = 0) and (p2[3 * j + 1] = 0)  then
        begin
          if ((p2[3 * (j - 1) + 2] = 255) and (p2[3 * (j - 1) + 1] = 255) and(p2[3 * (j - 1)] = 255))or
             ((p2[3 * (j + 1) + 2] = 255) and (p2[3 * (j + 1) + 1] = 255) and(p2[3 * (j + 1)] = 255)) or
             ((p1[3 * (j + 1) + 2] = 255) and (p1[3 * (j + 1) + 1] = 255) and(p1[3 * (j + 1)] = 255)) or
             ((p1[3 * (j) + 2] = 255) and (p1[3 * (j) + 1] = 255) and(p1[3 * (j)] = 255)) or
             ((p1[3 * (j - 1) + 2] = 255) and (p1[3 * (j - 1) + 1] = 255) and(p1[3 * (j - 1)] = 255)) or
             ((p3[3 * (j - 1) + 2] = 255) and (p3[3 * (j - 1) + 1] = 255) and(p3[3 * (j - 1)] = 255)) or
             ((p3[3 * (j) + 2] = 255) and (p3[3 * (j) + 1] = 255) and (p3[3 * (j)]= 255)) or
             ((p3[3 * (j + 1) + 2] = 255) and (p3[3 * (j + 1) + 1] = 255) and(p3[3 * (j + 1)] = 255) )then
          begin
               p[3 * j + 2] := 255; //置白色像素
               p[3 * j + 1] := 255;
               p[3 * j] := 255;
            end;
         end;
       end;
      end;
   p1:= b0.ScanLine[0];
   p2:= b0.scanline[1];
   p:= b1.ScanLine[0];
  for i:=1 to (b0.Width-2)  do
  begin
    if ((p1[3*i]=0) and (p1[3*i]=0) and (p1[3*i]=0))then
    begin
    if ((p1[3*(i-1)]=255) and (p1[3*(i-1)+1]=255) and (p1[3*(i-1)+2]=255))