⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 childwin.~pas

📁 数字图像预出处理系统
💻 ~PAS
📖 第 1 页 / 共 5 页
字号:
//Designer: Jiang Xiangang    2005.8
unit CHILDWIN;

interface

uses Windows, Classes, Graphics, Forms, Controls, StdCtrls, ExtCtrls, Menus,Clipbrd,
      math,Messages, SysUtils, Variants,Dialogs, ExtDlgs, ComCtrls,GrayCurrenceMatrix;
      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)
    LiverImage: TImage;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    cellStatistic1: TMenuItem;
    ColorImageSum: TMenuItem;
    DistributionOfGray: TMenuItem;
    twovalue: TMenuItem;
    HoleFilling: TMenuItem;
    Erode: TMenuItem;
    Undo: TMenuItem;
    withdraw: TMenuItem;
    loadAgain: TMenuItem;
    CellStatistic: TMenuItem;
    twovalue1: TMenuItem;
    FindCenter: TMenuItem;
    HSL: TMenuItem;
    removeimpurity: TMenuItem;
    ImageProcess: TMenuItem;
    TwoValueMethod: TMenuItem;
    TwoMaxThreshold: TMenuItem;
    OtsuThreshold: TMenuItem;
    TotalThreshold: TMenuItem;
    ErodeProcess: TMenuItem;
    expand: TMenuItem;
    ItinerateThreshold: TMenuItem;
    TotalThresholdInColor: TMenuItem;
    HSL1: TMenuItem;
    Gray: TMenuItem;
    FillHole: TMenuItem;
    MiddleValueFilter: TMenuItem;
    GrayStrech: TMenuItem;
    Contrast: TMenuItem;
    StrengthSaturation: TMenuItem;
    TextureRecgnize: TMenuItem;
    GrayMatrix: TMenuItem;
    LiverPartImage: TImage;
    N2: TMenuItem;
    Kmeans1: TMenuItem;
    FCM1: TMenuItem;
    N2561: TMenuItem;
    DotN: TMenuItem;
    ManualN: TMenuItem;
    ResultReportN: TMenuItem;
    SetSystemParameter: TMenuItem;
    N9: TMenuItem;
    Windown16N: TMenuItem;
    N10: TMenuItem;
    Distance5N: TMenuItem;
    Distance3N: TMenuItem;
    N11: TMenuItem;
    GrayLayer8N: TMenuItem;
    GrayLayer16N: TMenuItem;
    Windown8N: TMenuItem;
    N4: TMenuItem;
    FiledChoiceN: TMenuItem;
    PlayParameterN: TMenuItem;
    N3: 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 LiverImageMousedown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LiverImageMouseMove(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 TotalThresholdInColorClick(Sender: TObject);
    procedure HSL1Click(Sender: TObject);
    procedure GrayClick(Sender: TObject);
    procedure FillHoleClick(Sender: TObject);
    procedure MiddleValueFilterClick(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);
    procedure GrayMatrixClick(Sender: TObject);
    procedure LiverImageMouseup(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure N2561Click(Sender: TObject);
    procedure DotNClick(Sender: TObject);
    procedure ManualNClick(Sender: TObject);
    procedure ResultReportNClick(Sender: TObject);
    procedure Windown16NClick(Sender: TObject);
    procedure Windown8NClick(Sender: TObject);
    procedure Distance5NClick(Sender: TObject);
    procedure Distance3NClick(Sender: TObject);
    procedure GrayLayer8NClick(Sender: TObject);
    procedure GrayLayer16NClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PlayParameterNClick(Sender: TObject);
    procedure FormShow(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;
   startpoint,endpoint:Tpoint;
implementation

uses Distribution, MAIN, HSL, DataModule, Stat, QReport,LiverTextureRec,
  SystemParameter;

{$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(LiverImage.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(LiverImage.Picture.Bitmap);
    withdraw.Enabled :=true;
    mainForm.ToolButton4.Enabled:=true;
    threshold:=strtoint(DistributionForm.Edit1.Text);
   //strtoint(DistributionForm.Edit1.Text);
    Bmp := TBitmap.Create;
    Bmp.Assign(LiverImage.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;
  LiverImage.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(LiverImage.Picture.Bitmap);
   w:= Bmp.Width ;
   H:= Bmp.Height ;
   withdrawBmp.Assign(LiverImage.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;
   LiverImage.Picture.Bitmap.Assign(Bmp) ;
   Bmp.Free;
   erode.Enabled :=true;
end;

procedure TMDIChild.ErodeClick(Sender: TObject);
begin
   withdrawBmp.Assign(LiverImage.Picture.Bitmap);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -