unit1.pas

Dicom Delphi code 看DICOM图像

    tmrPlaySlice.Interval := 1000 div iTag;
    tmrPlaySlice.Enabled := True;
  end
  else
    tmrPlaySlice.Enabled := False;
  Case iTag of
    1:
    begin
      N1FPS1.Checked:=True;
      N1FPS2.Checked:=True;
    end;
    2:
    begin
      N2FPS1.Checked:=True;
      N2FPS2.Checked:=True;
    end;
    5:
    begin
      N5FPS1.Checked:=True;
      N5FPS2.Checked:=True;
    end;
    10:
    begin
      N10FPS1.Checked:=True;
      N10FPS2.Checked:=True;
    end;
    15:
    begin
      N15FPS1.Checked:=True;
      N15FPS2.Checked:=True;
    end;
    20:
    begin
      N20FPS1.Checked:=True;
      N20FPS2.Checked:=True;
    end;
    100:
    begin
      Stop1.Checked:=True;
      N43.Checked:=True;
    end;
  end;
end;

procedure TForm1.MenuDICOMSEClick(Sender: TObject);
begin
  N62.Checked:=False;
  N63.Checked:=False;
  if (Sender as TMenuItem).Tag=0 then
  begin
    DICOMX1.SilentError := True;
    N63.Checked:=True;
    giEnableErrorReport := 0;
  end
  else
  begin
    DICOMX1.SilentError := False;
    N62.Checked:=True;
    giEnableErrorReport := 1;
  end;
end;

procedure TForm1.MenuDICOMMSizeClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;
  M60.Checked := False;
  M80.Checked := False;
  M100.Checked := False;
  M120.Checked := False;
  //Magnify Size=(60..200)
  if  (iTag=60) or (iTag=80) or (iTag=100) or (iTag=120) then
  begin
    DICOMX1.ImageMagnifySize := iTag;
    (Sender as TMenuItem).Checked := True;
    giMagSize := iTag;
  end;
end;

procedure TForm1.MenuDICOMMRatioClick(Sender: TObject);
var
  iTag : Integer;
begin
  iTag := (Sender as TMenuItem).Tag;
  N2X1.Checked := False;
  N4X1.Checked := False;
  N6X1.Checked := False;
  //Magnify Value=(2..10)
  if  (iTag=2) or (iTag=4) or (iTag=6) then
  begin
    DICOMX1.ImageMagnifyZoomSize := iTag;
    (Sender as TMenuItem).Checked := True;
    giMagRadious := iTag;
  end;
end;

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

  if (iTag>200) and (iTag<214) then
  begin
    UnCheckImageTool;
  end;

  Case iTag of
    201:
    begin
      //Window/Level
      DICOMX1.ImageTool := 1;
      N3.Checked := True;
    end;

    202:
    begin
      //Window/Level Selected Area
      DICOMX1.ImageTool := 2;
      N4.Checked := True;
    end;

    203:
    begin
      //Magnify
      DICOMX1.ImageTool := 3;
      N5.Checked := True;
    end;

    204:
    begin
      //Pan
      DICOMX1.ImageTool := 4;
      N6.Checked := True;
    end;

    205:
    begin
      //Arrow
      DICOMX1.ImageTool := 10;
      N8.Checked := True;
    end;

    206:
    begin
      //Text
      DICOMX1.ImageMeasureTextPreSet := 'User Defined Text';
      DICOMX1.ImageTool := 11;
      N9.Checked := True;
    end;

    207:
    begin
      //Line
      DICOMX1.ImageTool := 5;
      N10.Checked := True;
    end;

    208:
    begin
      //Rectangle Area
      DICOMX1.ImageTool := 6;
      N11.Checked := True;
    end;

    209:
    begin
      //Rectangle Grith
      DICOMX1.ImageTool := 12;
      N74.Checked := True;
    end;

    210:
    begin
      //Ellipse Area
      DICOMX1.ImageTool := 7;
      N12.Checked := True;
    end;

    211:
    begin
      //Ellipse Grith
      DICOMX1.ImageTool := 13;
      N75.Checked := True;
    end;

    212:
    begin
      //Angle
      DICOMX1.ImageTool := 9;
      N14.Checked := True;
    end;

    213:
    begin
      //Select Measure Item
      DICOMX1.ImageTool := 14;
      N76.Checked := True;
    end;

    214:
    begin
      //Delete Selected Measure Item
      DICOMX1.ImageMeasureDeleteCurrentItem := True;
      N78.Checked := True;
    end;

    215:
    begin
      //Delete All Measure Item
      DICOMX1.ImageMeasureDeleteAllItem := True;
      N79.Checked := True;
    end;
  end;
end;

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

  if (iTag>200) and (iTag<214) then
  begin
    UnCheckImageTool;
    (Sender as TMenuItem).Checked := True;
  end;
  Case iTag of
    201:
    begin
      //Window/Level
      DICOMX1.ImageTool := 1;
    end;

    202:
    begin
      //Window/Level Selected Area
      DICOMX1.ImageTool := 2;
    end;

    203:
    begin
      //Magnify
      DICOMX1.ImageTool := 3;
    end;

    204:
    begin
      //Pan
      DICOMX1.ImageTool := 4;
    end;

    205:
    begin
      //Arrow
      DICOMX1.ImageTool := 10;
    end;

    206:
    begin
      //Text
      DICOMX1.ImageMeasureTextPreSet := 'User Defined Text';
      DICOMX1.ImageTool := 11;
    end;

    207:
    begin
      //Line
      DICOMX1.ImageTool := 5;
    end;

    208:
    begin
      //Rectangle Area
      DICOMX1.ImageTool := 6;
    end;

    209:
    begin
      //Rectangle Grith
      DICOMX1.ImageTool := 12;
    end;

    210:
    begin
      //Ellipse Area
      DICOMX1.ImageTool := 7;
    end;

    211:
    begin
      //Ellipse Grith
      DICOMX1.ImageTool := 13;
    end;

    212:
    begin
      //Angle
      DICOMX1.ImageTool := 9;
    end;

    213:
    begin
      //Select Measure Item
      DICOMX1.ImageTool := 14;
    end;

    214:
    begin
      //Delete Selected Measure Item
      DICOMX1.ImageMeasureDeleteCurrentItem := True;
    end;

    215:
    begin
      //Delete All Measure Item
      DICOMX1.ImageMeasureDeleteAllItem := True;
    end;
  end;
end;

procedure TForm1.UnCheckSliceFlip;
begin
  //Main Menu
  N2X21.Checked:=False;
  N2X31.Checked:=False;
  N3X31.Checked:=False;
  N3X41.Checked:=False;
  N4X41.Checked:=False;
  N45.Checked:=False;
  N47.Checked:=False;
  //Popup Menu
  N2X22.Checked:=False;
  N2X32.Checked:=False;
  N3X32.Checked:=False;
  N3X42.Checked:=False;
  N4X42.Checked:=False;
  UserDefine1.Checked:=False;
  Cancel1.Checked:=False;
end;

procedure TForm1.UnCheckSlicePlay;
begin
  //Main Menu
  N1FPS1.Checked:=False;
  N2FPS1.Checked:=False;
  N5FPS1.Checked:=False;
  N10FPS1.Checked:=False;
  N15FPS1.Checked:=False;
  N20FPS1.Checked:=False;
  N43.Checked:=False;
  //Popup Menu
  N1FPS2.Checked:=False;
  N2FPS2.Checked:=False;
  N5FPS2.Checked:=False;
  N10FPS2.Checked:=False;
  N15FPS2.Checked:=False;
  N20FPS2.Checked:=False;
  Stop1.Checked:=False;
end;

procedure TForm1.UnCheckImageZoom;
begin
  //Main Menu
  N501.Checked:=False;
  N1001.Checked:=False;
  N1501.Checked:=False;
  N2001.Checked:=False;
  N4001.Checked:=False;
  N18.Checked:=False;
  N20.Checked:=False;

  //Popup Menu
  N502.Checked:=False;
  N1002.Checked:=False;
  N1502.Checked:=False;
  N2002.Checked:=False;
  N4002.Checked:=False;
  Fit1.Checked := False;
end;

procedure TForm1.UnCheckImageTool;
begin
  N3.Checked:=False;
  N4.Checked:=False;
  N5.Checked:=False;
  N6.Checked:=False;
  N8.Checked:=False;
  N9.Checked:=False;
  N10.Checked:=False;
  N11.Checked:=False;
  N12.Checked:=False;
  N14.Checked:=False;
  N74.Checked:=False;
  N75.Checked:=False;
  N76.Checked:=False;
end;


