main.pas

用Delphi做的读取医学图片的控件及代码

unit Main;

interface                                            

uses Windows, SysUtils, Classes, Graphics, Forms, Controls,
     Menus, StdCtrls, Dialogs, Buttons, Messages, ExtCtrls,
     ComCtrls,Registry, ToolWin, ExtDlgs, Spin,dicom,JPEG,define_types,analyze;
             
type
  TMainForm = class(TForm)
    MainMenu1 : TMainMenu;
    FileMenu: TMenuItem;
    FileOpenItem      : TMenuItem;
    N1                : TMenuItem;
    FileExitItem      : TMenuItem;
    WindowMenu: TMenuItem;
    WindowCascadeItem : TMenuItem;
    WindowTileItem    : TMenuItem;
    WindowArrangeItem : TMenuItem;
    WindowMinimizeItem: TMenuItem;
    HelpMenu: TMenuItem;
    HelpAboutItem     : TMenuItem;
    OpenDialog: TOpenDialog;
    Opengraphic1: TMenuItem;
    PGOpenDialog: TOpenDialog;
    OpenAnz: TMenuItem;
    ToolBar1: TToolBar;
    WinCenEdit: TSpinEdit;
    WinWidEdit: TSpinEdit;
    SliceSlider: TTrackBar;
    ApplyCon: TSpeedButton;
    Autobal: TSpeedButton;
    OpenECAT: TMenuItem;
    PGSaveDialog: TSaveDialog;
    SchemeDrop: TComboBox;
    ApplyBright: TSpeedButton;
    FileContrast: TSpeedButton;
    StatusBar: TStatusBar;
    BestFitItem: TMenuItem;
    Print1: TMenuItem;
    Exportaspicture1: TMenuItem;
    Close1: TMenuItem;
    ZoomSlider: TTrackBar;
    AutoFitBtn: TSpeedButton;
    Pct100btn: TSpeedButton;
    HdrBtn: TSpeedButton;
    MaximizeAll1: TMenuItem;
    OpenRaw1: TMenuItem;
    ConverttoDICOM1: TMenuItem;
    Convertto1: TMenuItem;
    ConvertMenu: TMenuItem;
    Convertraw1: TMenuItem;
    Convert2Ana: TMenuItem;
    VideoBtn: TSpeedButton;
    Hints1: TMenuItem;
    PrintDialog1: TPrintDialog;
    procedure ContrastPreset(lPreset:integer);
    function AddMRU (lFilename: string): boolean;
    procedure FormCreate(Sender: TObject);
    procedure WindowCascadeItemClick(Sender: TObject);
    procedure UpdateMenuItems(Sender: TObject);
    procedure WindowTileItemClick(Sender: TObject);
    procedure WindowArrangeItemClick(Sender: TObject);
    procedure AppLaunch;
    procedure FileOpenItemClick(Sender: TObject);
    procedure FileExitItemClick(Sender: TObject);
    procedure WindowMinimizeItemClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure HelpAboutItemClick(Sender: TObject);
    procedure Opengraphic1Click(Sender: TObject);
    procedure SliceSliderChange(Sender: TObject);
    procedure ColUpdate;
    procedure SchemeDropChange(Sender: TObject);
    procedure ApplyConClick(Sender: TObject);
    procedure LoadDropFile (var lFilename: string);
    procedure PrintImg;
    procedure ConLabelClick;
    procedure BestFitItemClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Print1Click(Sender: TObject);
    procedure Exportaspicture1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure GetRegistryData;
    procedure PutRegistryData;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ZoomSliderChange(Sender: TObject);
    procedure Pct100btnClick(Sender: TObject);
    procedure HdrBtnClick(Sender: TObject);
    procedure AutoFitBtnClick(Sender: TObject);
    procedure MaximizeAll1Click(Sender: TObject);
    procedure HintBtnClick(Sender: TObject);
    procedure OpenRaw1Click(Sender: TObject);
    procedure Convertto1Click(Sender: TObject);
    procedure WinCenEditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure VideoBtnClick(Sender: TObject);
    procedure VideoBtnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
    procedure CreateMDIChild(Name: string; lAnz,lECAT,l2dImage,lRaw: boolean);
    procedure MRUClick (Sender: TOBject);
    procedure UpdateMRUMenu;    { Public declarations }
    function ConvertImg (lInName: string; lDICOMdata: DICOMdata; l3ForInterfile4ForAna: integer): boolean;

  end;
var
  MainForm: TMainForm;

implementation
uses ChildWin, About,ShellAPI,printers, Raw;
const
  kMaxMRU = 8;
  //gFastCheck: boolean = true;
  gMRUra: array [1..kMaxMRU] of string=('','','','','','','','');
  knMenup1 = 11;
  gKeyRoot: string = '\Software\ezDICOM';
{$R *.DFM}
procedure TMAinForm.ContrastPreset(lPreset:integer);
var lWid,lCen: integer;
begin
  if MainForm.MDIChildCount = 0 then exit;
  case lPreset of
     0: begin lcen := 400; lwid := 2000; end; //bone
     1: begin lcen := 50; lwid := 350; end; //chest
     2: begin lcen := -600; lwid := 1500; end; //lung
  end;
  if TMDIChild(MainForm.ActiveMDIChild).gBuff16sz > 0 then
         TMDIChild(MainForm.ActiveMDIChild).Scale16to8bit(lCen,lWid)
  else begin
     TMDIChild(MainForm.ActiveMDIChild).gFastCen := lCen;
     TMDIChild(MainForm.ActiveMDIChild).UpdatePalette(true,lWid);
  end;
  //     TMDIChild(MainForm.ActiveMDIChild).RefreshZoom;
  ConLabelClick;
  //TMDIChild(MainForm.ActiveMDIChild).RefreshZoom;
