main.~pas

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

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  PutRegistryData;
end;

procedure TMainForm.ZoomSliderChange(Sender: TObject);
var
  lZoomPct: integer;
begin
  //gZoomSlider := true;
  //lTMp := WindowmaximizeItem.checked;
  //WindowmaximizeItem.checked := false;
  if MainForm.MDIChildCount = 0 then
    exit;
  lZoomPct := ZoomSlider.Position;
  if TMDIChild(MainForm.ActiveMDIChild).gZoomPct = lZoomPct then
    exit;
  TMDIChild(MainForm.ActiveMDIChild).gZoomPct := lZoomPct;
  TMDIChild(MainForm.ActiveMDIChild).RefreshZoom;
  {     TMDIChild(MainForm.ActiveMDIChild).gZoomPct := lZoomPct;
       TMDIChild(MainForm.ActiveMDIChild).image.Height:= round(TMDIChild(MainForm.ActiveMDIChild).image.Picture.Height * (lZoomPct/100));
       TMDIChild(MainForm.ActiveMDIChild).image.Width := round(TMDIChild(MainForm.ActiveMDIChild).image.Picture.Width * (lZoomPct/100));
       StatusBar.Panels[1].text := inttostr(TMDIChild(MainForm.ActiveMDIChild).gZoomPct)+'%';
    }//TMDIChild(MainForm.ActiveMDIChild).image.refresh;
       //WindowmaximizeItem.checked := lTmp;
       //gZoomSlider := false;
end;

procedure TMainForm.Pct100btnClick(Sender: TObject);
begin
  ZoomSlider.Position := 100;
  ZoomSliderChange(nil);
end;

procedure TMainForm.HdrBtnClick(Sender: TObject);
begin
  if MainForm.MDIChildCount = 0 then
    exit;
  //HdrBtn.Down := not HdrBtn.Down;
  //if HdrBtn.Down then
  TMDIChild(MainForm.ActiveMDIChild).Memo1.visible := HdrBtn.Down;
end;

procedure TMainForm.AutoFitBtnClick(Sender: TObject);
begin
  BestFitItem.Click;
end;

procedure TMainForm.MaximizeAll1Click(Sender: TObject);
var
  I: integer;
begin
  if MainForm.MDIChildCount = 0 then
    exit;
  for I := (MDIChildCount - 1) downto 0 do
    MDIChildren[I].WindowState := wsMaximized;
  {}
end;

procedure TMainForm.HintBtnClick(Sender: TObject);
begin
  messageBox(handle, '你可以拖动鼠标改变图像视图. ' + kCR +
    ' 拖动可以改变对比度.' + kCR +
    ' 按下Alt拖动将移动图像.' + kCR +
    ' 按下Shift拖动可以局部放大图像.' + kCR +
    ' 按下Ctrl拖动选择局部使对比度最佳.' + kCR +
    ' 如果打开多窗口，使用Ctrl+Tab在各图像窗口之间转换.', '提示信息', mb_ICONINFORMATION);
end;

procedure TMainForm.OpenRaw1Click(Sender: TObject);
var
  I: integer;
  lConv, lConvAny: boolean;
  lDICOMdata: DICOMdata;
begin
  //Memo1.lines.add(inttostr(gDicomData.ImageStart));
  if MDIChildCount <> 0 then
  begin
    gRawOffset := TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.ImageStart;
    gRawWid := TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.XYZdim[1];
    gRawHt := TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.XYZdim[2];
    gRawSlice := TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.XYZdim[3];
    if TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.SamplesPerPixel = 3 then
      gRawBits := 24
    else
      gRawBits := TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.Storedbits_per_pixel;
    if TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.little_endian = 1 then
      gRawLittleEnd := true
    else
      gRawLittleEnd := false;
    if TMDIChild(MainForm.ActiveMDIChild).gDICOMdata.PlanarConfig = 1 then
      gRawPlanarRGB := true
    else
      gRawPlanarRGB := false;
  end;
  //RawForm.WidEditChange(nil);
  RawForm.showmodal;
  if gRawOK = 0 then
    exit; //cancel
  if gRawOK > 1 then //user wants to convert file
    showmessage('Note that ezDICOM does not same voxel size [mm] for converted raw files. If required, use MRIcro to convert files.');
  if (RawForm.BitsEdit.value = 20) then
  begin
    showmessage('The current version of the software is unable to view or convert 20-bit images.');
    exit;
  end;
  if (gRawOK > 2) and (RawForm.BitsEdit.value = 24) then
  begin
    showmessage('The current version of the software is unable to convert 24-bit images to Analyze/Interfile.');
    exit;
  end;
  lConvAny := false;
  if OpenDialog.Execute then
  begin
    for I := 0 to OpenDialog.Files.Count - 1 do
    begin
      if Fileexists(OpenDialog.Files[i]) then
      begin //do NOT add to MRU!
        OpenDialog.InitialDir := extractfiledir(OpenDialog.Files[i]);
        if gRawOK = 1 then //view
          CreateMDIChild(OpenDialog.Files[i], false, false, false, true)
        else
        begin //convert raw to dicom or interfile
          clear_dicom_data(lDICOMdata);
          lDicomData.XYZdim[1] := RawForm.WidEdit.value;
          lDicomData.XYZdim[2] := RawForm.HtEdit.value;
          lDicomData.XYZdim[3] := RawForm.SliceEdit.value;
          lDicomData.XYZdim[4] := 1;
          lDicomData.ImageStart := RawForm.OffsetEdit.value;
          if RawForm.LittleEndCheck.checked then
            lDicomData.little_endian := 1
          else
            lDicomData.little_endian := 0;
          lDicomData.Allocbits_per_pixel := RawForm.BitsEdit.value;
          if lDicomData.Allocbits_per_pixel = 24 then
          begin
            lDicomData.SamplesPerPixel := 3;
            lDicomData.Allocbits_per_pixel := 8;
            if RawForm.PlanarRGBCheck.Checked then
              lDicomData.PlanarConfig := 1
            else
              lDicomData.PlanarConfig := 0;
          end;
          lDicomData.Storedbits_per_pixel := RawForm.BitsEdit.value;
          lDicomData.ImageSz := (lDicomData.SamplesPerPixel * (lDicomData.XYZdim[1] * lDicomData.XYZdim[2] *
            lDicomData.Allocbits_per_pixel + 7) div 8) * lDicomData.XYZdim[3];
          lConv := ConvertImg(OpenDialog.Files[i], lDICOMdata, gRawOK);
          if lConv then
            lConvANy := true;
        end; //convert raw
      end; //fileexists
    end;
  end;
  ConLabelClick;
  if lConvAny then
  begin
    showmessage('转换后的图像被放置在文件夹 ' + extractfilepath(OpenDialog.Filename));
  end;
end;

function TMainForm.ConvertImg(lInName: string; lDICOMdata: DICOMdata; l3ForInterfile4ForAna: integer): boolean;
var
  lOffset, lSliceSz, lOutHdrSz, lInc: Integer;
  lHdrOK: boolean;
  lOutHdr, lOutImg: string;
  lF, lOutF: file of byte;
  lBuff: bytep0;
begin
  result := false;
  lOffset := lDicomdata.ImageStart;
  if (lDicomData.SamplesPerPixel > 1) and ((l3ForInterfile4ForAna = 3) or (l3ForInterfile4ForAna = 4)) then
  begin
    showmessage('错误: 该软件不能转换 24-bit RGB 图像为Analyze 或 Interfile 格式.');
    exit;
  end;
  lDicomData.ImageStart := 0;
  if l3ForInterfile4ForAna = 4 then
  begin //interfile
    lOutHdr := changefileext(lInname, '.hdr');
    lOutImg := changefileext(lInname, '.img');
  end
  else if l3ForInterfile4ForAna = 3 then
  begin //interfile
    lOutHdr := changefileext(lInname, '.i3h');
    lOutImg := changefileext(lInname, '.i3i');
  end
  else
  begin //tag <> interfile
    lOutHdr := changefileext(lInName, '.dcm');
    lOutImg := lOutHdr;
  end; //save DCM
  if fileexists(lOutHdr) then
    showmessage('文件 ' + lOutHdr + ' 已存在.')
  else if fileexists(lOutImg) then
    showmessage('文件 ' + lOutImg + ' 已存在.')
  else
  begin //file does not exist
    lOutHdrSz := 0;
    lHdrOK := true;
    lDicomData.ImageSz := lDicomData.XYZdim[1] * lDicomData.XYZdim[2] * lDicomData.XYZdim[3] *
      (lDicomData.Storedbits_per_pixel div 8) * lDicomData.SamplesPerPixel;
    if l3ForInterfile4ForAna = 4 then
      lHdrOK := SaveAnalyzeHdr(lOutHdr, lDicomData)
        //write_interfile_hdr (lOutHdr,lOutImg, lDICOMdata)
    else if l3ForInterfile4ForAna = 3 then
      write_interfile_hdr(lOutHdr, lOutImg, lDICOMdata)
    else
      write_dicom(lOutHdr, lDICOMdata, lOutHdrSz, {true} true);
    if (lDICOMdata.XYZdim[3] > 0) and (lHdrOK) then
    begin
      result := true;
      lSliceSz := ((lDICOMdata.XYZdim[1] * lDICOMdata.XYZdim[2] {height * width} * lDICOMdata.Allocbits_per_pixel + 7)
        div 8) * lDicomData.SamplesPerPixel;
      AssignFile(lF, lInName);
      FileMode := 0; //read Only
      reset(lF);
      if ((lSliceSz * lDICOMdata.XYZdim[3]) + lOffset) > filesize(lf) then
      begin
        showmessage('输入文件太小. 不能转换数据.');
        closefile(lf);
        exit;
      end;
      GetMem(lBuff, lSliceSz);
      Seek(lF, lOffset);
      FileMode := 2; //read/write
      AssignFile(lOutF, lOutImg);
      if lOutHdrSz = 0 then
        Rewrite(lOutF)
      else
      begin
        Reset(lOutF);
        Seek(lOutF, lOutHdrSz);
      end; //hdrsz
      for lInc := 1 to lDICOMdata.XYZdim[3] do
      begin
        FileMode := 0; //read only
        BlockRead(lF, lBuff^, lSliceSz);
        FileMode := 2; //read/write
        BlockWrite(lOutF, lBuff^, lSliceSz);
      end; //for each slice
      CloseFile(lF);
      closeFile(lOutF);
    end; //if > 0 slices
  end; //filenames are unique
  FileMode := 2; //read/write
end;

procedure TMainForm.Convertto1Click(Sender: TObject);
var
  I, lLen, lTag: Integer;
  lHdrOK, lImgOK, lConv, lConvAny: boolean;
  lDICOMdata: DICOMdata;
  lFileName {,lOutHdr,lOutImg}, lDynStr: string;
  lF: file of byte;
