unit1.pas

Dicom Delphi code 看DICOM图像

procedure TForm1.N23Click(Sender: TObject);
begin
  N23.Checked:=Not N23.Checked;
  if N23.Checked then
    DICOMX1.ImageOverlayOn := True
  else
    DICOMX1.ImageOverlayOn := False;
end;

procedure TForm1.N15Click(Sender: TObject);
begin
  frmWC.Edit2.Text:=FloatToStr(DICOMX1.ImageWinCenter);
  frmWC.Edit1.Text:=FloatToStr(DICOMX1.ImageWinWidth);
  frmWC.ShowModal;
end;

procedure TForm1.N40Click(Sender: TObject);
begin
  //Stop
  if tmrPlaySlice.Enabled then
    N43.Click;
  //Cancel
  if N47.Checked=False then
    N47.Click;
  if (DICOMX1.ImageSlicesCurrent - 1) < 1 then
    DICOMX1.ImageSlicesCurrent := DICOMX1.ImageSlicesTotal
  else
    DICOMX1.ImageSlicesCurrent := DICOMX1.ImageSlicesCurrent - 1;
end;

procedure TForm1.N41Click(Sender: TObject);
begin
  //Stop Play
  if tmrPlaySlice.Enabled then
    N43.Click;
  //Cancel Mosaic
  if N47.Checked=False then
    N47.Click;
  if DICOMX1.ImageSlicesCurrent < DICOMX1.ImageSlicesTotal then
    DICOMX1.ImageSlicesCurrent := DICOMX1.ImageSlicesCurrent + 1
  else
    DICOMX1.ImageSlicesCurrent := 1;
end;

procedure TForm1.N48Click(Sender: TObject);
begin
  N48.Checked:=Not N48.Checked;
  if N48.Checked then
    DICOMX1.ToolBarVisible:=False
  else
    DICOMX1.ToolBarVisible:=True;
end;

procedure TForm1.DICOM2Click(Sender: TObject);
begin
  DICOM2.Checked:=Not DICOM2.Checked;
  if DICOM2.Checked then
    DICOMX1.ImageShowHeaderInfo := True
  else
    DICOMX1.ImageShowHeaderInfo := False;
end;

procedure TForm1.DICOM3Click(Sender: TObject);
begin
  SaveDialog1.Filter:='DICOM File(*.DCM)|*.DCM';
  if SaveDialog1.Execute then
  begin
    frmSaveDICOM.btnAddFile.Enabled := True;
    frmSaveDICOM.edtSrcImageFile.Text := '';
    frmSaveDICOM.edtSaveFileName.Text := SaveDialog1.FileName;
    //Initial Default Value
    InitialDInfoSaveValue;
    //Show Save Dialog
    frmSaveDICOM.ShowModal;
  end;
end;

procedure TForm1.N53Click(Sender: TObject);
begin
  //uses AxCtrls, ActiveX
  frmStreamImage.Image1.Picture.Assign(nil);

  SetOlePicture(frmStreamImage.Image1.Picture, DICOMX1.ImageBMPStream as IPictureDisp);
  frmStreamImage.Image1.Width:=frmStreamImage.Image1.Picture.Width;
  frmStreamImage.Image1.Height:=frmStreamImage.Image1.Picture.Height;
  frmStreamImage.Caption := IntToStr(frmStreamImage.Image1.Picture.Width)+' x '+IntToStr(frmStreamImage.Image1.Picture.Height);

  if (frmStreamImage.Width <> frmStreamImage.Image1.Width + 8) then
  begin
    frmStreamImage.Width := frmStreamImage.Image1.Width + 8;
    frmStreamImage.Height := frmStreamImage.Image1.Height + 17;
  end;
  frmStreamImage.Show;
end;

procedure TForm1.DICOM4Click(Sender: TObject);
var
  i : Integer;
begin

    if DICOMX1.ImageSlicesTotal<2 then
      Exit;

    SaveDialog1.Filter:='BMP File(*.BMP)|*.BMP|JPEG File(*.JPG)|*.JPG';
    if SaveDialog1.Execute then
    begin
      if SaveDialog1.FileName<>'' then
      begin
        if UpperCase(RightStr(SaveDialog1.FileName,4))='.BMP' then
        begin
          for i := 1 to DICOMX1.ImageSlicesTotal do
          begin
            DICOMX1.ImageSlicesCurrent := i;
            DICOMX1.ImageSaveToFile :=LeftStr(SaveDialog1.FileName,Length(SaveDialog1.FileName)-4)+ '.'+RightStr('00'+IntToStr(i),3)+'.BMP';
          end;
        end
        else
        begin
          if UpperCase(RightStr(SaveDialog1.FileName,4))='.JPG' then
          begin
            for i := 1 to DICOMX1.ImageSlicesTotal do
            begin
              DICOMX1.ImageSlicesCurrent := i;
              DICOMX1.ImageSaveToFile:=LeftStr(SaveDialog1.FileName,Length(SaveDialog1.FileName)-4)+ '.'+RightStr('00'+IntToStr(i),3)+'.JPG';
            end;
          end;
        end;
      end;
    end;
end;

procedure TForm1.N72Click(Sender: TObject);
begin
  Form4.Edit1.Text:=IntToStr(DICOMX1.ImageWidth);
  Form4.Edit2.Text:=IntToStr(DICOMX1.ImageHeight);
  Form4.ShowModal;
end;

procedure TForm1.DICOM6Click(Sender: TObject);
begin
  SaveDialog1.Filter:='AVI File(*.AVI)|*.AVI';
  if SaveDialog1.Execute then
  begin
    //Useage : DCMSaveToAVI(AVIFileName, StartFrame, EndFrame, FPS[1-30])
    if DICOMX1.ImageSaveToAVI(SaveDialog1.FileName, 1, DICOMX1.ImageSlicesTotal, 5) = True then
      Showmessage('Convert to AVI File ok !');
  end;
end;

procedure TForm1.N80Click(Sender: TObject);
begin
  DICOMX1.ImageCopyImageToClipboard;
end;

procedure TForm1.N110Click(Sender: TObject);
begin
  //MaxItem=99
  DICOMX1.ImageMeasureMaxItem := DICOMX1.ImageMeasureMaxItem + 1;
end;

procedure TForm1.N111Click(Sender: TObject);
begin
  //MaxItem=99
  DICOMX1.ImageMeasureMaxItem := DICOMX1.ImageMeasureMaxItem - 1;
end;

procedure TForm1.N100Click(Sender: TObject);
begin
  Showmessage('Measure Items = [' + IntToStr(DICOMX1.ImageMeasureMaxItem) + ']');
end;

procedure TForm1.N109Click(Sender: TObject);
begin
  DICOMX1.ImageMeasureFontSize := 12;
end;

procedure TForm1.N112Click(Sender: TObject);
begin
  DICOMX1.ImageMeasureTextFontSize := 14;
end;

procedure TForm1.N85Click(Sender: TObject);
begin
  DICOMX1.DICOMPixelSpaceWidth := 0.5;
  DICOMX1.DICOMPixelSpaceHeight := 0.5;
  //Refresh Preview
  DICOMX1.ImageMeasureMaxItem := DICOMX1.ImageMeasureMaxItem;
end;

procedure TForm1.N86Click(Sender: TObject);
var
  i : Integer;
  s : String;
begin
  s := '';
  for i := 1 to DICOMX1.ImageMeasureMaxItem do
  begin
    DICOMX1.ImageMeasureResultIndex := i;
    if DICOMX1.ImageMeasureResultValue<>0 then
    begin
      showmessage(IntToStr(i) + '=' + FloatToStr(DICOMX1.ImageMeasureResultValue) + DICOMX1.ImageMeasureResultUnit);
    end;
  end;
end;

procedure TForm1.DICOMDirR1Click(Sender: TObject);
begin
  frmDICOMDir.ShowModal;
end;

procedure TForm1.N114Click(Sender: TObject);
begin
  DICOMX1.FreeMemory;
  //Disable MultiSlice Function
  EnableMultiSlice(False);  
end;

procedure TForm1.N113Click(Sender: TObject);
begin
  if DICOMX1.ToolBarVisible=True then
  begin
    if DICOMX1.ToolBarPos=1 then
      DICOMX1.ToolBarPos:=2
    else
      DICOMX1.ToolBarPos:=1;
  end;
end;

procedure TForm1.N115Click(Sender: TObject);
var
  i : Integer;
begin
  for i := 1 to DICOMX1.ImageMeasureMaxItem do
  begin
    DICOMX1.ImageMeasureSelectIndex := i;
    if DICOMX1.ImageMeasureSelectIndex=i then
    begin
      DICOMX1.ImageMeasureResultIndex := i;
      if DICOMX1.ImageMeasureResultValue<>0 then
        showmessage('Selected=['+IntToStr(i)+'],Press [Delete] key to delete item!'+
          chr(13)+chr(13)+IntToStr(i) + '=' + FloatToStr(DICOMX1.ImageMeasureResultValue) + DICOMX1.ImageMeasureResultUnit)
      else
        showmessage('Selected=['+IntToStr(i)+'],Press [Delete] key to delete item!');
      exit;
    end;
  end;
  showmessage('No Measure item in preview!');
end;

procedure TForm1.DICOMC1Click(Sender: TObject);
var
  iCount : Integer;
begin
  if tmrPlaySlice.Enabled then
    N43.Click;
  OpenDialog1.Filter:='All Files(*.*)|*.*|DICOM Files(*.dcm)|*.dcm';
  if OpenDialog1.Execute then
  begin
    DICOMX1.OpenFileNameByMultiple:=OpenDialog1.FileName;
    iCount := DICOMX1.ImageSlicesTotal;
    if iCount > 1 then
      EnableMultiSlice(True)
    else
      EnableMultiSlice(False);
    if iCount > 1 then
    begin
      Case DICOMX1.ImageSlicesTotal of
        2, 3, 4:
          DICOMX1.ImageMosaicX(2, 2, 1, iCount);

        5, 6:
          DICOMX1.ImageMosaicX(2, 3, 1, iCount);

        7, 8, 9:
          DICOMX1.ImageMosaicX(3, 3, 1, iCount);

        else
          DICOMX1.ImageMosaicX(3, 4, 1, iCount);

      end;
      N47.Checked := False;
    end;
  end;

end;

procedure TForm1.FormShow(Sender: TObject);
begin
  //MeasureMent Setting
  DICOMX1.ImageMeasureTextFontColor := giMSATextColor;
  DICOMX1.ImageMeasureFontColor := giMSRTextColor;
  DICOMX1.ImageMeasureLineColor := giMSLineColor;
  DICOMX1.ImageMeasureTextFontSize := giMSATextSize;
  DICOMX1.ImageMeasureFontSize := giMSRTextSize;
  //Language
  N118.Click;
end;

procedure TForm1.ShowRuler1Click(Sender: TObject);
begin
  ShowRuler1.Checked := Not ShowRuler1.Checked;
  DICOMX1.ImageOverlayShowRuler := Showruler1.Checked;
  if Showruler1.Checked then
    giOverlayShowRuler := 1
  else
    giOverlayShowRuler := 0;
end;

procedure TForm1.pnlMainResize(Sender: TObject);
begin
  if N18.Checked = True then
    DICOMX1.ImageZoomBestFit := True
  else
    DICOMX1.ImageZoomPct := DICOMX1.ImageZoomPct;
end;

procedure TForm1.ToolButton36Click(Sender: TObject);
begin
  if DICOMX1.ImageShowHeaderInfo then
    DICOMX1.ImageCopyHeaderToClipboard
  else
    DICOMX1.ImageCopyImageToClipboard;
end;

procedure TForm1.ToolButton23Click(Sender: TObject);
begin
  //Invert
  N66.Checked:=Not N66.Checked;
  if N66.Checked then
    DICOMX1.ImageColorScheme := 0 - Abs(DICOMX1.ImageColorScheme)
  else
    DICOMX1.ImageColorScheme := Abs(DICOMX1.ImageColorScheme);
end;

procedure TForm1.ToolButton31Click(Sender: TObject);
begin
  Randomize;
  if N66.Checked then
    DICOMX1.ImageColorScheme := 0-Trunc(1+Random(16))
  else
    DICOMX1.ImageColorScheme := Trunc(1+Random(16));
end;

procedure TForm1.ToolButton13Click(Sender: TObject);
begin
  MenuZoomIMGClick(Fit1);
end;

procedure TForm1.ToolButton9Click(Sender: TObject);
begin
  if Stop1.Checked then
    MenuPlaySliceClick(N10FPS2)
  else
    MenuPlaySliceClick(Stop1);
end;

procedure TForm1.ToolButton58Click(Sender: TObject);
begin
  if Cancel1.Checked then
    MenuFlipSliceClick(N2X32)
  else
    MenuFlipSliceClick(Cancel1);
end;

procedure TForm1.AboutApplication1Click(Sender: TObject);
begin
  frmAbout.ShowModal;
end;

procedure TForm1.DICOMX1DCMmouseMove(ASender: TObject; X, Y, Button, Shift: Integer);
begin
  if (Button=1) then
  begin
    Case DICOMX1.ImageTool of
      1:
        StatusBar1.Panels[1].Text := 'Window: '+IntToStr(Trunc(DICOMX1.ImageWinWidth))+', Level: '+IntToStr(Trunc(DICOMX1.ImageWinCenter));

      5..7,9..14:
        if DICOMX1.ImageMeasureSelectIndex>0 then
        begin
          DICOMX1.ImageMeasureResultIndex := DICOMX1.ImageMeasureSelectIndex;
          StatusBar1.Panels[2].Text := '['+IntToStr(DICOMX1.ImageMeasureSelectIndex)+']='+FloatToStrF(DICOMX1.ImageMeasureResultValue,ffFixed,4,1)+DICOMX1.ImageMeasureResultUnit;
        end;
    end;
  end;
end;

procedure TForm1.ToolButton24Click(Sender: TObject);
begin
  DICOMX1.ImageReset;
end;

procedure TForm1.DICOMX1DCMmouseUp(ASender: TObject; X, Y, Button, Shift: Integer);
begin
  if (Button=1) and (DICOMX1.ImageTool=2) then
  begin
    StatusBar1.Panels[1].Text := 'Window: '+IntToStr(Trunc(DICOMX1.ImageWinWidth))+', Level: '+IntToStr(Trunc(DICOMX1.ImageWinCenter));
  end;
end;

procedure TForm1.ToolButton18Click(Sender: TObject);
begin
  frmSetting.ShowModal;
end;

procedure TForm1.DICOMA2Click(Sender: TObject);
begin
  if DICOMX1.OpenFileName<>'' then
  begin
    SaveDialog1.Filter:='DICOM File(*.DCM)|*.DCM';
    if SaveDialog1.Execute then
    begin
      OpenDialog1.FileName := '';
      frmSaveDICOM.btnAddFile.Enabled := False;
      frmSaveDICOM.edtSrcImageFile.Text := DICOMX1.OpenFileName;
      frmSaveDICOM.edtSaveFileName.Text := SaveDialog1.FileName;
      //Initial Default Value
      InitialDInfoSaveValue;
      //Show Save Dialog
      frmSaveDICOM.ShowModal;
    end;
  end
  else
    Showmessage('No File Opened, Can not save DICOM File!');
end;

procedure TForm1.BMPJPGDICOM1Click(Sender: TObject);
begin
    OpenDialog1.DefaultExt := '*';
    OpenDialog1.Title := 'Open BMP/JPEG File';
    OpenDialog1.Filter := 'Bitmap File(*.bmp)|*.bmp|JPEG File(*.jpg)|*.jpg';
    if OpenDialog1.Execute then
    begin
      if FileExists(OpenDialog1.FileName) then
      begin
        SaveDialog1.Filter:='DICOM File(*.DCM)|*.DCM';
        if SaveDialog1.Execute then
        begin
          frmSaveDICOM.btnAddFile.Enabled := False;
          frmSaveDICOM.edtSrcImageFile.Text := OpenDialog1.FileName;
          frmSaveDICOM.edtSaveFileName.Text := SaveDialog1.FileName;
          //Initial Default Value
          InitialDInfoSaveValue;
          //Show Save Dialog
          frmSaveDICOM.ShowModal;
        end;
      end;
    end;
end;

procedure TForm1.WindowingPreset1Click(Sender: TObject);
begin
  frmWindowingPreset.ShowModal;
end;

procedure TForm1.ToolButton21Click(Sender: TObject);
begin
  if Form1.borderstyle<>bsnone then
  begin
    with Form1 do
    begin
      DICOMX1.PopupMenu := pmExitFS;

      Form1.Menu := nil;
      StatusBar1.Visible := False;
      CoolBar1.Visible := False;
      CoolBar1.Bands[0].Visible := False;
      CoolBar1.Bands[1].Visible := False;
      CoolBar1.Bands[2].Visible := False;
      CoolBar2.Visible := False;

      giFormPrvLeft := Left;
      giFormPrvTop := Top;
      giFormPrvWidth := Width;
      giFormPrvHeight := Height;

      borderstyle := bsnone;
      left := 0;
      top := 0;
      width := screen.width;
      height := screen.height;
    end;
  end
  else
  begin
    with Form1 do
    begin
      borderstyle := bsSizeable;

      ShowMainToolBar1.Checked := False;
      ShowOToolBar1.Checked := False;
      ShowCineToolBar1.Checked := False;
      ShowMeasureMentToolBar1.Checked := False;

      DICOMX1.PopupMenu := nil;
      Form1.Menu := MainMenu1;
      StatusBar1.Visible := True;
      psMain.Visible := True;
      CoolBar1.Visible := True;
      CoolBar1.Bands[0].Visible := True;
      CoolBar1.Bands[1].Visible := True;
      CoolBar1.Bands[2].Visible := True;
      CoolBar2.Visible := True;

      Left := giFormPrvLeft;
      Top := giFormPrvTop;
      Width := giFormPrvWidth;
      Height := giFormPrvHeight;
    end;
  end;
end;

procedure TForm1.ExitFullScreenMode1Click(Sender: TObject);
begin
  ToolButton21.Click;
end;

end.