main.pas

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

    reg.Free;
    end;
  end;

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
Showmessage('You can drag the mouse over an image to change the view. '+kCR+
' Dragging changes the contrast.'+kCR+
' Alt+dragging pans the scrollbars.'+kCR+
' Shift+dragging magnifies the region under the mouse.'+kCR+
' Ctrl+dragging selects a region for contrast optimization.'+kCR+
'When multiple windows are open, use Ctrl+Tab to select an image.');
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('Converted images have been placed in the folder '+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('Error: This software can not convert 24-bit RGB images to Analyze or Interfile formats.');
        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 ('The file '+lOutHdr+' already exists.')
     else if fileexists(lOutImg) then showmessage ('The file '+lOutImg+' already exists.')
     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('The input file is too small. Unable to convert data.');
                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('Unable to read this image: try using 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('Unable to convert compressed image data: try using 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('Converted images have been placed in the folder '+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;

end.