📄 dicom.pas
字号:
lDicomRA[lnImages] := lDicomData;
lSliceTimeReportedRA[lnImages] := lSliceTimeReported;
end;
end; //valid image
until ((lINPos+2) >= lLen);
if (lImageFormatOK) and (lnImages > 0) and lConvertToAnalyze then begin
FileMode := 0; //set to readonly
AssignFile(fp, lFileName);
Reset(fp, 1);
lInPos := 1;
lVolumes := 1;
lOutputFiles := 1;
repeat
if lnImages = 1 then
lTmpStr := ''
else
lTmpStr := '.'+inttostr(lOutputFiles);
lTmpStr := lTmpStr+'.img';
lTmpStr := changefileext(lFilename,lTmpStr);
if not fileexists(lTmpStr) then begin
AssignFile(lOutFile, lTmpStr);
Rewrite(lOutFile, 1);
lVolumes := 1;
lTimeSlices := 1;
lOutputSlices := lDicomRA[lInPos].XYZdim[3]; //3rd dimension
lOutputVolumes := 1; //4th dimension
lVolumeSz := lDicomRA[lInPos].XYZdim[1]*lDicomRA[lInPos].XYZdim[2]*lDicomRA[lInPos].XYZdim[3]*(lDicomRA[lInPos].Allocbits_per_pixel div 8);
if lSliceTimeReportedRA[lInPos] then begin //Lipsia saves datasets XYTimeZ, while Analyze is XYZTime, so we need to reorder
lZSlices := 1;
lTimeSlices := lDicomRA[lInPos].XYZdim[3];
lVolumes := lInPos;
repeat
inc(lVolumes);
until (lVolumes > lnImages) or (not lSliceTimeReportedRA[lVolumes{-1}]);
lVolumes := lVolumes - lInPos;
lOutputSlices := lVolumes; //3rd dimension
lOutputVolumes := lDicomRA[lInPos].XYZdim[3]; //4th dimension
end else begin
lZSlices := lDicomRA[lInPos].XYZdim[3];
end;
inc(lOutputFiles);
lImageSz := lDicomRA[lInPos].XYZdim[1]*lDicomRA[lInPos].XYZdim[2]*lZSlices*(lDicomRA[lInPos].Allocbits_per_pixel div 8);
GetMem( lP, lImageSz );
l2DSz := lDicomRA[lInPos].XYZdim[1]*lDicomRA[lInPos].XYZdim[2]* (lDicomRA[lInPos].Allocbits_per_pixel div 8);
lLineLen := lDicomRA[lInPos].XYZdim[1]* (lDicomRA[lInPos].Allocbits_per_pixel div 8);
lHalfLines := lDicomRA[lInPos].XYZdim[2] div 2;
GetMem(lLineP,lLineLen);
for lTimeSlice := 1 to lTimeSlices do begin //read each time series
for lVolume := 1 to lVolumes do begin //read from each slice
//Read Image Data
FileMode := 0; //set read only
seek(fp,lDicomRA[lInPos].ImageStart+((lVolume-1)*lVolumeSz)+((lTimeSlice-1)*lImageSz) );
BlockRead(fp, lP^, lImageSz);
//Analyze goes Bottom-to-Top, so flip line order
for lZSlice := 1 to lZSlices do begin
lLowLine := 1+(l2DSz*(lZSlice-1));
lHighLine := l2DSz-lLineLen+1+(l2DSz*(lZSlice-1));
for lLine := 1 to lHalfLines do begin
Move(lP[lLowLine],lLineP^,lLineLen);
Move(lP[lHighLine],lP[lLowLine],lLineLen);
Move(lLineP^,lP[lHighLine],lLineLen);
lLowLine := lLowLine+lLineLen;
lHighLine := lHighLine-lLineLen;
end;
end;
//Write Image Data
FileMode := 2; //set read/write
BlockWrite(lOutFile,lP^,lImageSz);
end;
end;
close(lOutFile);
//lLine,lHalfLines,lLineLen,
freemem(lLineP);
freemem(lP);//
//Next: write a header...
Filemode := 2; //1366
DICOM2AnzHdr(lAnalyzeHdr,lAnonymize,lFilename,lDicomRA[lInPos]);
lAnalyzeHdr.Dim[3] := lOutputSlices;
lAnalyzeHdr.Dim[4] := lOutputVolumes;
lTmpStr := changefileext(lTmpStr,'.hdr');
if not fileexists(lTmpStr) then begin
if lDicomRA[lInPos].little_endian <> 1 then
SwapBytes(lAnalyzeHdr);
AssignFile(lOutFile, lTmpStr);
Rewrite(lOutFile,SizeOf(lAnalyzeHdr));
BlockWrite(lOutFile,lAnalyzeHdr, 1 {, NumWritten});
CloseFile(lOutFile);
end; //Header file named TmpStr does not exist
end; //Image File named TmpStr does not exist
lInPos := lInPos + lVolumes;
until lInPos > lnImages;
CloseFile(fp);
end //ConvertToAnalyze
else if (lImageFormatOK) and (lnImages > 1) then
showmessage('Note: Only first volume of multivolume image will be displayed. Use MRIcro''s ''Convert Vista/Lipsia to Analyze'' command to see all volumes.');
lDicomData := lDicomRA[1];
lDynStr := lDynStr+ 'VISTA Format'
+kCR+ 'XYZ dim: ' +inttostr(lDicomData.XYZdim[1])+'/'+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
+kCR+'Volumes: ' +inttostr(lDicomData.XYZdim[4])
+kCR+'Image offset: ' +inttostr(lDicomData.ImageStart)
+kCR+'XYZ mm: '+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2);
333:
FreeMem( lCharRA);
end; //vista
//afni start
function ParseFileName (lFilewExt:String): string;
var
lLen,lInc: integer;
lName: String;
begin
lName := '';
lLen := length(lFilewExt);
lInc := lLen+1;
if lLen > 0 then
repeat
dec(lInc);
until (lFileWExt[lInc] = '.') or (lInc = 1);
if lInc > 1 then
for lLen := 1 to (lInc - 1) do
lName := lName + lFileWExt[lLen]
else
lName := lFilewExt; //no extension
ParseFileName := lName;
end;
procedure read_afni_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string; var lRotation1,lRotation2,lRotation3: integer);
//label 333;
const UNIXeoln = chr(10);
kTab = ord(chr(9));
kSpace = ord(' ');
var lTmpStr,lInStr,lUpCaseStr: string;
lHdrEnd: boolean;
lMSBch: char;
lOri : array [1..4] of single;
lTmpInt,lPos,lLen,FileSz,linPos: integer;
fp: file;
lCharRA: bytep;
procedure readAFNIeoln;
begin
while (linPos < FileSz) and (lCharRA[linPos] <> ord(kCR)) and (lCharRA[linPos] <> ord(UNIXeoln)) do
inc(linPos);
inc(lInPos); //read EOLN
end;
function readAFNIFloat:real;
var lStr: string;
lCh:char;
begin
lStr := '';
while (linPos < FileSz) and ((lStr='') or ((lCharRA[lInPos] <> kTab) and (lCharRA[lInPos] <> kSpace))) do begin
lCh:= chr(lCharRA[linPos]);
if lCh in ['+','-','e','E','.','0'..'9'] then
lStr := lStr+lCh;
inc(linPos);
end;
//showmessage(lStr);
//exit;
if lStr = '' then exit;
try
result := strtofloat(lStr);
except
on EConvertError do begin
showmessage('Unable to convert the string '+lStr+' to a number');
result := 1;
exit;
end;
end; {except}
end;
(*function readInterStr:string;
var lStr: string;
begin
lStr := '';
While (lPos <= lLen) and (lInStr[lPos] = ' ') do begin
inc(lPos);
end;
While (lPos <= lLen) and (lInStr[lPos] <> ';') do begin
lStr := lStr+upcase(linStr[lPos]); //zebra upcase
inc(lPos);
end;
result := lStr;
end; //interstr func*)
begin
lHdrOK := false;
lImageFormatOK := true;
Clear_Dicom_Data(lDicomData);
lDynStr := '';
lTmpStr := string(StrUpper(PChar(ExtractFileExt(lFileName))));
if lTmpStr <> '.HEAD' then exit;
for lInPos := 1 to 3 do
lOri[lInPos] := -6666;
FileMode := 0; //set to readonly
AssignFile(fp, lFileName);
Reset(fp, 1);
FileSz := FileSize(fp);
lHdrEnd := false;
//lDicomData.ImageStart := FileSz;
GetMem( lCharRA, FileSz+1 );
BlockRead(fp, lCharRA^, FileSz, linpos);
if lInPos <> FileSz then showmessage('Disk error: Unable to read full input file.');
linPos := 1;
CloseFile(fp);
FileMode := 2; //set to read/write
repeat
linstr := '';
while (linPos < FileSz) and (lCharRA[linPos] <> ord(kCR)) and (lCharRA[linPos] <> ord(UNIXeoln)) do begin
lInStr := lInstr + chr(lCharRA[linPos]);
inc(linPos);
end;
inc(lInPos); //read EOLN
lLen := length(lInStr);
lPos := 1;
lUpcaseStr := '';
While (lPos <= lLen) do begin
if lInStr[lPos] in ['_','[',']','(',')','/','+','-','=',{' ',} '0'..'9','a'..'z','A'..'Z'] then
lUpCaseStr := lUpCaseStr+upcase(linStr[lPos]);
inc(lPos);
end;
inc(lPos); {read equal sign in := statement}
if lUpCaseStr ='NAME=DATASET_DIMENSIONS'then begin
lImageFormatOK := true;
lHdrOK := true;
lFileName := parsefilename(lFilename)+'.BRIK'; //always UPPERcase
readAFNIeoln;
lDICOMdata.XYZdim[1] := round(readAFNIFloat);
lDICOMdata.XYZdim[2] := round(readAFNIFloat);
lDICOMdata.XYZdim[3] := round(readAFNIFloat);
//lDicomData.ImageStart := 2048 * round(readInterFloat);
end;
if lUpCaseStr ='NAME=BRICK_FLOAT_FACS'then begin
readAFNIeoln;
lDICOMdata.IntenScale := readAFNIFloat; //1380 read slope of intensity
end;
if lUpCaseStr ='NAME=DATASET_RANK'then begin
readAFNIeoln;
//2nd value is number of volumes
readAFNIFloat;
lDICOMdata.XYZdim[4] := round(readAFNIFloat);
//showmessage(inttostr((lDICOMdata.XYZdim[4])));
end;
if lUpCaseStr ='NAME=BRICK_TYPES'then begin
readAFNIeoln;
lTmpInt := round(readAFNIFloat);
case lTmpInt of
0:lDicomData.Allocbits_per_pixel := 8;
1:begin
lDicomData.Allocbits_per_pixel := 16;
//lDicomData.MaxIntensity := 65535; //Old AFNI were UNSIGNED, new ones are SIGNED???
end;
3:begin
lDicomData.Allocbits_per_pixel := 32;
lDicomData.Float := true;
end;
else begin
lHdrEnd := true;
showmessage('Unsupported AFNI BRICK_TYPES: '+inttostr(lTmpInt));
end;
end; //case
{datatype
0 = byte (unsigned char; 1 byte)
1 = short (2 bytes, signed)
3 = float (4 bytes, assumed to be IEEE format)
5 = complex (8 bytes: real+imaginary parts)}
end;
if lUpCaseStr ='NAME=BYTEORDER_STRING'then begin
readAFNIeoln;
if ((linPos+2) < FileSz) then begin
lMSBch := chr(lCharRA[linPos+1]);
//showmessage(lMSBch);
if lMSBCh = 'L' then lDicomData.Little_Endian := 1;
if lMSBCh = 'M' then begin
lDicomData.Little_Endian := 0;
end;
linPos := lInPos + 2;
end;
//littleendian
end;
if lUpCaseStr ='NAME=ORIGIN'then begin
readAFNIeoln;
lOri[1] := (abs(readAFNIFloat));
lOri[2] := (abs(readAFNIFloat));
lOri[3] := (abs(readAFNIFloat));
{ lDICOMdata.XYZori[1] := round(abs(readAFNIFloat));
lDICOMdata.XYZori[2] := round(abs(readAFNIFloat));
lDICOMdata.XYZori[3] := round(abs(readAFNIFloat));
} //Xori,YOri,ZOri
end;
if lUpCaseStr ='NAME=DELTA'then begin
readAFNIeoln;
lDICOMdata.XYZmm[1] := abs(readAFNIFloat);
lDICOMdata.XYZmm[2] := abs(readAFNIFloat);
lDICOMdata.XYZmm[3] := abs(readAFNIFloat);
//showmessage('xxx');
//Xmm,Ymm,Zmm
end;
if lUpCaseStr ='NAME=ORIENT_SPECIFIC'then begin
readAFNIeoln;
lRotation1 := round(readAFNIFloat);
lRotation2 := round(readAFNIFloat);
lRotation3 := round(readAFNIFloat);
end; //ORIENT_SPECIFIC rotation details
if lInStr <> '' then
lDynStr := lDynStr + lInStr+kCr;
until (linPos >= FileSz) or (lHdrEnd){EOF(fp)};
lDicomData.Storedbits_per_pixel := lDicomData.Allocbits_per_pixel;
for lInPos := 1 to 3 do begin
//showmessage(⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -