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

📄 unit1.pas

📁 Dicom Delphi code 看DICOM图像
💻 PAS
📖 第 1 页 / 共 4 页
字号:
  //Mouse Scroll
  if giEnableMouseWheel=1 then
    MenuMScrollClick(EnableScrollforMultiSlice1)
  else
    MenuMScrollClick(DisableScrollforMultiSlice1);

  //Smooth Image
  if giEnableSmooth=1 then
    N22.Checked := False
  else
    N22.Checked := True;
  N22.Click;

  //Magnifycation Radious
  Case giMagRadious of
    4:
      MenuDICOMMRatioClick(N4X1);
    6:
      MenuDICOMMRatioClick(N6X1);
    else
      MenuDICOMMRatioClick(N2X1);
  end;

  //Magnifycation Size
  Case giMagSize of
    80:
      MenuDICOMMSizeClick(M80);
    100:
      MenuDICOMMSizeClick(M100);
    120:
      MenuDICOMMSizeClick(M120);
    else
      MenuDICOMMSizeClick(M60);
  end;

  //OCX Language
  if giOCXLanguage=0 then
    MenuOCXLanguageClick(N117)
  else
    MenuOCXLanguageClick(N118);

  //Overlay Language
  if giOverlayLanguage=0 then
    MenuOverlayLanguageClick(N59)
  else
    MenuOverlayLanguageClick(N58);

  //Overlay Color
  if giOverlayColor=0 then
    MenuOverlayColorClick(N60)
  else
    MenuOverlayColorClick(N61);

  //Overlay Show Ruler
  if giOverlayShowRuler=0 then
    ShowRuler1.Checked := True
  else
    ShowRuler1.Checked := False;
  ShowRuler1.Click;

  DICOMX1.ImageMeasureTextFontColor := giMSATextColor;
  DICOMX1.ImageMeasureFontColor := giMSRTextColor;
  DICOMX1.ImageMeasureLineColor := giMSLineColor;
  DICOMX1.ImageMeasureTextFontSize := giMSATextSize;
  DICOMX1.ImageMeasureFontSize := giMSRTextSize;

  RefreshPreview;
end;


procedure TForm1.ReadIniSetting;
var
  Ini: TIniFile;
begin
  //读取设置文件
  Ini := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'Setting.cfg');
  try
//    giShowOverlay := Ini.ReadInteger('General', 'ShowOverlay', 1);
//    giImageZoom := Ini.ReadInteger('General', 'ImageZoom', 1);
//    giImageTool := Ini.ReadInteger('General', 'ImageTool', 1);
    giAssociateFile := Ini.ReadInteger('General', 'AssociateFile', 0);
    giEnableErrorReport := Ini.ReadInteger('General', 'ErrorReport', 1);
    giEnableMouseWheel := Ini.ReadInteger('General', 'MouseScroll', 1);
    giEnableSmooth := Ini.ReadInteger('General', 'SmoothImage', 1);
    giMagRadious := Ini.ReadInteger('General', 'MagRadious', 2);
    giMagSize := Ini.ReadInteger('General', 'MagSize', 60);
    giOCXLanguage := Ini.ReadInteger('General', 'OCXLanguage', 1);
    giOverlayLanguage := Ini.ReadInteger('General', 'OverlayLanguage', 0);
    giOverlayColor := Ini.ReadInteger('General', 'OverlayColor', 1);
    giOverlayShowRuler := Ini.ReadInteger('General', 'OverlayRuler', 1);
    giMSItemCount := Ini.ReadInteger('Measurement', 'ItemCount', 8);
    giMSATextColor := Ini.ReadInteger('Measurement', 'AnnotationTextColor', 1);
    giMSATextSize := Ini.ReadInteger('Measurement', 'AnnotationTextSize', 8);
    giMSRTextColor := Ini.ReadInteger('Measurement', 'ResultTextColor', 1);
    giMSRTextSize := Ini.ReadInteger('Measurement', 'ResultTextSize', 8);
    giMSLineColor := Ini.ReadInteger('Measurement', 'LineColor', 1);
  finally
    Ini.Free;
  end;
end;

procedure TForm1.EnableMultiSlice(Value : Boolean);
begin
  M1.Enabled := Value;
  ToolButton58.Enabled := Value;
  ToolButton8.Enabled := Value;
  ToolButton9.Enabled := Value;
  ToolButton10.Enabled := Value;
end;

procedure TForm1.MenuMScrollClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;
  if iTag = 1 then
  begin
    EnableScrollforMultiSlice1.Checked := True;
    DisableScrollforMultiSlice1.Checked := False;
    DICOMX1.EnableMouseScroll := True;
    giEnableMouseWheel := 1;
  end
  else
  begin
    EnableScrollforMultiSlice1.Checked := False;
    DisableScrollforMultiSlice1.Checked := True;
    DICOMX1.EnableMouseScroll := False;
    giEnableMouseWheel := 0;
  end;
end;

procedure TForm1.MenuToolBarClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;
  (Sender as TMenuItem).Checked := Not (Sender as TMenuItem).Checked;
  Case iTag of
    1:
      psMain.Visible := (Sender as TMenuItem).Checked;

    2:
      tbOrientation.Visible := (Sender as TMenuItem).Checked;

    3:
      tbMultiSlice.Visible := (Sender as TMenuItem).Checked;

    4:
    begin
      tbMeasurement.Visible := (Sender as TMenuItem).Checked;
      CoolBar2.Visible := tbMeasurement.Visible;
    end;
  end;

  if (psMain.Visible=False) and (tbMultiSlice.Visible=False) and (tbOrientation.Visible=False) then
    CoolBar1.Visible := False
  else
  begin
    if CoolBar1.Visible = False then
      CoolBar1.Visible := True;
  end;

end;

procedure TForm1.MenuOCXLanguageClick(Sender: TObject);
begin
  if (Sender as TMenuItem).Tag=1 then
  begin
    N117.Checked := False;
    N118.Checked := True;
    DICOMX1.OCXLanguage := 1;
    giOCXLanguage := 1;
  end
  else
  begin
    N117.Checked := True;
    N118.Checked := False;
    DICOMX1.OCXLanguage := 0;
    giOCXLanguage := 0;
  end;
end;    

procedure TForm1.IMeasureColorClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;

  //Text Color
  if (iTag>100) and (iTag<200) then
  begin
    N102.Checked := False;
    N103.Checked := False;
    N104.Checked := False;
    N105.Checked := False;
    N106.Checked := False;
    N107.Checked := False;
    iTag := iTag mod 100;
    if (iTag>0) and (iTag<7) then
    begin
      //1=Red, 2=Green ,3=Blue ,4=Yellow ,5=Black ,6=White
      DICOMX1.ImageMeasureTextFontColor := iTag;
      (Sender as TMenuItem).Checked := True;
    end;
  end;

  //Line Color
  if (iTag>200) and (iTag<300) then
  begin
    N87.Checked := False;
    N88.Checked := False;
    N89.Checked := False;
    N90.Checked := False;
    N91.Checked := False;
    N92.Checked := False;
    iTag := iTag mod 100;
    if (iTag>0) and (iTag<7) then
    begin
      //1=Red, 2=Green ,3=Blue ,4=Yellow ,5=Black ,6=White
      DICOMX1.ImageMeasureLineColor := iTag;
      (Sender as TMenuItem).Checked := True;
    end;
  end;

  //Result Text Color
  if (iTag>300) and (iTag<400) then
  begin
    N93.Checked := False;
    N94.Checked := False;
    N95.Checked := False;
    N96.Checked := False;
    N97.Checked := False;
    N98.Checked := False;
    iTag := iTag mod 100;
    if (iTag>0) and (iTag<7) then
    begin
      //1=Red, 2=Green ,3=Blue ,4=Yellow ,5=Black ,6=White
      DICOMX1.ImageMeasureFontColor := iTag;
      (Sender as TMenuItem).Checked := True;
    end;
  end;
end;

procedure TForm1.MenuLUTClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;

  //Gray=1, Internal LUT=2..16
  if (iTag>0) and (iTag<20) then
  begin
    if N66.Checked then
      DICOMX1.ImageColorScheme := 0-iTag
    else
      DICOMX1.ImageColorScheme := iTag;
  end
  else
  begin
    if iTag=20 then
    begin
      //Invert
      N66.Checked:=Not N66.Checked;
      if N66.Checked then
        DICOMX1.ImageColorScheme := 0 - Abs(DICOMX1.ImageColorScheme)
      else
        DICOMX1.ImageColorScheme := Abs(DICOMX1.ImageColorScheme);
    end
    else
    begin
      //Load LookUpTable from file
      OpenDialog1.Filter:='LUT File[Look Up Table](*.lut)|*.lut';
      if OpenDialog1.Execute then
        DICOMX1.ImageColorSchemeFile:=OpenDialog1.FileName;
    end;
  end;
end;

procedure TForm1.MenuZoomIMGClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;
  UnCheckImageZoom;
  if (iTag>0) and (iTag<999) then
  begin
    case iTag of
       50:
       begin
        DICOMX1.ImageZoomBestFit:=False;
        DICOMX1.ImageZoomPct := iTag;
        N501.Checked:=True;
        N502.Checked:=True;
       end;

       100:
       begin
        DICOMX1.ImageZoomBestFit:=False;
        DICOMX1.ImageZoomPct := iTag;
        N1001.Checked:=True;
        N1002.Checked:=True;
       end;

       150:
       begin
        DICOMX1.ImageZoomBestFit:=False;
        DICOMX1.ImageZoomPct := iTag;
        N1501.Checked:=True;
        N1502.Checked:=True;
       end;

       200:
       begin
        DICOMX1.ImageZoomBestFit:=False;
        DICOMX1.ImageZoomPct := iTag;
        N2001.Checked:=True;
        N2002.Checked:=True;
       end;

       400:
       begin
        DICOMX1.ImageZoomBestFit:=False;
        DICOMX1.ImageZoomPct := iTag;
        N4001.Checked:=True;
        N4002.Checked:=True;
       end;
    end;
  end
  else
  begin
    if iTag=0 then
    begin
      DICOMX1.ImageZoomBestFit:=True;
      Fit1.Checked := True;
      N18.Checked := True;
    end
    else
    begin
      DICOMX1.ImageZoomBestFit:=False;
      //Pecentage, value=(10-500)
      DICOMX1.ImageZoomPct := 333;
      N20.Checked := True;
    end;
  end;
