dicom.pas

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

     lT1 := inguy.Word1 and $80FF;
     lT2 := ((inguy.Word1 and $7F00) +$FF00) and $7F00;
     inguy.Word1 := inguy.Word2;
     inguy.Word2 := (lt1+lT2);
     fvax4r:=inguy.float;
end;
begin
  Clear_Dicom_Data(lDicomData);
  if gECATJPEG_table_entries <> 0 then begin
     freemem (gECATJPEG_pos_table);
     freemem (gECATJPEG_size_table);
     gECATJPEG_table_entries := 0;
  end;
  lHdrOK:= false;
  lQuantScale:= 1;
  lCalibrationFactor := 1;
  lLongRASz := 0;
  lLongRAPos := 0;
  lImageFormatOK := false;
  lVolume := 1;
  if not fileexists(lFileName) then begin
     showmessage('Unable to find the image '+lFileName);
     exit;
  end;
  FileMode := 0; //set to readonly
  AssignFile(fp, lFileName);
  Reset(fp, 1);
  FileSz := FileSize(fp);
     if filesz < (2048) then begin
        showmessage('This file is to small to be a ECAT format image.');
        goto 539;
     end;
  seek(fp, 0);
  BlockRead(fp, lECAT7Sig, 6*SizeOf(Char){, n});
  for lInt4 := 0 to (5) do begin
      if lECAT7Sig[lInt4] in ['a'..'z','A'..'Z'] then
         lECAT7SigUpCase[lInt4] := upcase(lECAT7Sig[lInt4])
      else
          lECAT7SigUpCase[lInt4] := ' ';
  end;
  if (lECAT7SigUpCase[0]='M') and (lECAT7SigUpCase[1]='A') and (lECAT7SigUpCase[2]='T') and (lECAT7SigUpCase[3]='R') and
  (lECAT7SigUpCase[4]='I') and (lECAT7SigUpCase[5]='X') then
    lECAT6 := false
  else
      lECAT6 := true;
   if lEcat6 then begin
      lSwapBytes := false;
      lFileType := xWord(27*2);
      if lFileType > 255 then lSwapBytes := not lSwapBytes;
      lFileType := xWord(27*2);
      lAqcType := xWord(175*2);
      lPlanes := xWord(188*2);
      lFrames := xword(189*2);
      lGates := xWord(190*2);
      lYear := xWord(70);
      if (lPlanes < 1) or (lFrames < 1) or (lGates < 1) then begin
         case MessageDlg('Warning: one of the planes/frames/gates values is less than 1 ['+inttostr(lPlanes)+'/'+inttostr(lFrames)+'/'+inttostr(lGates)+']. Is this file really ECAT 6 format? Press abort to cancel conversion. ',
             mterror,[mbOK,mbAbort], 0) of
             mrAbort: goto 539;
         end; //case
      end else if (lYear < 1940) or (lYear > 3000) then begin
        case MessageDlg('Warning: the year value appears invalid ['+inttostr(lYear)+']. Is this file really ECAT 6 format? Press abort to cancel conversion. ',
             mterror,[mbOK,mbAbort], 0) of
             mrAbort: goto 539;
        end; //case
     end;
     if lVerboseRead then begin
        lDynStr :='ECAT6 data';
        lDynStr :=lDynStr+kCR+('Patient Name:'+StrRead(190,32));
        lDynStr :=lDynStr+kCR+('Patient ID:'+StrRead(174,16));
        lDynStr :=lDynStr+kCR+('Study Desc:'+StrRead(318,32));
        lDynStr := lDynStr+kCR+('Facility: '+StrRead(356,20));
        lDynStr := lDynStr+kCR+('Planes: '+inttostr(lPlanes));
        lDynStr := lDynStr+kCR+('Frames: '+inttostr(lFrames));
        lDynStr := lDynStr+kCR+('Gates: '+inttostr(lGates));
        lDynStr := lDynStr+kCR+('Date DD/MM/YY: '+ inttostr(xWord(66))+'/'+inttostr(xWord(68))+'/'+inttostr(lYear));
     end; {show summary}
   end else begin //NOT ECAT6
       lSwapBytes := true;
     lFileType := xWord(50);
     if lFileType > 255 then lSwapBytes := not lSwapBytes;
     lFileType := xWord(50);
     lAqcType := xWord(328);
     lPlanes := xWord(352);
     lFrames := xWord(354);
     lGates := xWord(356);
     lCalibrationFactor := fswap4r(144);
     if {(true) or} (lPlanes < 1) or (lFrames < 1) or (lGates < 1) then begin
        case MessageDlg('Warning: on of the planes/frames/gates values is less than 1 ['+inttostr(lPlanes)+'/'+inttostr(lFrames)+'/'+inttostr(lGates)+']. Is this file really ECAT 7 format? Press abort to cancel conversion. ',
             mterror,[mbOK,mbAbort], 0) of
             mrAbort: goto 539;
        end; //case
     end; //error
     if lVerboseRead then begin
          lDynStr := 'ECAT 7 format';
          lDynStr := lDynStr+kCR+('Serial Number:'+StrRead(52,10));
          lDynStr := lDynStr+kCR+('Patient Name:'+StrRead(182,32));
          lDynStr := lDynStr+kCR+('Patient ID:'+StrRead(166,16));
          lDynStr := lDynStr+kCR+('Study Desc:'+StrRead(296,32));
          lDynStr := lDynStr+kCR+('Facility: '+StrRead(332,20));
          lDynStr := lDynStr+kCR+('Scanner: '+inttostr(xWord(48)));
          lDynStr := lDynStr+kCR+('Planes: '+inttostr(lPlanes));
          lDynStr := lDynStr+kCR+('Frames: '+inttostr(lFrames));
          lDynStr := lDynStr+kCR+('Gates: '+inttostr(lGates));
          lDynStr := lDynStr+kCR+'Calibration: '+floattostr(lCalibrationFactor);
     end; {lShow Summary}
   end; //lECAT7
