main.~pas

在delphi7 下开发医学图象浏览器,对医学图象进行编辑,分析的

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,
  ActnList, ImgList;

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;
    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 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 MRUClick(Sender: TOBject);
    procedure UpdateMRUMenu; { Public declarations }
    function ConvertImg(lInName: string; lDICOMdata: DICOMdata; l3ForInterfile4ForAna: integer): boolean;
  public
    procedure CreateMDIChild(Name: string; lAnz, lECAT, l2dImage, lRaw: boolean);


    //打开DCM文件消息
    procedure Mymessage(var t:TWmCopyData);message WM_COPYDATA;


  end;
var
  MainForm: TMainForm;


implementation

uses ChildWin, ShellAPI, printers, Raw, uMultislice;

const
  kMaxMRU = 8;
  gMRUra: array[1..kMaxMRU] of string = ('', '', '', '', '', '', '', '');
  knMenup1 = 11;
  gKeyRoot: string = '\Software\ezDICOM';

{$R *.DFM}

  {********************************************************************
  //通过该函数调用
  // 胥小华
  //2004-10-12
  //
  {********************************************************************}
procedure ViewDICOM(FileName: string);
var
  I, lLen, lTag: Integer;
  lF: file of byte;
begin
{  Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TRawForm, RawForm);
  Application.CreateForm(TMultiSliceForm, MultiSliceForm);
}
  MainForm.Show ;

  if MainForm.AddMRU(FileName) then
  begin
    Filemode := 0;
    AssignFile(lf, FileName);
    Reset(lf);
    lLen := filesize(lf);
    closefile(lf);
    Filemode := 2;
    if lTag = 2 then //ecat
      MainForm.CreateMDIChild(FileName, false, true, false, false)
    else if (lLen = 348) and (ExtractFileExt(FileName) = '.hdr') then
      MainForm.CreateMDIChild(FileName, true, false, false, false)
    else
      MainForm.CreateMDIChild(FileName, false, false, false, false);
  end; //fileexists
end;


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('不能找到文件 ' + 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('不能找到文件: *' + 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