unit5.pas

Dicom Delphi code 看DICOM图像

unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, StrUtils, DICOMax_TLB;

type
  TfrmDICOMDir = class(TForm)
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    lstPatient: TListBox;
    Label2: TLabel;
    lstStudy: TListBox;
    Label3: TLabel;
    lstSeries: TListBox;
    Label4: TLabel;
    lstImage: TListBox;
    DICOMX1: TDICOMX;
    procedure Button1Click(Sender: TObject);
    procedure lstSeriesClick(Sender: TObject);
    procedure lstImageClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmDICOMDir: TfrmDICOMDir;

implementation

{$R *.dfm}

procedure TfrmDICOMDir.Button1Click(Sender: TObject);
var
  i : Integer;
begin
  DICOMX1.OpenDICOMDir := Edit1.Text;
  if DICOMX1.DICOMDirLastOpenSuccess=True then
  begin
    lstPatient.Clear;
    if DICOMX1.DICOMDirPatientName <> '' then
      lstPatient.Items.Append(DICOMX1.DICOMDirPatientName)
    else
      lstPatient.Items.Append('No Patient Name');

    lstStudy.Clear;
    if DICOMX1.DICOMDirStudyCount > 0 then
    begin
      for i := 1 to DICOMX1.DICOMDirStudyCount do
      begin
        DICOMX1.DICOMDirStudyPos := i;
        lstStudy.Items.Append(DICOMX1.DICOMDirStudyDateCurrent + ' , ' + DICOMX1.DICOMDirStudyTimeCurrent + ' , ' + DICOMX1.DICOMDirStudyDescriptionCurrent);
      end;
      DICOMX1.DICOMDirStudyPos := 1;
    end;

    lstSeries.Clear;
    if DICOMX1.DICOMDirSeriesCount > 0 then
    begin
      for i := 1 to DICOMX1.DICOMDirSeriesCount do
      begin
        DICOMX1.DICOMDirSeriesPos := i;
        lstSeries.Items.Append('[' + DICOMX1.DICOMDirSeriesModalityCurrent + '] (' + IntToStr(DICOMX1.DICOMDirSeriesImageCountCurrent) + ')Images , ' +
          DICOMX1.DICOMDirSeriesDateCurrent + ' , ' + DICOMX1.DICOMDirSeriesTimeCurrent + ' , ' + DICOMX1.DICOMDirSeriesDescriptionCurrent);
        DICOMX1.DICOMDirSeriesPos := 1;
      end;
    end;

    lstImage.Clear;
    if (DICOMX1.DICOMDirSeriesPos > 0) and (DICOMX1.DICOMDirSeriesImageCountCurrent > 0) then
    begin
      for i := 1 to DICOMX1.DICOMDirSeriesImageCountCurrent do
      begin
        DICOMX1.DICOMDirImagePos := i;
        lstImage.Items.Append(DICOMX1.DICOMDirImageFileTypeCurrent + ' , ' + DICOMX1.DICOMDirImageFileNameCurrent);
      end;
      DICOMX1.DICOMDirImagePos := 1;
    end;
  end;
end;

procedure TfrmDICOMDir.lstSeriesClick(Sender: TObject);
var
  i : Integer;
begin
  i := lstSeries.ItemIndex + 1;
  if (i < 1) Or (i > 16) then
    Exit
  else
    DICOMX1.DICOMDirSeriesPos := i;

  lstImage.Clear;
  if (DICOMX1.DICOMDirSeriesPos > 0) and (DICOMX1.DICOMDirSeriesImageCountCurrent > 0) then
  begin
    for i := 1 to DICOMX1.DICOMDirSeriesImageCountCurrent do
    begin
      DICOMX1.DICOMDirImagePos := i;
      lstImage.Items.Append(DICOMX1.DICOMDirImageFileTypeCurrent + ' , ' + DICOMX1.DICOMDirImageFileNameCurrent);
    end;
    DICOMX1.DICOMDirImagePos := 1;
  end;

end;

procedure TfrmDICOMDir.lstImageClick(Sender: TObject);
var
  sFileName : String;
  i : Integer;
begin
  i := lstImage.ItemIndex + 1;
  if (i < 1) Or (i > 128) then
    Exit
  else
    DICOMX1.DICOMDirImagePos := i;

  if DICOMX1.DICOMDirImageFileNameCurrent <> '' then
  begin
    if Pos('DICOMDIR',edit1.Text) = 0 then
    begin
      if RightStr(edit1.Text, 1) = '\' then
        sFileName := edit1.Text + DICOMX1.DICOMDirImageFileNameCurrent
      else
        sFileName := edit1.Text + '\' + DICOMX1.DICOMDirImageFileNameCurrent;
    end
    else
      sFileName := LeftStr(edit1.Text, Pos('DICOMDIR',edit1.Text) - 1) + '\' + DICOMX1.DICOMDirImageFileNameCurrent;

    if FileExists(Trim(sFileName)) then
      DICOMX1.OpenFileName := sFileName;
  end;
end;

procedure TfrmDICOMDir.FormCreate(Sender: TObject);
begin
  DICOMX1.ImageZoomBestFit := True;
end;

procedure TfrmDICOMDir.FormShow(Sender: TObject);
begin
  Edit1.SetFocus;
end;

end.