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

📄 unit9.pas

📁 Dicom Delphi code 看DICOM图像
💻 PAS
字号:
unit Unit9;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, jpeg, FileCtrl;

type
  TfrmAddImageFile = class(TForm)
    DriveComboBox1: TDriveComboBox;
    GroupBox1: TGroupBox;
    DirectoryListBox1: TDirectoryListBox;
    FileListBox1: TFileListBox;
    FilterComboBox1: TFilterComboBox;
    Image1: TImage;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    GroupBox2: TGroupBox;
    lstSlice: TListBox;
    Image2: TImage;
    Button2: TButton;
    Button3: TButton;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    procedure FileListBox1Click(Sender: TObject);
    procedure FileListBox1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure lstSliceClick(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmAddImageFile: TfrmAddImageFile;
  gbCanAppend : Boolean;

implementation

uses Unit6;

{$R *.dfm}

procedure TfrmAddImageFile.FileListBox1Click(Sender: TObject);
begin
  try
    Image1.Picture.LoadFromFile(FileListBox1.FileName);
    Label1.Caption := 'Width:'+IntToStr(Image1.Picture.Width);
    Label2.Caption := 'Height:'+IntToStr(Image1.Picture.Height);
    gbCanAppend := True;
  except
    gbCanAppend := False;
  end;
end;

procedure TfrmAddImageFile.FileListBox1DblClick(Sender: TObject);
begin
  if gbCanAppend then
  begin
    if lstSlice.Items.IndexOf(FileListBox1.FileName)=-1 then
    begin
      lstSlice.Items.Append(FileListBox1.FileName);
      lstSlice.ItemIndex := lstSlice.Items.Count - 1;
      lstSlice.OnClick(Self);
    end
    else
      showmessage('This file already exists!');
  end;
end;

procedure TfrmAddImageFile.Button1Click(Sender: TObject);
begin
  if gbCanAppend then
  begin
    if lstSlice.Items.IndexOf(FileListBox1.FileName)=-1 then
    begin
      lstSlice.Items.Append(FileListBox1.FileName);
      lstSlice.ItemIndex := lstSlice.Items.Count - 1;
      lstSlice.OnClick(Self);
    end
    else
      showmessage('This file already exists!');
  end;
end;

procedure TfrmAddImageFile.lstSliceClick(Sender: TObject);
begin
  try
    Image2.Picture.LoadFromFile(lstSlice.Items.Strings[lstSlice.ItemIndex]);
    Label3.Caption := 'Width:'+IntToStr(Image2.Picture.Width);
    Label4.Caption := 'Height:'+IntToStr(Image2.Picture.Height);
    Label5.Caption := IntToStr(lstSlice.ItemIndex+1)+'/'+IntToStr(lstSlice.Items.Count);
  except
  end;
end;

procedure TfrmAddImageFile.Button3Click(Sender: TObject);
begin
  lstSlice.Clear;
  Image2.Picture.Assign(nil);
  Label3.Caption := 'Width:0';
  Label4.Caption := 'Height:0';
  Label5.Caption := '0/0';

end;

procedure TfrmAddImageFile.Button2Click(Sender: TObject);
var
  i : Integer;
  sFN : String;
begin
  if lstSlice.Items.Count > 0 then
  begin
    sFN := '';
    for i := 0 to lstSlice.Items.Count-1 do
    begin
      sFN := sFN + lstSlice.Items.Strings[i];
      if i<lstSlice.Items.Count-1 then
        sFN := sFN + '*';
    end;
    frmSaveDICOM.edtSrcImageFile.Text := sFN;
    frmSaveDICOM.edtSrcImageFile.Hint := sFN;
    frmSaveDICOM.edtSrcImageFile.ShowHint := True;
  end
  else
  begin
    frmSaveDICOM.edtSrcImageFile.Text := '';
    frmSaveDICOM.edtSrcImageFile.Hint := '';
    frmSaveDICOM.edtSrcImageFile.ShowHint := False;
  end;
  frmAddImageFile.Close;
end;

end.

⌨️ 快捷键说明

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