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

📄 unit1.pas

📁 用Delphi做的读取医学图片的控件及代码
💻 PAS
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  OleCtrls, Menus, ToolWin, ComCtrls, Buttons, ezDICOMax_TLB;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    //DCMax1: TDCMax;
    SpeedButton2: TSpeedButton;
    SpeedButton1: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    Open1: TMenuItem;
    OpenDialog1: TOpenDialog;
    Zoom1: TMenuItem;
    BestFit1: TMenuItem;
    N501: TMenuItem;
    N1001: TMenuItem;
    N1501: TMenuItem;
    N2001: TMenuItem;
    View1: TMenuItem;
    Smooth1: TMenuItem;
    ColorScheme1: TMenuItem;
    BlackWhite1: TMenuItem;
    Fire1: TMenuItem;
    InvertedBW1: TMenuItem;
    InvertedHotmetal1: TMenuItem;
    Mosaic1: TMenuItem;
    N1x11: TMenuItem;
    N2x21: TMenuItem;
    N3x3: TMenuItem;
    //DCMax1: TezDICOM;
    About1: TMenuItem;
    DelphiDemo1: TMenuItem;
    DCMax1: TezDICOMX;
    ShowHeader1: TMenuItem;
    Edit1: TMenuItem;
    Copy1: TMenuItem;
    Saveimage1: TMenuItem;
    SaveDialog1: TSaveDialog;
    PreviousSliceItem: TMenuItem;
    NextSliceItem: TMenuItem;
    Overlay1: TMenuItem;
    procedure ToolClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N2001Click(Sender: TObject);
    procedure Smooth1Click(Sender: TObject);
    procedure InvertedHotmetal1Click(Sender: TObject);
    procedure N3x3Click(Sender: TObject);
    procedure DelphiDemo1Click(Sender: TObject);
    procedure ShowHeader1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Saveimage1Click(Sender: TObject);
    procedure Unloadimages1Click(Sender: TObject);
    procedure PreviousSliceItemClick(Sender: TObject);
    procedure NextSliceItemClick(Sender: TObject);
    procedure DCMax1DCMmouseMoveIntensity(ASender: TObject; X, Y, Button,
      Shift, Intensity: Integer; RGB: WordBool);
    procedure Overlay1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ToolClick(Sender: TObject);
begin
     DCMax1.DCMtool := (sender as TSpeedButton).tag;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.Open1Click(Sender: TObject);
var lC: integer;
begin
     DCMax1.DCMloadmultiplefiles := true;
     if not OpenDialog1.execute then exit;
         DCMax1.DCMfilename := OpenDialog1.Filename;
     //lC := DCMax1.DCMfilenameSilentErrors[OpenDialog1.Filename];
     //showmessage(DCMax1.DCMwriteHeader2String[OpenDialog1.Filename]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  DCMax1.DCMtoolbar := false;
  Smooth1.Checked := DCMax1.DCMsmoothOn;
end;

procedure TForm1.N2001Click(Sender: TObject);
var lPct: integer;
begin
     (Sender as TMenuItem).Checked := true;
     lPct := (Sender as TMenuItem).tag;
     if lPct = 0 then begin
         if not DCMax1.DCMbestFitZoom then
            DCMax1.DCMbestFitZoom := true;
     end else begin
         if DCMax1.DCMbestFitZoom then
            DCMax1.DCMbestFitZoom := false;
         DCMax1.DCMzoomPct := lPct;
     end;

end;

procedure TForm1.Smooth1Click(Sender: TObject);
begin
  Smooth1.Checked := not Smooth1.Checked;
  DCMax1.DCMsmoothOn := Smooth1.Checked;
end;

procedure TForm1.InvertedHotmetal1Click(Sender: TObject);
begin
     (Sender as TMenuItem).Checked := true;
     DCMax1.DCMcolorscheme := (Sender as TMenuItem).tag;
end;

procedure TForm1.N3x3Click(Sender: TObject);
var lMosaic: integer;
begin
    lMosaic := (Sender as TMenuItem).tag;
    (Sender as TMenuItem).checked := true;
    //Form1.caption := inttostr(lMosaic);
    DCMax1.DCMmosaicFirstSlice := 1;
    DCMax1.DCMmosaicLastSlice := maxint;
    DCMax1.DCMmosaicRows := lMosaic;
    DCMax1.DCMmosaicCols := lMosaic;

    //DCMax1.DCMmosaicX[lMosaic,lMosaic,1] := MaxInt;
    //DCMax1.DCMmosaicX[2,2,1,16];
    //xxxx
end;

procedure TForm1.DelphiDemo1Click(Sender: TObject);
begin
 showmessage('DelphiDemo by Chris Rorden. Demonstrates ezDICOM ActiveX component. '+
  DCMax1.DCMversionInfo);
end;

procedure TForm1.ShowHeader1Click(Sender: TObject);
begin
  ShowHeader1.Checked := not ShowHeader1.Checked;
  DCMax1.DCMshowHeader := ShowHeader1.Checked;
end;

procedure TForm1.Copy1Click(Sender: TObject);
begin
  if DCMax1.DCMshowHeader then
    DCMax1.DCMcopyHeader2Clipboard
  else
    DCMax1.DCMcopyImage2Clipboard;
end;

procedure TForm1.Saveimage1Click(Sender: TObject);
begin
     if not SaveDialog1.Execute then exit;
     DCMax1.DCMsaveToFile := SaveDialog1.FileName;
end;

procedure TForm1.Unloadimages1Click(Sender: TObject);
begin
end;
(*procedure TForm1.Loadc0020dcm50times1Click(Sender: TObject);
var lInc: integer;
begin
  for lInc := 1 to 50 do
    DCMax1.DCMfilename := 'C:\0020.dcm';
end;

procedure TForm1.Unloadimages1Click(Sender: TObject);
begin
  DCMax1.DCMunloadImages:= 0;
end;
*)
procedure TForm1.PreviousSliceItemClick(Sender: TObject);
begin
  if DCMax1.DCMslice > 1 then
    DCMax1.DCMslice := DCMax1.DCMslice -1
  else
    DCMax1.DCMslice := DCMax1.DCMimageSlices;
end;

procedure TForm1.NextSliceItemClick(Sender: TObject);
begin
  if DCMax1.DCMslice < DCMax1.DCMimageSlices then
    DCMax1.DCMslice := DCMax1.DCMslice +1
  else
    DCMax1.DCMslice := 1;
end;

procedure TForm1.DCMax1DCMmouseMoveIntensity(ASender: TObject; X, Y,
  Button, Shift, Intensity: Integer; RGB: WordBool);
begin
//DCMmouseMoveIntensity
  Caption := inttostr(X)+','+inttostr(Y)+':'+inttostr(intensity);
end;

procedure TForm1.Overlay1Click(Sender: TObject);
begin
  Overlay1.Checked := not Overlay1.Checked;
  DCMax1.DCMoverlayOn := Overlay1.Checked;
end;

end.

⌨️ 快捷键说明

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