procedure TForm1.tmrPlaySliceTimer(Sender: TObject);
begin
    if DICOMX1.ImageSlicesCurrent < DICOMX1.ImageSlicesTotal then
      DICOMX1.ImageSlicesCurrent:=DICOMX1.ImageSlicesCurrent+1
    else
      DICOMX1.ImageSlicesCurrent:=1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin       
  gsOpenFileName := '';
  if ParamCount>0 then
  begin
  //ParamStr(0)=Application.ExeName
    if FileExists(ParamStr(1))=False then
    begin
      if ParamCount=1 then
      begin
        Showmessage('Can not open the specified file !');
        //Application.Terminate;
      end;
    end
    else
    begin
      gsOpenFileName := ParamStr(1);
    end;
  end;

  ReadIniSetting;
  InitialMenuItem;

  DICOMX1.ToolBarVisible := False;
  DICOMX1.ImageOverlayOn := True;
  DICOMX1.ImageOverlayShowRuler := True;
  DICOMX1.ImageZoomBestFit := True;

  //Disable MultiSlice Function
  EnableMultiSlice(False);

  //Initial LicenseCode
  DICOMX1.LicenseCode := '0123456789';
  if DICOMX1.LicenseIsOK then
    showmessage('Thanks for registration!');

  pnlMain.Align := alClient;
  DICOMX1.Align := alClient;
  if gsOpenFileName<>'' then
  begin
    if DICOMX1.OpenFile(gsOpenFileName)=True then
    begin
      //Show Image Info
      StatusBar1.Panels[0].Text := 'Width: '+IntToStr(DICOMX1.ImageWidth)+', Height: '+IntToStr(DICOMX1.ImageHeight);
      StatusBar1.Panels[1].Text := 'Window: '+IntToStr(Trunc(DICOMX1.ImageWinWidth))+', Level: '+IntToStr(Trunc(DICOMX1.ImageWinCenter));
      //Image Slices>1 then Enable Multi Slice Function
      if DICOMX1.ImageSlicesTotal > 1 then
        EnableMultiSlice(True)
      else
        EnableMultiSlice(False);
      RefreshPreview;
    end;
  end;
end;

procedure TForm1.O2Click(Sender: TObject);
begin
  if tmrPlaySlice.Enabled then
    N43.Click;
  OpenDialog1.Filter:='All Files(*.*)|*.*|DICOM File(*.DCM)|*.DCM|BMP File(*.BMP)|*.BMP|JPEG File(*.JPG)|*.JPG';
  if OpenDialog1.Execute then
  begin
    if DICOMX1.OpenFile(OpenDialog1.FileName)=True then
    begin
      //Show Image Info
      StatusBar1.Panels[0].Text := 'Width: '+IntToStr(DICOMX1.ImageWidth)+', Height: '+IntToStr(DICOMX1.ImageHeight);
      StatusBar1.Panels[1].Text := 'Window: '+IntToStr(Trunc(DICOMX1.ImageWinWidth))+', Level: '+IntToStr(Trunc(DICOMX1.ImageWinCenter));
      //Image Slices>1 then Enable Multi Slice Function
      if DICOMX1.ImageSlicesTotal > 1 then
        EnableMultiSlice(True)
      else
        EnableMultiSlice(False);
      RefreshPreview;
    end;
  end;
end;

procedure TForm1.S1Click(Sender: TObject);
var
  sTmp,sFileName : String;
begin
  SaveDialog1.Filter:='BMP File(*.BMP)|*.BMP|JPEG File(*.JPG)|*.JPG|TIFF File(*.TIF)|*.TIF';
  if SaveDialog1.Execute then
  begin
    sFileName:=SaveDialog1.FileName;
    if Length(sFileName)>1 then
    begin
      sTmp:=sFileName[Length(sFileName)-3]+sFileName[Length(sFileName)-2];
      sTmp:=sTmp+sFileName[Length(sFileName)-1]+sFileName[Length(sFileName)];
      DICOMX1.ImageSaveToFile := sFileName;
    end;
  end;
end;

procedure TForm1.X1Click(Sender: TObject);
begin
  Form1.Close;
end;

procedure TForm1.N22Click(Sender: TObject);
begin
  if N22.Checked then
  begin
    DICOMX1.ImageSmoothOn:=False;
    N22.Checked:=False;
    giEnableSmooth := 0;
  end
  else
  begin
    DICOMX1.ImageSmoothOn:=True;
    N22.Checked:=True;
    giEnableSmooth := 1;
  end;
end;