begin
  lTag := (Sender as TMEnuItem).Tag;
  lConv := false;
  lConvAny := false;
  if OpenDialog.Execute then
  begin
    for I := 0 to OpenDialog.Files.Count - 1 do
    begin
      if AddMRU(OpenDialog.Files[i]) then
      begin
        OpenDialog.InitialDir := extractfiledir(OpenDialog.Files[i]);
        Filemode := 0;
        AssignFile(lf, OpenDialog.Files[i]);
        Reset(lf);
        lLen := filesize(lf);
        closefile(lf);
        Filemode := 2;
        lFileName := OpenDialog.Files[i];
        if (lLen = 348) then
          OpenAnalyze(lHdrOK, lImgOK, lDynStr, lFileName, lDicomData)
        else
          read_dicom_data(false, false, true, false, true, true, true, lDICOMdata, lHdrOK, lImgOK, lDynStr, lFileName);
        if (not lImgOK) or (not lHdrOK) then
          Showmessage('不能读取该图像: 偿试使用 MRIcro.')
        else if (not lImgOK) or (not lHdrOK) or (lDICOMdata.RunLengthEncoding) or (lDICOMdata.JPEGlosslessCpt) or
          (lDICOMdata.JPEGlossyCpt) or (lDICOMdata.GenesisCpt) or (lDICOMdata.GenesisPackHdr <> 0) then
        begin
          Showmessage('不能转换压缩图像: 偿试使用 MRIcro.');
        end
        else
        begin
          if FileExists(lFileName) then
            lConv := ConvertImg(lFileName, lDICOMdata, lTag);
          if lConv then
            lConvAny := true;
        end;
      end; //fileexists
    end;
  end;
  ConLabelClick;
  if lConvAny then
  begin
    showmessage('转换后的图像被放置在文件夹 ' + extractfilepath(OpenDialog.Filename));
  end;
end;

procedure TMainForm.WinCenEditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if MainForm.MDIChildCount = 0 then
    exit;
  //if (ssShift in Shift) then StatusBar.Panels[1].text := inttostr(random(1024));
  if key = 13 then
    ApplyCon.Click;
end;

procedure TMainForm.VideoBtnClick(Sender: TObject);
//var lSpeed: integer;
begin
  (*  if MainForm.MDIChildCount > 0 then begin
       lSpeed := TMDIChild(MainForm.ActiveMDIChild).gvideospeed;
       if lSpeed > 4 then
          lSpeed := 0
       else
           inc(lSpeed);
       TMDIChild(MainForm.ActiveMDIChild).gMultiRow := 1;
       TMDIChild(MainForm.ActiveMDIChild).gMultiCol := 1;
       TMDIChild(MainForm.ActiveMDIChild).gVideoSpeed := lSpeed;
       if lSpeed > 0 then begin
          TMDIChild(MainForm.ActiveMDIChild).Timer1.Interval := 100 * lSpeed;
          TMDIChild(MainForm.ActiveMDIChild).Timer1.enabled := true;
       end else
          TMDIChild(MainForm.ActiveMDIChild).Timer1.enabled := false;
       VideoBtn.Caption := inttostr(lSpeed);
    end;*)
end;

procedure TMainForm.VideoBtnMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  lSpeed: integer;
begin
  if MainForm.MDIChildCount > 0 then
  begin
    lSpeed := TMDIChild(MainForm.ActiveMDIChild).gvideospeed;
    if Button = mbLeft then
    begin
      if lSpeed > 4 then
        lSpeed := 0
      else
        inc(lSpeed);
    end
    else
    begin
      if lSpeed < 1 then
        lSpeed := 5
      else
        dec(lSpeed);
    end;
    TMDIChild(MainForm.ActiveMDIChild).gMultiRow := 1;
    TMDIChild(MainForm.ActiveMDIChild).gMultiCol := 1;
    TMDIChild(MainForm.ActiveMDIChild).gVideoSpeed := lSpeed;
    if lSpeed > 0 then
    begin
      TMDIChild(MainForm.ActiveMDIChild).Timer1.Interval := 100 * lSpeed;
      TMDIChild(MainForm.ActiveMDIChild).Timer1.enabled := true;
    end
    else
      TMDIChild(MainForm.ActiveMDIChild).Timer1.enabled := false;
    VideoBtn.Caption := inttostr(lSpeed);
  end;
end;

procedure TMainForm.Mymessage(var t: TWmCopyData);
begin
  ViewDICOM(StrPas(t.CopyDataStruct^.lpData));//接受数据并显示。
end;

end.