childwin.~pas

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

//Designer: Jiang Xiangang    2005.8
unit CHILDWIN;

interface

uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Menus,
      math,Messages, SysUtils, Variants,Dialogs, ExtDlgs, ComCtrls;
      const
   MaxPixelCount = 65536;
      type
  Center=record
         r:Integer;
         x:Integer;
         y:Integer
         end;
        pRGBTripleArray = ^TRGBTripleArray;
        TRGBTripleArray = array[0..MaxPixelCount - 1] of TRGBTriple;
type
  TMDIChild = class(TForm)
    BloodImage: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    cellStatistic1: TMenuItem;
    N3: TMenuItem;
    DistributionOfGray: TMenuItem;
    twovalue: TMenuItem;
    HoleFilling: TMenuItem;
    erode: TMenuItem;
    N4: TMenuItem;
    withdraw: TMenuItem;
    loadAgain: TMenuItem;
    cellStatistic: TMenuItem;
    twovalue1: TMenuItem;
    FindCenter: TMenuItem;
    HSL: TMenuItem;
    removeimpurity: TMenuItem;
    N2: TMenuItem;
    erzhihua: TMenuItem;
    TwoMaxThreshold: TMenuItem;
    OtsuThreshold: TMenuItem;
    TotalThreshold: TMenuItem;
    ErodeProcess: TMenuItem;
    expand: TMenuItem;
    ItinerateThreshold: TMenuItem;
    N5: TMenuItem;
    HSL1: TMenuItem;
    Gray: TMenuItem;
    N6: TMenuItem;
    Filter: TMenuItem;
    GrayStrech: TMenuItem;
    Contrast: TMenuItem;
    StrengthSaturation: TMenuItem;
    procedure ItinerateThresholdClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure DistributionOfGrayClick(Sender: TObject);
    procedure twovalueClick(Sender: TObject);
    procedure connect(w,h, c,x,y:Integer);
    procedure HoleFillingClick(Sender: TObject);
    procedure erodeClick(Sender: TObject);
    function BitmapErode(Bitmap: TBitmap; Horic: Boolean): Boolean;
    procedure withdrawClick(Sender: TObject);
    procedure HSIClick(Sender: TObject);
    procedure BloodImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BloodImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure twovalue1Click(Sender: TObject);
    procedure FindCenterClick(Sender: TObject);
    procedure cellStatisticClick(Sender: TObject);
    procedure HSLClick(Sender: TObject);
    procedure removeimpurityClick(Sender: TObject);
    procedure cellStatistic1Click(Sender: TObject);
    procedure loadAgainClick(Sender: TObject);
    procedure TwoMaxThresholdClick(Sender: TObject);

    procedure OtsuThresholdClick(Sender: TObject);
    procedure TotalThresholdClick(Sender: TObject);
    procedure ErodeProcessClick(Sender: TObject);
    procedure expandClick(Sender: TObject);
    function BitmapDilate(Bitmap: TBitmap; Hori: Boolean): Boolean;
    procedure zzlbClick(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure HSL1Click(Sender: TObject);
    procedure GrayClick(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FilterClick(Sender: TObject);
    procedure SelectionSort(var a: array of Integer);
    procedure RGB_TO_HSL(R,G,B:Integer;VAR H,S,L:Integer);
    procedure HSL_to_RGB(H, S, L: Integer; var R, G, B: Integer);
    procedure GrayStrechClick(Sender: TObject);
    procedure GetParam(Bmp:TBitmap);
    procedure ContrastClick(Sender: TObject);
    procedure StrengthSaturationClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
var
  MDIChild:TMDIChild;
  ProcessedBmp:tbitmap;
  h1,s1,l1,hp,lp,sp,hf,sf,lf,sx,sy,numofcell:Integer;
  pCenter:array[0..1000] of Center;
  intGrayLevel: array[0..255] of Integer;
  RvalueArray, GvalueArray, BvalueArray: array[0..8] of Integer;
  t:array [0..800] of PByteArray;
   Grayclass: array[0..255] of Integer; 
   OriginalRangeRight,OriginalRangeLeft:Integer;
implementation

uses Distribution, MAIN, HSL, DataModule, Stat;

{$R *.dfm}

procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TMDIChild.DistributionOfGrayClick(Sender: TObject);
var
    Bmp,Bmp1:TBitmap;
    x,y,i,j,gray,MaxValue:Integer;
    p: PByteArray;
    GrayClass:array [0..260] of Integer;
begin
    DistributionForm.Show;
    Bmp := TBitmap.Create;
    Bmp.Assign(BloodImage.Picture.Bitmap);
    Bmp.PixelFormat := pf24Bit;
    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  //算出每一点的灰度值
            if (p[x * 3 + 2])=(p[x * 3 + 1]) then
           Gray := Round(p[x * 3 + 2]) else
    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;
    Bmp.Free;
    //初始化最大值变量
    MaxValue := GrayClass[0];
    DistributionForm.Image.Canvas.Brush.Color := clSkyBlue;
    //填充背景
    DistributionForm.Image.Canvas.FillRect(rect(0, 0, DistributionForm.Image.Width, DistributionForm.Image.Height));
    DistributionForm.Image.Canvas.Pen.Color := clyellow;
    for i := 1 to 255 do
    begin
        if MaxValue < GrayClass[i] then
        begin
            //获取某个灰度值上最大像素点数
            MaxValue := GrayClass[i];
        end;
    end;
    //开始绘制
    for i := 0 to 255 do
    begin
        //选用灰度渐变的画笔
        DistributionForm.Image.Canvas.Pen.Color := RGB(i, i, i);
        DistributionForm.Image.Canvas.MoveTo(64, 320);
        DistributionForm.Image.Canvas.LineTo(64,0);
        DistributionForm.Image.Canvas.MoveTo(128, 320);
        DistributionForm.Image.Canvas.LineTo(128,0);
        DistributionForm.Image.Canvas.MoveTo(192, 320);
        DistributionForm.Image.Canvas.LineTo(192,0);
        DistributionForm.Image.Canvas.MoveTo(256, 320);
        DistributionForm.Image.Canvas.LineTo(256,0);
        DistributionForm.Image.Canvas.MoveTo(320, 320);
        DistributionForm.Image.Canvas.LineTo(320,0);
        DistributionForm.Image.Canvas.MoveTo(384, 320);
        DistributionForm.Image.Canvas.LineTo(384,0);
        DistributionForm.Image.Canvas.MoveTo(448, 320);
        DistributionForm.Image.Canvas.LineTo(448,0);
        DistributionForm.Image.Canvas.MoveTo(2*i, 320);
        DistributionForm.Image.Canvas.LineTo(2*i, 320-Round(50 *(log10(GrayClass[i]+ 1.0))));
        //统计的数据进行对数降级
    end;
    Bmp1 := Tbitmap.Create;
    Bmp1.Width := DistributionForm.Image1.Width;
    Bmp1.Height := DistributionForm.Image1.Height;
    //在Image上绘制256级灰度分布图
    for i := 0 to 2*Bmp1.Width do
    begin
        Color := RGB(i, i, i);
        for j := 0 to Bmp1.Height do
        begin
            Bmp1.Canvas.Pixels[2*i, j] := Color;
            Bmp1.Canvas.Pixels[2*i-1, j] := Color;
        end;
    end;
    DistributionForm.Image1.Picture.Bitmap.Assign(Bmp1);
    Bmp1.Free;
    DistributionForm.Label4.Caption := '各灰度级上最大像素点数是:' + '                ';
    DistributionForm.Label5.Caption := inttostr(MaxValue);
    twovalue.Enabled :=true;
end;

procedure TMDIChild.TwoValueClick(Sender: TObject);
var
    p: PByteArray;
    Gray, x, y,threshold: Integer;
    Bmp: TBitmap;
begin
    withdrawBmp.Assign(BloodImage.Picture.Bitmap);
    withdraw.Enabled :=true;
    mainForm.ToolButton4.Enabled:=true;
    threshold:=strtoint(DistributionForm.Edit1.Text);
   //strtoint(DistributionForm.Edit1.Text);
    Bmp := TBitmap.Create;
    Bmp.Assign(BloodImage.Picture.Bitmap);
    //设置为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   //算出每一点的灰度值
           if (p[x * 3 + 2])=(p[x * 3 + 1]) then
            Gray := Round(p[x * 3 + 2]) else
            Gray := Round(p[x * 3 + 2] * 0.3 + p[x * 3 + 1] * 0.59 + p[x
                * 3] * 0.11);
            if gray > threshold then //全局阀值128
            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;
  BloodImage.Picture.Bitmap.Assign(Bmp);
    Bmp.Free;
     HoleFilling.Enabled :=true;
end;

procedure  TMDIChild.connect(w,h, c,x,y:Integer);    //t[]
begin
  if c=0 then
    begin
      t[y][3*(x)]:=0;
      t[y][3*(x)+1]:=0;
      t[y][3*(x)+2]:=255;
    end else
    begin
      t[y][3*(x)]:=0;
      t[y][3*(x)+1]:=0;
      t[y][3*(x)+2]:=0;
    end;

  if (y>0) and (x<W-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,c,x+1,y-1);
    end;

  if (y>0) 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,c,x,y-1);
    end;

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

  if  (x>0) 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,c,x-1,y);
    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,c,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,c,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,c,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,c,x+1,y);
    end;
end;

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

procedure TMDIChild.ErodeClick(Sender: TObject);
begin
   withdrawBmp.Assign(BloodImage.Picture.Bitmap);
   withdraw.Enabled :=true;
   if (BitmapErode(BloodImage.Picture.Bitmap, True)) then
   begin
      BloodImage.Picture.Assign(BloodImage.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