if lFiletype = 9 then lFiletype := 7;  //1364: treat projections as Volume16's 
if not (lFileType in [1,2,3,4,7]) then begin
   Showmessage('This software does not recognize the ECAT file type. Selected filetype: '+inttostr(lFileType));
   goto 539;
end;
lVoxelType := 2;
if lFileType = 3 then lVoxelType := 4;
if lVerboseRead then begin
  case lFileType of
    1: lDynStr := lDynStr+kCR+('File type: Scan File');
    2: lDynStr := lDynStr+kCR+('File type: Image File'); //x
    3: lDynStr := lDynStr+kCR+('File type: Attn File');
    4: lDynStr := lDynStr+kCR+('File type: Norm File');
    7: lDynStr := lDynStr+kCR+('File type: Volume 16'); //x
  end; //lfiletye case
  case lAqcType of
     1:lDynStr := lDynStr+kCR+('Acquisition type: Blank');
     2:lDynStr := lDynStr+kCR+('Acquisition type: Transmission');
     3:lDynStr := lDynStr+kCR+('Acquisition type: Static Emission');
     4:lDynStr := lDynStr+kCR+('Acquisition type: Dynamic Emission');
     5:lDynStr := lDynStr+kCR+('Acquisition type: Gated Emission');
     6:lDynStr := lDynStr+kCR+('Acquisition type: Transmission Rect');
     7:lDynStr := lDynStr+kCR+('Acquisition type: Emission Rect');
     8:lDynStr := lDynStr+kCR+('Acquisition type: Whole Body Transm');
     9:lDynStr := lDynStr+kCR+('Acquisition type: Whole Body Static');
     else lDynStr := lDynStr+kCR+('Acquisition type: Undefined');
  end; //case AqcType
end; //verbose read
if ((lECAT6) and (lFiletype =2)) or ({(not lECAT6) and} (lFileType=7)) then  //Kludge
else begin
     Showmessage('Unusual ECAT filetype. Please contact the author.');
     goto 539;
end;
lHdrOK:= true;
lImageFormatOK := true;
lLongRASz := kMaxnSlices * sizeof(longint);
getmem(lLongRA,lLongRAsz);
lPos := 512;
//lSingleRASz := kMaxnSlices * sizeof(single);
//getmem(lSingleRA,lSingleRAsz);
//lMatri := 0;
lVolume := 1;
lPass := 0;
121:
     lEntry := 1;
     lInt := swap32i(lPos);
     lInt2 := swap32i(lPos+4);
   lNextDirectory := lInt2;
   while true do begin
      inc(lEntry);
     lPos := lPos + 16;
     lInt := swap32i(lPos);
     lInt2 := swap32i(lPos+4);
     lInt3 := swap32i(lPos+8);
     lInt4 := swap32i(lPos+12);
     lInt2 := lInt2 - 1;
     lSubHeadStart := lINt2 *512;
     lMatrixStart := ((lInt2) * 512)+512 {add subhead sz};
     lMatrixEnd := lInt3 * 512;
     if  (lInt4 = 1) and (lMatrixStart < FileSz) and (lMatrixEnd <= FileSz) then begin
        if (lFileType= 7) {or (lFileType = 4) } or (lFileType = 2) then begin //Volume of 16-bit integers
           if lEcat6 then begin
               lX := xWord(lSubHeadStart+(66*2));
               lY := xWord(lSubHeadStart+(67*2));
               lZ := 1;//uxWord(lSubHeadStart+8);
               lXmm := 10*fvax4r(lSubHeadStart+(92*2));// fswap4r(lSubHeadStart+(92*2));
               lYmm := lXmm;//read32r(lSubHeadStart+(94*2));
               lZmm := 10 * fvax4r(lSubHeadStart+(94*2));
               lCalibrationFactor :=  fvax4r(lSubHeadStart+(194*2));
               lQuantScale := fvax4r(lSubHeadStart+(86*2));
               if lVerboseRead then
                  lDynStr := lDynStr+kCR+'Plane '+inttostr(lPass+1)+' Calibration/Scale Factor: '+floattostr(lCalibrationFactor)+'/'+floattostr(lQuantScale);
           end else begin
           //02 or 07
               lX := xWord(lSubHeadStart+4);
               lY := xWord(lSubHeadStart+6);
               lZ := xWord(lSubHeadStart+8);
               //if lFileType <> 4 then begin
               lXmm := 10*fswap4r(lSubHeadStart+34);
               lYmm := 10*fswap4r(lSubHeadStart+38);
               lZmm := 10*fswap4r(lSubHeadStart+42);
               lQuantScale := fswap4r(lSubHeadStart+26);
               if lVerboseRead then
                  lDynStr := lDynStr+kCR+'Volume: '+inttostr(lPass+1)+' Scale Factor: '+floattostr(lQuantScale);
               //end; //filetype <> 4
           end;  //ecat7
           if true then begin
           //FileMode := 2; //set to read/write
           inc(lPass);
           lImgSz := lX * lY * lZ * lVoxelType; {2 bytes per voxel}
           lSliceSz := lX * lY * lVoxelType;
           if lZ < 1 then begin
              lHdrOK := false;
              goto 539;
           end;
           lSlicePos := lMatrixStart;
           if ((lECAT6) and (lPass = 1)) or ( (not lECAT6)) then begin
             lDICOMdata.XYZdim[1] := lX;
             lDICOMdata.XYZdim[2] := lY;
             lDICOMdata.XYZdim[3] := lZ;
             lDICOMdata.XYZmm[1] := lXmm;
             lDICOMdata.XYZmm[2] := lYmm;
             lDICOMdata.XYZmm[3] := lZmm;
             case lVoxelType of
                  1: begin
                     Showmessage('Error: 8-bit data not supported [yet]. Please contact the author.');
                     lDicomData.Allocbits_per_pixel := 8;
                     lHdrOK := false;
                     goto 539;
                  end;
                  4: begin
                     Showmessage('Error: 32-bit data not supported [yet]. Please contact the author.');
                     lHdrOK := false;
                     goto 539;
                  end;
                  else begin //16-bit integers
                     lDicomData.Allocbits_per_pixel := 16;
                  end;
             end; {case lVoxelType}
           end else begin //if lECAT6
               if (lDICOMdata.XYZdim[1] <> lX) or (lDICOMdata.XYZdim[2] <> lY) or (lDICOMdata.XYZdim[3] <> lZ) then begin
                  Showmessage('Error: different slices in this volume have different slice sizes. Please contact the author.');
                  lHdrOK := false;
                  goto 539;
               end; //dimensions have changed
               //lSlicePos :=((lMatri-1)*lImgSz);
           end; //ECAT6
           lVox := lSliceSz div 2;
           lHlfVox := lSliceSz div 4;
           for lSlice := 1 to lZ do begin
              if (not lECAT6) then
                 lSlicePos := ((lSlice-1)*lSliceSz)+lMatrixStart;
               if lLongRAPos >= kMaxnSLices then begin
                  lHdrOK := false;
                  goto 539;
               end;
               inc(lLongRAPos);
               lLongRA[lLongRAPos] := lSlicePos;
               {inc(lSingleRAPos);
               if lCalibTableType = 1 then
                  lSingleRA[lSingleRAPos] := lQuantScale
               else
                  lSingleRA[lSingleRAPos] := lCalibrationFactor *lQuantScale;}

           end; //slice 1..lZ
           if not lECAT6 then inc(lVolume);
          end; //fileexistsex
        end; //correct filetype
     end; //matrix start/end within filesz
     if (lMatrixStart > FileSz) or (lMatrixEnd >= FileSz) then goto 539;
     if ((lEntry mod 32) = 0) then begin
        if ((lNextDirectory-1)*512) <= lPos then goto 539; //no more directories
        lPos := (lNextDirectory-1)*512;
        goto 121;
     end;  //entry 32
     end ;  //while true
539:
  CloseFile(fp);
  FileMode := 2; //set to read/write
  lDicomData.XYZdim[3] := lLongRApos;
  if not lECAT6 then dec(lVolume); //ECAT7 increments immediately before exiting loop - once too often
  lDicomData.XYZdim[4] :=(lVolume);
  if lSwapBytes then
     lDicomData.little_endian := 0
  else
      lDicomData.little_endian := 1;
  if (lLongRApos > 0) and (lHdrOK) then begin
     lDicomData.ImageStart := lLongRA[1];
     lCreateTable := false;
     if (lLongRApos > 1) then begin
        lFPos := lDICOMdata.ImageStart;
        for lS := 2 to lLongRApos do begin
            lFPos := lFPos + lSliceSz;
            if lFPos <> lLongRA[lS] then lCreateTable := true;
        end;
        if (lCreateTable) and (lReadECAToffsetTables) then begin
           gECATJPEG_table_entries := lLongRApos;
           getmem (gECATJPEG_pos_table, gECATJPEG_table_entries*sizeof(longint));
           getmem (gECATJPEG_size_table, gECATJPEG_table_entries*sizeof(longint));
           for lS := 1 to gECATJPEG_table_entries do
               gECATJPEG_pos_table[lS] := lLongRA[lS]
        end else if (lCreateTable) then
            lImageFormatOK := false;  //slices are offset within this file
     end;
     if (lVerboseRead) and (lHdrOK) then begin
        lDynStr :=lDynStr+kCR+('XYZdim:'+inttostr(lX)+'/'+inttostr(lY)+'/'+inttostr(gECATJPEG_table_entries));
        lDynStr :=lDynStr+kCR+('XYZmm: '+floattostrf(lDicomData.XYZmm[1],ffFixed,7,7)+'/'+floattostrf(lDicomData.XYZmm[2],ffFixed,7,7)
        +'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,7,7));
        lDynStr :=lDynStr+kCR+('Bits per voxel: '+inttostr(lDicomData.Storedbits_per_pixel));
        lDynStr :=lDynStr+kCR+('Image Start: '+inttostr(lDicomData.ImageStart));
        if lCreateTable then
           lDynStr :=lDynStr+kCR+('Note: staggered slice offsets');
     end
  end;
  lDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
  if lLongRASz > 0 then
     freemem(lLongRA);
  (*if (lSingleRApos > 0) and (lHdrOK) and (lCalibTableType <> 0) then begin
           gECAT_scalefactor_entries := lSingleRApos;
           getmem (gECAT_scalefactor_table, gECAT_scalefactor_entries*sizeof(single));
           for lS := 1 to gECAT_scalefactor_entries do
               gECAT_scalefactor_table[lS] := lSingleRA[lS];
  end;