childwin.~pas

delphi 血液红细胞识别统计源代码

    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(BloodImage.Picture.Bitmap);
   withdraw.Enabled :=true;
   GravityNum:=0;
   for I:=0 to 1000 do Obectject_XY[i]:=0;
   Bmp3:= Tbitmap.Create;
   Bmp3.Assign (BloodImage.Picture.Bitmap);
   Bmp1:= Tbitmap.Create;
   Bmp1.Assign ( BloodImage.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;
  BloodImage.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  BloodImage 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,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(BloodImage.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;
  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 ; BloodImage.Cursor :=crcross;
      ProcessedBmp := TBitmap.Create;
      ProcessedBmp.Assign(BloodImage.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(BloodImage.Picture.Bitmap);
   withdraw.Enabled :=true;
   Bmp:= Tbitmap.Create;
   Bmp.Assign ( BloodImage.Picture.Bitmap);

   for y:=0 to Bmp.Height-1 do t[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 ( BloodImage.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,c,Obectject_XY[2*i-1],Obectject_XY[2*i],n ) ;
   end;
   BloodImage.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
  BloodImage.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] := 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:= '双峰法求阀值';
  Child.ErodeProcess.Enabled:=true;
  Child.expand.Enabled:=true;
  TMDIChild(Child).BloodImage.picture.bitmap.Assign (Bmp);
  Child.Width :=Child.BloodImage.picture.width+1;
  Child.height:=Child.BloodImage.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;