unit1.pas

DICOM文件的读写程序

          $1090: info := 'manufacturer''s model name';
        end;
    	$0010 :
        case element of
        	$00 :  info := 'patient group';
          $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';
          $10 :  begin info := 'contrast/bolus agent'; t := _string; end;
          $20 :  info := 'scanning sequence';
          $21 :  info := 'Sequence Variant';
          $22 :  info := 'Scan Options';
          $23 :  begin info := 'MR Acquisition Type'; t := _string; end;
          $24 :  info := 'Sequence Name';
          $25 :  info := 'Angio Flag';
          $30 :  info := 'radionuclide';
          $50 :  info := 'slice thickness';
          $80 :  info := 'repetition time';
          $81 :  info := 'echo time';
          $82 :  info := 'inversion time';
          $83 :  info := 'Number of Averages';
          $84 :  info := 'Imaging Frequency';
          $85 :  begin info := 'Imaged Nucleus';  t := _string; end;
          $86 :  info := 'Echo Number';
          $87 :  info := 'Magnetic Field Strength';
          $88 :  info := 'Spacing Between Slices';
          $91 :  info := 'Echo Train Length';
          $95 :  info := 'Pixel Bandwidth';
          $1020: info := 'software version';
          $1030: info := 'protocol name';
          $1088: info := 'Heart Rate';
          $1090: info := 'Cardiac Number of Images';
          $1094: info := 'Trigger Window';
          $1100: info := 'Reconstruction Diameter';
          $1120: info := 'gantry tilt';
          $1250: info := 'Receiving Coil';
          $1251: info := 'Transmitting Coil';
          $1310: info := 'Acquisition Matrix';
          $1314: info := 'Flip Angle';
          $1316: info := 'SAR';
          $5100: info := 'Patient Position';
				end;
			$0020 :
        case element of
					$00 :  info := 'relationship group';
          $0d :  info := 'Study Instance UID';
          $0e :  info := 'Series Instance UID';
          $10 :  info := 'study id';
          $11 :  begin info := 'series number';       t := _string; end;
          $12 :  begin info := 'acquisition number';  t := _string; end;
          $13 :  begin info := 'image number';        t := _string; end;
          $20 :  begin info := 'patient orientation'; t := _string; end;
          $30 :  info := 'image position';
          $32 :  info := 'Image Position Patient';
          $35 :  info := 'image orientation';
          $37 :  info := 'Image Orientation (Patient)';
          $50 :  info := 'location';
          $52 :  info := 'Frame of Reference UID';
          $60 :  info := 'Laterality';
          $1002: info := 'images in acquisition';
          $1040: info := 'position reference';
          $1041: info := 'slice location';
          $3401: info := 'modifying device id';
          $3402: info := 'modified image id';
          $3403: info := 'modified image date';
          $3404: info := 'modifying device mfg.';
          $3405: info := 'modified image time';
          $3406: info := 'modified image desc.';
          $5000: info := 'original image id';
				end;
			$0028 :
        case element of
        	$00 :  info := 'image presentation group';
          $02 :  info := 'samples per pixel';
          $04 :  info := 'Photometric Interpretation';
          $05 :  info := 'image dimensions';
          $10 :  begin info := 'rows';
          				height := read16(fp);
          				tmp := height;
                  remaining := 0;
                 end;
					$11 :  begin info := 'columns';
          				width := read16(fp);
          				tmp := height;
                  remaining := 0;
                 end;
          $30 :  info := 'pixel size';
          $50 :  info := 'manipulated image';
          $0100: begin info := 'bits allocated';
									tmp := read16(fp);
                  if tmp = 8 then bytes_per_pixel := 1
                  else if tmp = 16 then bytes_per_pixel := 2
                  else
                  begin
                  	writeln(textfp, IntToStr(tmp));
                    exit;
									end;
                  remaining := 0;
                 end;
        	$0101: begin info := 'bits stored';
          				tmp := read16(fp);
                  if tmp <= 8 then bytes_per_pixel := 1
                  else if tmp <= 16 then bytes_per_pixel := 2
                  else
                  begin
                  	writeln(textfp, IntToStr(tmp));
                  end;
                  remaining := 0;
          			 end;
          $0102: begin info := 'high bit';
          				tmp := read16(fp);
                                 (*
                                 could be 11 for 12 bit cr images so just
                                 skip checking it
                                 assert(tmp == 7 || tmp == 15);
                                 *)
                  remaining := 0;
                 end;
					$0103: info := 'pixel representation';
          $1050: info := 'window center';
          $1051: info := 'window width';
          $1052: info := 'rescale intercept';
          $1053: info := 'rescale slope';
				end;
      $4000 : info := 'text';
      $7FE0 :
        case element of
        	$00 :  info := 'pixel data';
          $10 :  begin info := 'pixel data'; time_to_quit := TRUE; end;
				end;
      else
      	begin
        	if (group >= $6000) AND (group <= $601e) AND ((group AND 1) = 0)
          	then  info := 'overlay';
          if element = $0000 then info := 'group length';
          if element = $4000 then info := 'comments';
				end;
    end;

    Write(textfp, IntToHex(where,4)+': ('+IntToHex(group,4)+','+IntToHex(element,4)+')');
    if info <> ''
    	then write(textfp, ' '+ info)
      else write(textfp, ' unrecognized');

    if time_to_quit then writeln(textfp);

        //skip unused data
    Write(textfp, ': '+IntToStr(e_len)+' ');

    if (NOT time_to_quit) AND (remaining > 0) then
    begin
    	GetMem( buff, e_len);
			BlockRead(fp, buff^, e_len, n);

      case t of
       	unknown :
       		case e_len of
           	1 : Write(textfp, IntToStr(Integer(buff[0])));
            2 : Begin
                 	if little_endian <> 0
                   	then i := Integer(buff[0]) + 256*Integer(buff[1])
                    else i := Integer(buff[0])*256 + Integer(buff[1]);
                  Write(textfp, IntToStr(i));
		  					end;
            4 : Begin
                 	if little_endian <> 0
                   	then i :=               Integer(buff[0])
                              +         256*Integer(buff[1])
                              +     256*256*Integer(buff[2])
                              + 256*256*256*Integer(buff[3])
                    else i :=   Integer(buff[0])*256*256*256
                              + Integer(buff[1])*256*256
                              + Integer(buff[2])*256
                              + Integer(buff[3]);
                  Write(textfp, IntToStr(i));
                end;
						else
             		begin
									for i := 0 to e_len-1 do
                  begin
                   	if Char(buff[i]) in [' ', '0'..'9','a'..'z','A'..'Z']
                     	then Write(textfp, Char(buff[i]))
                      else Write(textfp, '.');
									end;
                end;
					end;

        i8, i16, i32, ui8, ui16, ui32,
        _string  : for i := 0 to e_len-1 do
                   	if Char(buff[i]) in [' ', '0'..'9','a'..'z','A'..'Z']
                     	then Write(textfp, Char(buff[i]))
                      else Write(textfp, '.');
      end;
      FreeMem(buff);
    end
		else if e_len > 0 then Write(textfp, IntToStr(tmp));
    Writeln(textfp);
  end;	// end for

		//read the actual pixel data
	GetMem( buff, height * width * bytes_per_pixel);
	BlockRead(fp, buff^, height * width * bytes_per_pixel, n);
end;

(****************************************************************************)
procedure flip_16bit_data ( var buff : PChar; width : Integer; height:Integer);
var
i   : Integer;
tmp : Char;
begin
	if bytes_per_pixel <> 2 then exit;
  if flip_flag <> 0 then
  begin
    i := 0;
    while i < 2*width*height do
    begin
    	tmp       := buff[i];
      buff[i]   := buff[i+1];
      buff[i+1] := tmp;
      i := i + 2;
		end;

    Writeln(textfp);
    Writeln(textfp, 'Flipped 16-bit data.');
    exit;
	end;

  if (little_endian <> 0) OR (no_flip_flag <> 0) then exit;
  i := 0;
  while i < 2*width*height do
  begin
  	tmp       := buff[i];
    buff[i]   := buff[i+1];
    buff[i+1] := tmp;
    i := i + 2;
	end;
  Writeln(textfp);
  Writeln(textfp,'Flipped 16-bit data.');
end;

(**************************************************************)
procedure scale16to8( var buff : PChar; width : Integer; height:Integer);
var
  max16 : LongInt;
  min16 : LongInt;
  i,j   : Integer;
  new_buff : PChar;
  value : LongInt;
begin
	if bytes_per_pixel <> 2 then exit;

  value := Integer(buff[0]) + Integer(buff[1])*256;
  max16 := value;
  min16 := value;

    //first find the min and max of the 16-bit data
	i:=0;
  while I < 2*width*height do
  begin
    value := Integer(buff[i+1]);
    value := Integer(buff[i]) + value*256;
		if value < min16 then min16 := value;
    if value > max16 then max16 := value;
    i := i+2;
	end;
  Writeln(textfp);
  Writeln(textfp, 'Pixel value range: min= '+Inttostr(min16)+', max= '+Inttostr(max16));
  Writeln(textfp);


  GetMem( new_buff, width * height);

  	//now scale the 16-bit data to 8-bits
  for i := 0 to width*height-1 do
  begin
  	new_buff[i] := CHAR(Trunc(255*(Integer(Buff[i])-min16) / (max16-min16)));
	end;

	i:=0;
  j := 0;
  while I < 2*width*height do
  begin
    value := Integer(buff[i]) + Integer(buff[i+1])*256;
  	new_buff[j] := CHAR(Trunc( 255*(value-min16) / (max16-min16)));
    j:=j+1;
    i := i+2;
	end;



	FreeMem( buff );
  buff := new_buff;

  Writeln(textfp);
  Writeln(textfp, 'Scaled 16-bit data to 8-bit data.');
  Writeln(textfp);
end;


end.