end;

procedure TMAinForm.MRUClick (Sender: TOBject);
var lFilename: string;
begin;
    lFileName := gMRUra[(Sender as TMenuItem).tag];
    if AddMRU (lFileName) then
       LoadDropFile (lFileName)
    else showmessage('Unable to find the file '+lFileName);
end;
procedure TMAinForm.UpdateMRUMenu;
var lF,lN: integer;
  NewItem: TMenuItem;
begin
     lF := FileMenu.Count;
     if lF > (knMenup1-1) then
        for lN := lF downto knMenup1 do
          FileMenu.Delete(lN-1);
     lF := 0;
     repeat
           inc(lF);
     until (lF = kMaxMRU) or (gMRUra[lF] = '');
     if gMRUra[lF] = '' then
        lF := lF - 1;
     if lF = 0 then exit;
     NewItem := TMenuItem.Create(Self);
        NewItem.Caption := '-';
        FileMenu.Add(NewItem);
     for lN := 1 to lF do begin
        NewItem := TMenuItem.Create(Self);
        NewItem.Caption := gMRUra[lN];
        NewItem.Tag := lN;
        NewItem.Onclick := MRUClick;
        FileMenu.Add(NewItem);
    end;
end;
procedure TMainForm.WMDropFiles(var Msg: TWMDropFiles);
var
lInc: integer;
lFileName: string;
  CFileName: array[0..MAX_PATH] of Char;
begin
  try
    lInc := 0;
    while DragQueryFile(Msg.Drop, lInc, CFileName, MAX_PATH) > 0 do
    begin
         lFileName := CFileName;
         if AddMRU (lFileName) then
            LoadDropFile(lFileName);
      Msg.Result := 0;
      inc(lInc);
    end;
  finally
    DragFinish(Msg.Drop);
  end;
end;
(*procedure TMainForm.WMDropFiles(var Msg: TWMDropFiles);
var
lInc: integer;
  CFileName: array[0..MAX_PATH] of Char;
begin
  try
    if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then
    begin
         OpenDialog.FileName := CFileName;
         LoadDropFile;
      Msg.Result := 0;
    end;
  finally
    DragFinish(Msg.Drop);
  end;
end;
*)
procedure TMainForm.AppLaunch;
var
lStr: String;
I: integer;
begin
  if (ParamCount > 0) then begin
    I := 0;
    repeat
     lStr := '';
     repeat
        inc(I);
        if I = 1 then
            lStr := ParamStr(I)
        else begin
            if lStr <> '' then
               lStr := lStr +' '+ ParamStr(I)
            else
                lStr := ParamStr(I);
        end;
     until (I=ParamCount) or (fileexists(lStr));
     if fileexists(lStr) then begin
        LoadDropFile(lStr);
     end
     else ShowmEssage('Unable to find the file: *'+lStr+'*');
    until I >= ParamCount;
  end;{param count > 0}
  {lStr := 'C:\TEST.DCM';
  if fileexists(lStr) then
     LoadDropFile(lStr); {}

end;
function ParseFileName (lFilewExt:String): string;
var
   lLen,lInc: integer;
   lName: String;
begin
	lName := '';
     lLen := length(lFilewExt);
	lInc := lLen+1;
     if  lLen > 0 then
	   repeat
              dec(lInc);
        until (lFileWExt[lInc] = '.') or (lInc = 1);
     if lInc > 1 then
        for lLen := 1 to (lInc - 1) do
            lName := lName + lFileWExt[lLen]
     else
         lName := lFilewExt; //no extension
        ParseFileName := lName;
end;

function TMainForm.AddMRU (lFilename: string): boolean;
var
    lI,lSlot: integer;
    lAbort: boolean;
begin
  if not fileexists(lFilename) then begin
      //showmessage('Unable to find the file '+ lHdrName);
      lAbort := true;
  end else
      lAbort := false;{}
  lSlot := 1;
  for lI := 1 to kMaxMRU do begin
      if (gMRUra[lI] <> '') and(gMRUra[lI] <> lFilename) and (lSlot <= kMaxMRU) then begin
         gMRUra[lSlot] := gMRUra[lI];
         inc(lSlot);
      end;
  end;
  if lSlot < kMaxMRU then
  for lI := lSLot to kMAxMRU do
      gMRUra[lI] :='';
  if lAbort then begin
      UpdateMRUmenu;
      result := false;
      exit;
  end;
  result := true;
  for lI := (kMAxMRU) downto 2 do
      gMRUra[lI] :=gMRUra[lI-1];
  gMRUra[1] := lFilename;
  UpdateMRUMenu;
end;
procedure TMainForm.LoadDropFile (var lFilename: string);
var lExt,lHDrName: string;
lF: file of byte;
    lI,lLen: integer;
begin
     lExt := ExtractFileExt(lFilename);
     if length(lExt) > 0 then

        for lI := 1 to length(lExt) do
            lExt[lI] := upcase(lExt[lI]);
     if (lExt ='.BMP') or (lExt ='.JPG') then begin
          PGOpenDialog.FileName := '';
          PGOpenDialog.InitialDir := extractfiledir(lFilename);
          CreateMDIChild(lFilename,false,false,true,false);
          exit;
     end;
OpenDialog.InitialDir := extractfiledir(lFilename);
if (lExt ='.IMG') or (lExt ='.HDR') then begin
     lHdrName :=ExtractFilePath(lFilename)+ParseFileName(ExtractFileName(lFilename))+'.hdr';
     if fileexists(lHdrName) then begin
            AssignFile(lf, lHdrName);
            Reset(lf);
            lLen := filesize(lf);
            closefile(lf);
            if lLen=(348) then begin
               CreateMDIChild(lHdrName,true,false,false,false);
               exit;
            end;