?? unit1.pas
字號:
$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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -