dicom.~pas

CT DCOM源代码

     if not lrOK then goto 666;
lGrpStr := '';
    lt0 := e_len and 255;
    lt1 := (e_len shr 8) and 255;
    lt2 := (e_len shr 16) and 255;
    lt3 := (e_len shr 24) and 255;
 if explicitVR or first_one then begin
   if  ((lT0=kO) and (lT1=kB)) or ((lT0=kO) and (lT1=kW)) or ((lT0=kS) and (lT1=kQ)) then begin
       lGrpStr := chr(lT0)+chr(lT1);
           e_len:= read32(fp,lrOK);
           if not lrOK then goto 666;
           if first_one then explicitVR := true;
   end else if ((lT3=kO) and (lT2=kB)) or ((lT3=kO) and (lT2=kW)) or ((lT3=kS) and (lT2=kQ)) then begin
           e_len:= read32(fp,lrOK);
           if not lrOK then goto 666;
           if first_one then explicitVR := true;
   end else
   if  ( ((lT0=kA) and (lT1=kE)) or ((lT0=kA) and (lT1=kS))
      or ((lT0=kA) and (lT1=kT)) or ((lT0=kC) and (lT1=kS)) or ((lT0=kD) and (lT1=kA))
      or ((lT0=kD) and (lT1=kS))
      or ((lT0=kD) and (lT1=kT)) or ((lT0=kF) and (lT1=kL)) or ((lT0=kF) and (lT1=kD))
      or ((lT0=kI) and (lT1=kS)) or ((lT0=kL) and (lT1=kO))or ((lT0=kL) and (lT1=kT))
      or ((lT0=kP) and (lT1=kN)) or ((lT0=kS) and (lT1=kH)) or ((lT0=kS) and (lT1=kL))
      or ((lT0=kS) and (lT1=kS)) or ((lT0=kS) and (lT1=kT)) or ((lT0=kT) and (lT1=kM))
      or ((lT0=kU) and (lT1=kI)) or ((lT0=kU) and (lT1=kL)) or ((lT0=kU) and (lT1=kS))
      or ((lT0=kA) and (lT1=kE)) or ((lT0=kA) and (lT1=kS)) )
      then begin
           lGrpStr := chr(lT0) + chr(lT1);
           if lDicomData.little_endian = 1 then
              e_len := (e_len and $ffff0000) shr 16
           else
              e_len := swap((e_len and $ffff0000) shr 16);
           if first_one then begin
              explicitVR := true;
           end;
   end else if (
           ((lT3=kA) and (lT2=kT)) or ((lT3=kC) and (lT2=kS)) or ((lT3=kD) and (lT2=kA))
           or ((lT3=kD) and (lT2=kS))
      or ((lT3=kD) and (lT2=kT)) or ((lT3=kF) and (lT2=kL)) or ((lT3=kF) and (lT2=kD))
      or ((lT3=kI) and (lT2=kS)) or ((lT3=kL) and (lT2=kO))or ((lT3=kL) and (lT2=kT))
      or ((lT3=kP) and (lT2=kN)) or ((lT3=kS) and (lT2=kH)) or ((lT3=kS) and (lT2=kL))
      or ((lT3=kS) and (lT2=kS)) or ((lT3=kS) and (lT2=kT)) or ((lT3=kT) and (lT2=kM))
      or ((lT3=kU) and (lT2=kI)) or ((lT3=kU) and (lT2=kL)) or ((lT3=kU) and (lT2=kS)))
      then begin
           if lDicomData.little_endian = 1 then
              e_len := (256 * lT0) + lT1
           else
              e_len := (lT0) + (256*lT1);
           if first_one then begin
              explicitVR := true;
           end;
   end;
end; //not first_one or explicit
   if (first_one) and (lDicomdata.little_endian =0) and (e_len = $04000000) then begin
      ShowMessage('Switching to little endian');
      lDicomData.little_endian := 1;
      seek(fp, where);
      first_one := false;
      goto 777;
   end else if (first_one) and (lDicomData.little_endian =1) and (e_len = $04000000) then begin
       ShowMessage('Switching to little endian');
       lDicomData.little_endian := 0;
       seek(fp, where);
       first_one := false;
       goto 777;
   end;
   //if first_one and explicitVR then showmessage('explicit')
//   if lGrp then showmessage(inttostr(group)+'/'+inttostr(element));
   first_one    := false;
    remaining := e_len;
    //    Write(textfp, {IntToHex(where,4)+': '+}'('+IntToHex(group,4)+','+IntToHex(element,4)+')');
    info := 'UNKNOWN';
    case group of
    	$0002 :
      	case element of
        	$00 :  info := 'File Meta Elements Group Len';
          $01 :  info := 'File Meta Info Version';
          $02 :  info := 'Media Storage SOP Class UID';
          $03 :  info := 'Media Storage SOP Inst UID';
          $10 :  begin
              info := 'Transfer Syntax UID';
              TmpStr := '';
              if FilePos(fp) > (filesz-e_len) then goto 666;
              GetMem( buff, e_len);
              BlockRead(fp, buff^, e_len, n);
              for i := 0 to e_len-1 do
                   	if Char(buff[i]) in ['+','-',' ', '0'..'9','a'..'z','A'..'Z']
                     	then TmpStr := TmpStr +(Char(buff[i]))
                      else TmpStr := TmpStr +('.');
              FreeMem( buff);
              lStr := '';
              if length(TmpStr) >= 19 then begin
                  if TmpStr[19] = '1' then begin
                     lBigSet:= true;
                     lBig := false;
                  end else if TmpStr[19] = '2' then begin
                     lBigSet:= true;
                     lBig := true;
                  end else if TmpStr[19] = '4' then begin
                      ShowMessage('Unable to extract JPEG: '+TmpStr[17]);
                      lImageFormatOK := false;
                  end else if TmpStr[19] = '5' then begin
                      ShowMessage('Unable to extract lossless run length encoding: '+TmpStr[17]);
                      lImageFormatOK := false;
                  end else begin
                      ShowMessage('Unable to extract unknown data type: '+TmpStr[17]);
                      lImageFormatOK := false;
                  end;
              end; {length}
                  remaining := 0;
                  e_len := 0; {use tempstr}
              end;
          $12 :  begin
              info := 'Implementation Class UID';
              end;
          $13 :
              info := 'Implementation Version Name';
          $16 :  info := 'Source App Entity Title';
          $100:  info := 'Private Info Creator UID';
          $102:  info := 'Private Info';
				end;
      $0008 :
        case element of
          $00 :  begin
              info := 'Identifying Group Length';
          end;
          $01 :  info := 'Length to End';
          $05 :  info := 'Specific Character Set';
          $08 :  begin
              info := 'Image Type';
              t := _string;
              end;
          $10 :  info := 'Recognition Code';
          $12 :  info := 'Instance Creation Date';
          $13 :  info := 'Instance Creation Time';
          $14 :  info := 'Instance Creator UID';
          $16 :  info := 'SOP Class UID';
          $18 :  info := 'SOP Instance UID';
          $20 :  info := 'Study Date';
          $21 :  info := 'Series Date';
          $22 :  info := 'Acquisition Date';
          $23 :  info := 'Image Date';
          $30 :  info := 'Study Time';
          $31 :  info := 'Series Time';
          $32 :  info := 'Acquisition Time';
          $33 :  info := 'Image Time';
          $40 :  info := 'Data Set Type';
          $41 :  info := 'Data Set Subtype';
          $50 :  info := 'Accession Number';
          $60 :  begin info := 'Modality';  t := _string; end;
          $64 :  begin info := 'Conversion Type';  t := _string; end;
          $70 :  info := 'Manufacturer';
          $80 :  info := 'Institution Name';
          $81 :  info := 'City Name';
          $90 :  info := 'Referring Physician''s Name';
          $1010: info := 'Station Name';
          $1030: begin info := 'Study Description'; t := _string; end;
          $103e: info := 'Series Description';
          $1040: info := 'Institutional Dept. Name';
          $1050: info := 'Performing Physician''s Name';
          $1060: info := 'Name Phys(s) Read Study';
          $1070: begin info := 'Operator''s Name';  t := _string; end;
          $1080: info := 'Admitting Diagnosis Description';
          $1090: begin info := 'Manufacturer''s Model Name';t := _string; end;
          $1140: info := 'Referenced Image Sequence';
          $2120: info := 'Stage Name';
          $2122: begin info := 'Stage Number';t := _string; end;
          $2124: begin info := 'Number of Stages';t := _string; end;
          $2128: begin info := 'View Number';t := _string; end;
          $212A: begin info := 'Number of Views in stage';t := _string; end;
          $2204: info := 'Transducer Orientation';


        end;
    	$0010 :
        case element of
        	$00 :  info := 'Patient Group Length';
          $10 :  begin info := 'Patient Name'; t := _string; end;
          $20 :  info := 'Patient ID';
          $30 :  info := 'Patient Date of Birth';
          $40 :  begin info := 'Patient Sex';  t := _string; end;
          $1010: info := 'Patient Age';
          $1030: info := 'Patient Weight';
          $21b0: info := 'Additional Patient History';
				end;
			$0018 :
        case element of
             $00 :  info := 'Acquisition Group Length';
          $10 :  begin info := 'Contrast/Bolus Agent'; t := _string; end;
          $15: info := 'Body Part Examined';
          $20 :  begin info := 'Scanning Sequence';t := _string; end;
          $21 :  begin info := 'Sequence Variant';t := _string; end;
          $22 :  info := 'Scan Options';
          $23 :  begin info := 'MR Acquisition Type'; t := _string; end;
          $24 :  info := 'Sequence Name';
          $25 :  begin info := 'Angio Flag';t := _string; end;
          $30 :  info := 'Radionuclide';
          $50 :  begin info := 'Slice Thickness';
             readfloats (fp, remaining, TmpStr, lfloat1, lfloat2, lROK);
              if not lrOK then goto 666;
e_len := 0;      remaining := 0;
             lDICOMdata.XYZmm[3] := lfloat1;
//             showmessage(floattostr(lDICOMdata.XYZmm[3]));
          end;
          $60: info := 'KVP';
          $70: begin t := _string; info := 'Counts Accumulated'; end;
          $71: begin t := _string; info := 'Acquisition Condition'; end;
          $80 :  info := 'Repetition Time';
          $81 :  info := 'Echo Time';
          $82 :  begin t := _string; info := 'Inversion Time'; end;
          $83 :  begin t := _string; info := 'Number of Averages'; end;
          $84 :  info := 'Imaging Frequency';
          $85 :  begin info := 'Imaged Nucleus';  t := _string; end;
          $86 :  begin info := 'Echo Number';t := _string; end;
          $87 :  info := 'Magnetic Field Strength';
          $88 :  info := 'Spacing Between Slices';
          $89 : begin
              t := _string;
              info := 'Number of Phase Encoding Steps';
              end;
          $90 :  info := 'Data collection diameter';
          $91 :  begin info := 'Echo Train Length';t := _string; end;
          $93: info := 'Percent Sampling';
          $94: info := 'Percent Phase Field View';
          $95 :  info := 'Pixel Bandwidth';
          $1000: begin t := _string; info := 'Device Serial Number'; end;
          $1020: begin info := 'Software Version';t := _string; end;
          $1030: info := 'Protocol Name';
          $1040: info := 'Contrast/Bolus Route';
          $1050 :  begin
              t := _string; info := 'Spatial Resolution'; end;
          $1062: info := 'Nominal Interval';
          $1063: info := 'Frame Time';
          $1088: begin info := 'Heart Rate'; t := _string; end;
          $1090: begin info :=  'Cardiac Number of Images'; t := _string; end;
          $1094: begin info :=  'Trigger Window';t := _string; end;
          $1100: info := 'Reconstruction Diameter';
          $1110: info := 'Distance Source to Detector';
          $1111: info := 'Distance Source to Patient';
          $1120: info := 'Gantry/Detector Tilt';
          $1130: info := 'Table Height';
          $1140: info := 'Rotation Direction';
          $1149: begin
              t := _string; info := 'Field of View Dimension[s]'; end;
          $1150: info := 'Exposure Time';
          $1151: info := 'X-ray Tube Current';
          $1152 :  info := 'Exposure';
          $1160: info := 'Filter Type';
          $1170 :  info := 'Generator Power';
          $1190 :  info := 'Focal Spot[s]';
          $1200 :  info := 'Date of Last Calibration';
          $1201 :  info := 'Time of Last Calibration';
          $1210: info := 'Convolution Kernel';
          $1250: begin t := _string; info := 'Receiving Coil'; end;
          $1251: begin t := _string; info := 'Transmitting Coil'; end;
          $1260 :  begin
              t := _string; info := 'Plate Type'; end;
          $1261 :  begin
              t := _string; info := 'Phosphor Type';  end;
          $1310: begin info := 'Acquisition Matrix'; TmpStr := ReadStr(fp, remaining,lrOK);
                     if not lrOK then goto 666;
e_len := 0; remaining := 0; end;
          $1312: begin
              t := _string; info := 'Phase Encoding Direction'; end;
          $1314: begin
              t := _string; info := 'Flip Angle'; end;
          $1315: begin
              t := _string;info := 'Variable Flip Angle Flag'; end;
          $1316: begin
              t := _string;info := 'SAR'; end;
          $1400: info := 'Aquisition Device Processing Description';
          $1401: begin info := 'Aquisition Device Processing Code';t := _string; end;
          $1402: info := 'Cassette Orientation';
          $1403: info := 'Cassette Size';
          $5020: info := 'Processing Function';
          $5100: begin
              t := _string; info := 'Patient Position';  end;
          $5101: begin info := 'View Position';t := _string; end;
          $6000: begin info := 'Sensitivity'; t := _string; end;
				end;
			$0020 :