📄 dicom.~pas
字号:
case element of
$00 : info := 'Relationship Group Length';
$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';
$91 : info := 'Echo Train Length';
$70 : info := 'Image Geometry Type';
$60 : info := 'Laterality';
$1002: info := 'Images in Acquisition';
$1040: begin info := 'Position Reference'; t := _string; end;
$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.';
$4000: info := 'Image Comments';
$5000: info := 'Original Image ID';
end;
$0028 :
case element of
$00 : info := 'Image Presentation Group Length';
$02 : info := 'Samples Per Pixel';
$04 : info := 'Photometric Interpretation';{help}
$05 : info := 'Image Dimensions (ret)';
$06 : info := 'Planar Configuration';
$08 : begin
t := _string;
lStr := '';
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']
then lStr := lStr +(Char(buff[i]));
//else lStr := lStr +('.');
FreeMem( buff);
lDicomData.XYZdim[3] := strtoint(lStr);
tmp := lDicomData.XYZdim[3];
remaining := 0;
if lDicomData.XYZdim[3] < 1 then lDicomData.XYZdim[3] := 1;
info := 'Number of Frames';
end;
$09: begin info := 'Frame Increment Pointer'; TmpStr := ReadStrHex(fp, remaining,lrOK); if not lrOK then goto 666;
e_len := 0; remaining := 0; end;
$10 : begin info := 'Rows';
lDicomData.XYZdim[2] := read16(fp,lrOK);
if not lrOK then goto 666;
tmp := lDicomData.XYZdim[2];
remaining := 0;
end;
$11 : begin info := 'Columns';
lDicomData.XYZdim[1] := read16(fp,lrOK);
if not lrOK then goto 666;
tmp := lDicomData.XYZdim[1];
remaining := 0;
end;
$30 : begin info := 'Pixel Spacing';
readfloats (fp, remaining, TmpStr, lfloat1, lfloat2, lROK);
if not lrOK then goto 666;
e_len := 0; remaining := 0;
lDICOMdata.XYZmm[1] := lfloat1;
lDICOMdata.XYZmm[2] := lfloat2;
end;
$31: info := 'Zoom Factor';
$32: info := 'Zoom Center';
$34: begin info :='Pixel Aspect Ratio';t := _string; end;
$40: info := 'Image Format [ret]';
$50 : info := 'Manipulated Image [ret]';
$51: info := 'Corrected Image';
$60: begin info := 'Compression Code [ret]';t := _string; end;
$0100: begin info := 'Bits Allocated';
tmp := read16(fp,lrOK);
if not lrOK then goto 666;
if tmp = 8 then lDicomData.Allocbits_per_pixel := 8
else if tmp = 12 then lDicomData.Allocbits_per_pixel := 12
else if tmp = 16 then lDicomData.Allocbits_per_pixel := 16
else begin
if lImageFormatOK then
Showmessage('This software can only read 8, 12 and 16 bit DICOM files. This file allocates '+inttostr(tmp)+' bits per voxel.');
lImageFormatOK := false;
end;
remaining := 0;
end;
$0101: begin info := 'Bits Stored';
tmp := read16(fp,lrOK);
if not lrOK then goto 666;
if tmp <= 8 then lDicomData.Storedbits_per_pixel := 8
else if tmp <= 16 then lDicomData.Storedbits_per_pixel := 16
else begin
if lImageFormatOK then
Showmessage('This software can only read 8, 12 and 16 bit DICOM files. This file stores '+inttostr(tmp)+' bits per voxel.');
lDicomData.Storedbits_per_pixel := tmp;
lImageFormatOK := false;
end;
remaining := 0;
end;
$0102: begin info := 'High Bit';
//lgrp := true;
tmp := read16(fp,lrOK);
if not lrOK then
goto 666;
(*
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';
$0104: info := 'Smallest Valid Pixel Value';
$0105: info := 'Largest Valid Pixel Value';
$0106: info := 'Smallest Image Pixel Value';
$0107: info := 'Largest Image Pixel Value';
$120: info := 'Pixel Padding Value';
$200: info := 'Image Location [ret]';
$1050: begin
t := _string; info := 'Window Center';end;{float}
$1051: begin
t := _string; info := 'Window Width';end; {float}
$1052: begin t := _string;info :='Rescale Intercept'; end; {float}
$1053:begin t := _string; info := 'Rescale Slope'; end; {float}
$1100: info := 'Gray Lookup Table [ret]';
$1101: begin info := 'Red Palette Descriptor'; TmpStr := ReadStr(fp, remaining,lrOK);
if not lrOK then goto 666;
e_len := 0; remaining := 0; end;
$1102: begin info := 'Green Palette Descriptor'; TmpStr := ReadStr(fp, remaining,lrOK);
if not lrOK then goto 666;
e_len := 0; remaining := 0; end;
$1103: begin info := 'Blue Palette Descriptor'; TmpStr := ReadStr(fp, remaining,lrOK);
if not lrOK then goto 666;
e_len := 0; remaining := 0; end;
$1200: info := 'Gray Lookup Data [ret]';
$1201, $1202,$1203: begin
case element of
$1201: info := 'Red Table'; {future}
$1202: info := 'Blue Table'; {future}
$1203: info := 'Green Table'; {future}
end;
if FilePos(fp) > (filesz-remaining) then
goto 666;
Seek(fp, FilePos(fp) + remaining);
tmpstr := 'Custom';
remaining := 0;
e_len := 0; {show tempstr}
end;
(* $1202: begin info := 'Green Table';{future}
end;
$1203: begin info := 'Blue Table';{future}
end;*)
end;
$54: case element of
$0: info := 'Nuclear Acquisition Group Length';
$11: info := 'Number of Energy Windows';
$21: info := 'Number of Detectors';
$51: info := 'Number of Rotations';
$80: begin info := 'Slice Vector'; TmpStr := ReadStr(fp, remaining,lrOK); if not lrOK then goto 666;
e_len := 0; remaining := 0; end;
$81: info := 'Number of Slices';
$202: info := 'Type of Detector Motion';
$400: info := 'Image ID';
end;
$2010 :
case element of
$0: info := 'Film Box Group Length';
$100: info := 'Border Density';
end;
$4000 : info := 'Text';
$7FE0 :
case element of
$00 : begin info := 'Pixel Data Group Length'; if not lImageFormatOK then time_to_quit := TRUE; end;
$10 : begin info := 'Pixel Data'; time_to_quit := TRUE; lDicomData.ImageSz := e_len; TmpStr := inttostr(e_len);e_len := 0; 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;
lStr := '';
if (Time_TO_Quit) and (not lImageFormatOK) then begin
lHdrOK := true; {header was OK}
goto 666;
end;
if (NOT time_to_quit) AND (e_len > 0) and (remaining > 0) then begin
if (e_len + filepos(fp)) > FileSz then begin
showmessage('Dicom format exceeds file size.');
goto 666;
end;
GetMem( buff, e_len);
BlockRead(fp, buff^, e_len, n);
case t of
unknown :
case e_len of
1 : lStr := ( IntToStr(Integer(buff[0])));
2 : Begin
if lDicomData.little_endian <> 0
then i := Integer(buff[0]) + 256*Integer(buff[1])
else i := Integer(buff[0])*256 + Integer(buff[1]);
lStr :=( IntToStr(i));
end;
4 : Begin
if lDicomData.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]);
lStr := (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 lStr := lStr+(Char(buff[i]))
else lStr := lStr+('.');
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 lStr := lStr +(Char(buff[i]))
// else if Char(buff[i]) = '' then showmessage('x');
// else lStr := lStr +(Char(buff[i]));
else lStr := lStr +('.');
end;
FreeMem(buff);
end
else if e_len > 0 then lStr := (IntToStr(tmp))
else if e_len = 0 then begin
lStr := TmpStr;
TmpStr := '';
end;
if (lGrp{info = 'identifying group'{}) then if MessageDlg(lStr+'= '+info+' '+IntToHex(where,4)+': ('+IntToHex(group,4)+','+IntToHex(element,4)+')'+IntToStr(e_len)+'. Continue?',
mtConfirmation, [mbYes, mbNo], 0) = mrNo then GOTO 666;
lDynStr := lDynStr +IntToHex(group,4)+','+IntToHex(element,4)+','{+inttostr(where)+': '+lGrpStr}+Info+': '+lStr+kCR ;
if length(lDynStr) > 10000 then goto 666;
// Writeln(textfp, lStr);
end; // end for
lDicomData.ImageStart := filepos(fp);
if lBigSet then begin
if LBig then lDicomData.little_endian := 0
else lDicomData.little_endian := 1;
end;
//if not lImageError then
lHdrOK := true;
666:
if not lHdrOK then lImageFormatOK := false;
CloseFile(fp);
FileMode := 2; //set to read/write
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -