dcmtest.pas

用Delphi做的读取医学图片的控件及代码

unit DCMtest;

interface

uses
  SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs,
  QStdCtrls,QT, QButtons, QComCtrls, QExtCtrls, QDCMImage;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    OpenBtn: TSpeedButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    SpeedButton2: TSpeedButton;
    StatusBar1: TStatusBar;
    ColorBox: TComboBox;
    ToolBox: TComboBox;
    ZoomBox: TComboBox;
    SmoothCheck: TCheckBox;
    OverlayBox: TComboBox;
    MosaicBox: TComboBox;
    nextbtn: TSpeedButton;
    PrevBtn: TSpeedButton;
    SaveBtn: TSpeedButton;
    DCMclx1: TDCMImage;
    procedure OpenBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure ColorBoxChange(Sender: TObject);
    procedure ToolBoxChange(Sender: TObject);
    procedure ZoomBoxChange(Sender: TObject);
    procedure SmoothCheckClick(Sender: TObject);
    procedure OverlayBoxChange(Sender: TObject);
    procedure MosaicBoxChange(Sender: TObject);
    procedure PrevBtnClick(Sender: TObject);
    procedure nextbtnClick(Sender: TObject);
    procedure SaveBtnClick(Sender: TObject);
  protected
  function WidgetFlags: Integer; override;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.xfm}
function
TForm1.WidgetFlags: Integer;
begin
// To reduce flickering on LINUX
Result := Inherited WidgetFlags or
Integer(WidgetFlags_WRepaintNoErase) or Integer(WidgetFlags_WResizeNoErase);
end;
procedure TForm1.OpenBtnClick(Sender: TObject);
begin
        //OpenDialog1.InitialDir := 'D:\mri\dicom\cpt\';
        if not OpenDialog1.Execute then exit;
        DCMclx1.DCMfilename := OpenDialog1.Filename;
        if DCMclx1.Get_DCMimageSlices > 1 then begin
                PrevBtn.Visible := true;
                NextBtn.Visible := true;
                MosaicBox.Visible := true;
        end else begin
                PrevBtn.Visible := false;
                NextBtn.Visible := false;
                MosaicBox.Visible := false;
        end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
        OpenDialog1.Filter := 'DICOM medical image (*.*)';
        SaveDialog1.Filter :=  'JPEG (*.jpg)|PNG (*.png)|Bitmap (*.bmp)';
        SaveDialog1.DefaultExt := '*.jpg';
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
        Showmessage(DCMclx1.Get_DCMversionInfo);
end;

procedure TForm1.ColorBoxChange(Sender: TObject);
var lIndex : integer;
begin
    lIndex := ColorBox.ItemIndex;
    case lIndex of
        0: DCMclx1.DCMcolorScheme := 1;
        1: DCMclx1.DCMcolorScheme := 2;
        2: DCMclx1.DCMcolorScheme := -1;
        3: DCMclx1.DCMcolorScheme := -2;
    end; //case
end;

procedure TForm1.ToolBoxChange(Sender: TObject);
var lIndex: integer;
begin
  lIndex := ToolBox.ItemIndex+1;
  if lIndex = 4 then lIndex := 5;
  DCMclx1.DCMtool := lIndex;
end;

procedure TForm1.ZoomBoxChange(Sender: TObject);
var lIndex : integer;
begin
   lIndex := ZoomBox.ItemIndex+1;
   DCMclx1.DCMbestfitzoom := false;
   DCMclx1.DCMzoomPct := 100 * lIndex;
end;

procedure TForm1.SmoothCheckClick(Sender: TObject);
begin
   DCMclx1.DCMsmoothOn := SmoothCheck.Checked;
end;

procedure TForm1.OverlayBoxChange(Sender: TObject);
var lIndex: integer;
begin
   lIndex := OverlayBox.ItemIndex;
   if lIndex = 2 then
        DCMclx1.DCMOverlayOn := false
   else begin
       DCMclx1.DCMOverlayOn := true;
       if lIndex = 0 then
        DCMclx1.DCMoverlayColor := 0
       else
        DCMclx1.DCMoverlayColor := 1;
   end;
end;

procedure TForm1.MosaicBoxChange(Sender: TObject);
var lIndex: integer;
begin
   lIndex := MosaicBox.ItemIndex;
   case lIndex of
      0:  DCMclx1.Set_DCMmosaicX(1,1,1,maxint);
      1:  DCMclx1.Set_DCMmosaicX(2,2,1,maxint);
      2: DCMclx1.Set_DCMmosaicX(2,3,1,maxint);
      3: DCMclx1.Set_DCMmosaicX(4,4,1,maxint);
   end;
end;

procedure TForm1.PrevBtnClick(Sender: TObject);
var lSlice: integer;
begin
  if MosaicBox.ItemIndex <> 0 then begin
        MosaicBox.ItemIndex := 0;
        MosaicBoxChange(nil);
  end;
  lSlice := DCMclx1.DCMslice;
  if lSlice > 1 then
        DCMclx1.DCMslice := lSlice - 1
  else
    DCMclx1.DCMslice := DCMclx1.Get_DCMimageSlices;
end;

procedure TForm1.nextbtnClick(Sender: TObject);
var lSlice: integer;
begin
  if MosaicBox.ItemIndex <> 0 then begin
        MosaicBox.ItemIndex := 0;
        MosaicBoxChange(nil);
  end;
  lSlice := DCMclx1.DCMslice;
  if lSlice < DCMclx1.Get_DCMimageSlices then
        DCMclx1.DCMslice := lSlice + 1
  else
    DCMclx1.DCMslice := 1;
end;

procedure TForm1.SaveBtnClick(Sender: TObject);
begin
     if not SaveDialog1.Execute then exit;
     DCMclx1.Set_DCMsavetofile(SaveDialog1.Filename);
     SaveDialog1.InitialDir := extractfiledir(SaveDialog1.FileName);
end;
//     DCMclx1.Set_DCMcopytoClipboard;
end.