end;

procedure TForm1.MenuOverlayLanguageClick(Sender: TObject);
begin
  if (Sender as TMenuItem).Tag=0 then
  begin
    N58.Checked:=False;
    N59.Checked:=True;
    //Overlay Language 0=English,1=CHS
    DICOMX1.ImageOverlayLanguage:=0;
    giOverlayLanguage := 0;
  end
  else
  begin
    N58.Checked:=True;
    N59.Checked:=False;
    //Overlay Language 0=English,1=CHS
    DICOMX1.ImageOverlayLanguage:=1;
    giOverlayLanguage := 1;
  end;
end;

procedure TForm1.MenuOverlayColorClick(Sender: TObject);
begin
  if (Sender as TMenuItem).Tag=0 then
  begin
    N60.Checked:=True;
    N61.Checked:=False;
    //Overlay Color 0=Black,1=White
    DICOMX1.ImageOverlayColor:=0;
    giOverlayColor := 0;
  end
  else
  begin
    N60.Checked:=False;
    N61.Checked:=True;
    //Overlay Color 0=Black,1=White
    DICOMX1.ImageOverlayColor:=1;
    giOverlayColor := 1;
  end;
end;

procedure TForm1.ToolBtnRotateClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TToolButton).Tag;
  case iTag of
    1:
      DICOMX1.ImageProcessRotate := 270;
    2:
      DICOMX1.ImageProcessRotate := 90;
    3:
      DICOMX1.ImageProcessFlipHorzontal := True;
    4:
      DICOMX1.ImageProcessFlipVertical := True;
  end;
end;

procedure TForm1.MenuRotateClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;
  case iTag of
    1:
      DICOMX1.ImageProcessRotate := 270;
    2:
      DICOMX1.ImageProcessRotate := 90;
    3:
      DICOMX1.ImageProcessFlipHorzontal := True;
    4:
      DICOMX1.ImageProcessFlipVertical := True;
  end;
end;

procedure TForm1.MenuProcessIMGClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;
  case iTag of
    1:
      DICOMX1.ImageProcessSharpen := True;
    2:
      DICOMX1.ImageProcessBlur := True;
    3:
      DICOMX1.ImageProcessFilter := True;
    4:
      DICOMX1.ImageProcessEmboss := True;
    5:
      DICOMX1.ImageProcessInvert := True;
  end;
end;


procedure TForm1.MenuFlipSliceClick(Sender: TObject);
var
  iTag : Integer;
begin
  if DICOMX1.ImageSlicesTotal<2 then
    Exit;
  iTag := (Sender as TMenuItem).Tag;
  UnCheckSliceFlip;
  //Useage: DCMmosaicX(a, b, c, d),a=Rows,b=Cols,c=Start Frame,d=End Frame
  if iTag>10 then
  begin
    //Stop Play Cine
    N43.Click;
    //iTag div 10 = a , iTag mod 10 = b
    DICOMX1.ImageMosaicX(iTag div 10, iTag mod 10, 1, DICOMX1.ImageSlicesTotal);
  end
  else
  begin
    if iTag=1 then
    begin
      //Stop Play Cine
      N43.Click;
      //User Defined
      //Useage: DCMmosaicX(a, b, c, d),a=Rows,b=Cols,c=Start Frame,d=End Frame
      DICOMX1.ImageMosaicX(2, 2, 2, 2 - 1 + 4);
    end
    else
    begin
      //Cancel Mosaic
      DICOMX1.ImageMosaicX(1, 1, 1, 1);
    end;
  end;
  Case iTag of
    22:
    begin
      N2X21.Checked:=True;
      N2X22.Checked:=True;
    end;
    23:
    begin
      N2X31.Checked:=True;
      N2X32.Checked:=True;
    end;
    33:
    begin
      N3X31.Checked:=True;
      N3X32.Checked:=True;
    end;
    34:
    begin
      N3X41.Checked:=True;
      N3X42.Checked:=True;
    end;
    44:
    begin
      N4X41.Checked:=True;
      N4X42.Checked:=True;
    end;
    1:
    begin
      N45.Checked:=True;
      UserDefine1.Checked:=True;
    end;
    0:
    begin
      N47.Checked:=True;
      Cancel1.Checked:=True;
    end;
  end;
end;

procedure TForm1.MenuPlaySliceClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;

  UnCheckSlicePlay;
  if (iTag<30) and (iTag>0) then
  begin
    //Cancel
    N47.Click;
    //Play

⌨️ 快捷键说明

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