📄 dicom.pas
字号:
if lSingleRASz > 0 then
freemem(lSingleRA);*)
end;
procedure write_vista (lAnzFileStrs: Tstrings);
const
kMaxImages = 256;
UNIXeoln = chr(10);
UNIXformfeed = chr(12);
var
lAHdr: AHdr;
lByteSwap: boolean;
lAnalyzeHdrRA: array [1..kMaxImages] of AHdr;
lByteSwapRA: array [1..kMaxImages] of boolean;
lImageOffset,lTimePoint,l3rdDim,lnSubVolumes,lSubVolume,lDataOffset,lVoxels,lInc,lLine,lHalfLines,l2DSz,lLowLine,lHighLine,lLineLen,lZSlice,lZSlices,lHdrSz,lFileSz,lXYZImgSz,lXYTImgSz,lHdr,lnHdr: integer;
lCondStr,lHdrFileName,lImgFileName,lVistaFileName,lRepnStr: string;
lSliceP,lLineP,lP: bytep;
lWordP: wordp;
lDoublep: Doublep;
lLongIntP: LongIntP;
lInFile,lOutFile: file;
lTextFile: textfile;
procedure riteln(lStr: string);
begin
write(lTextFile,lStr+UNIXeoln);
end;
begin
lnHdr := lAnzFileStrs.count;
if lnHdr < 1 then exit;
for lHdr := 1 to lnHdr do begin
lHdrFileName := lAnzFileStrs[lHdr-1];//-1 because tstrings are indexed from 0
lHdrFileName := changefileext(lHdrFileName,'.hdr');
if not fileexists(lHdrFileName) then exit;
lImgFileName := changefileext(lHdrFileName,'.img');
{$I-}
AssignFile(lInFile, lHdrFileName);
FileMode := 0; { Set file access to read only }
Reset(lInFile, 1);
lFileSz := FileSize(lInFile);
if lFileSz <> sizeof(AHdr) then begin
CloseFile(lInFile);
ShowMessage('The file "'+lHdrFileName+
'"is the wrong size to be an Analyze header.');
FileMode := 2; //set to read/write
exit;
end;
{$I+}
if ioresult <> 0 then
ShowMessage('Potential error in reading Analyze header.'+inttostr(IOResult));
BlockRead(lInFile, lAHdr, lFileSz);
CloseFile(lInFile);
FileMode := 2;
if (IOResult <> 0) then exit;
lHdrSz := lAHdr.HdrSz;
Swap4(lHdrSz);
if lAHdr.HdrSz = sizeof(AHdr) then begin
lByteSwap := false;
//little endian header
end else if SizeOf(AHdr) = lHdrSz then begin
SwapBytes (lAHdr); //big-endian: swap bytes
lByteSwap := true;
end else begin
ShowMessage('This software can not read the file "'+lHdrFileName+
'". The header file is not in Analyze format [the first 4 bytes do not have the value 348].');
exit;
end;
lXYZImgSz := lAHdr.Dim[1]*lAHdr.Dim[2]*lAHdr.Dim[3]*(lAHdr.bitpix div 8);
if FSize(lImgFileName) < lXYZImgSz then begin
ShowMessage('The image file "'+lImgFileName+'" is the wrong size');
exit;
end;
lAnalyzeHdrRA[lHdr] := lAHdr;
lByteSwapRA[lHdr] := lByteSwap;
end; //for each analyze header
lVistaFileName := changefileext(lAnzFileStrs[0],'.v');
if fileexists(lVistaFileName) then begin
showmessage('The file '+lVistaFileName+' already exists. Unable to create Interfile format header.');
exit;
end;
lDataOffset := 0; //bytes between end of header and image data
assignfile(lTextFile,lVistaFileName);
rewrite(lTextFile);
riteln('V-data 2 {'); //open bracket1: start header
for lHdr := 1 to lnHdr do begin //for each image
lAHdr := lAnalyzeHdrRA[lHdr];
if lAHdr.Dim[4] > 1 then begin
l3rdDim := lAHdr.Dim[4]; //with Lipsia, timepoints are contiguous
lnSubVolumes := lAHdr.Dim[3];//with Lipsia, 1 image per slice for 4d images
end else begin
l3rdDim := lAHdr.Dim[3]; //
lnSubVolumes := 1;
end;
for lSubvolume := 1 to lnSubVolumes do begin //once for each 2D/3D image, once per slice for each 4D image
riteln(kTab+'image: image {'); //open bracket2: start image
riteln(kTab+kTab+'data: '+inttostr(lDataOffset));//offset
lXYTImgSz := lAHdr.Dim[1]*lAHdr.Dim[2]*l3rdDim*(lAHdr.bitpix div 8);
lDataOffset := lDataOffset + lXYTImgSz; //increment for next image
riteln(kTab+kTab+'length: '+inttostr(lXYTImgSz));
riteln(kTab+kTab+'nbands: '+inttostr(l3rdDim));
riteln(kTab+kTab+'nframes: '+inttostr(l3rdDim));
riteln(kTab+kTab+'nrows: '+inttostr(lAHdr.Dim[2]));
riteln(kTab+kTab+'ncolumns: '+inttostr(lAHdr.Dim[1]));
case lAHdr.datatype of//compute voxel data type
1: lRepnStr := 'bit';
2: lRepnStr := 'ubyte';
4: lRepnStr := 'short';
8: lRepnStr := 'long';
16: lRepnStr := 'float';
64: lRepnStr := 'double';
end;
riteln(kTab+kTab+'repn: '+lRepnStr);
riteln(kTab+kTab+'patient: '+'NO_NAME');
riteln(kTab+kTab+'date: '+'"'+DateTimeToStr(Now)+'"');
//riteln(kTab+kTab+'date: '+'"07:54:50 11 Jan 2001"');
riteln(kTab+kTab+'modality: '+'"MR '+ extractfilename(lAnzFileStrs[lHdr-1])+'"');
riteln(kTab+kTab+'angle: '+'"0 0 0"');
riteln(kTab+kTab+'voxel: '+'"'+floattostrf(lAHdr.pixdim[2],ffFixed,7,5)+
' '+floattostrf(lAHdr.pixdim[3],ffFixed,7,5)+' '+floattostrf(lAHdr.pixdim[4],ffFixed,7,5)+'"');
riteln(kTab+kTab+'location: 0');
if lnSubVolumes > 1 then begin //4D volume
lCondStr := '';
for lTimePoint := 1 to l3rdDim do
lCondStr := lCondStr+'1';
riteln(kTab+kTab+'condition: '+lCondStr); //set condition for all timepoints to 1
end;
if lnSubVolumes > 1 then begin //4D volume
riteln(kTab+kTab+'name: MR '+inttostr(lHdr)+'-'+inttostr(lSubVolume-1)+' FUNCTIONAL');
end else
riteln(kTab+kTab+'name: MR '+inttostr(lHdr)+' ANATOMICAL');
if lnSubVolumes > 1 then begin
riteln(kTab+kTab+'slice_time: 0');
end;
riteln(kTab+kTab+'orientation: axial');
riteln(kTab+kTab+'birth: 07.04.75');
riteln(kTab+kTab+'sex: female');
if lnSubVolumes > 1 then begin
riteln(kTab+kTab+'MPIL_vista_0: " repition_time=2000 packed_data=1 '+inttostr(l3rdDim)+' "');
end;
riteln(kTab+kTab+'convention: natural');
riteln(kTab+'}'); //close bracket2: end image
end; //for lSubvolume... once for 2D/3D volumes, once per slice for 4D images
end; //for lHdr: each image
riteln('}'+chr(12)); //close bracket1: close header
riteln(UNIXformfeed); //end of Vista Header
closefile(lTextFile);
//end: we have now written the Lipsia/Vista text header
//next: copy binary image data
for lHdr := 1 to lnHdr do begin //for each image
lImgFileName := lAnzFileStrs[lHdr-1];//-1 because tstrings are indexed from 0
lImgFileName := changefileext(lImgFileName,'.img');
lAHdr := lAnalyzeHdrRA[lHdr];
lByteSwap := lByteSwapRA[lHdr];
AssignFile(lInFile, lImgFileName);
FileMode := 0; { Set file access to read only }
if lAHdr.Dim[4] > 1 then begin
l3rdDim := lAHdr.Dim[4]; //with Lipsia, timepoints are contiguous
lnSubVolumes := lAHdr.Dim[3];//with Lipsia, 1 image per slice for 4d images
end else begin
l3rdDim := lAHdr.Dim[3];
lnSubVolumes := 1;
end;
for lSubvolume := 1 to lnSubVolumes do begin //once for each 2D/3D image, once per slice for each 4D image
Reset(lInFile, 1);
seek(lInFile,round(lAHdr.vox_offset));
AssignFile(lOutFile, lVistaFileName);
FileMode := 2; { Set file access to read/write }
Reset(lOutFile, 1);
lFileSz := FileSize(lOutFile);
seek(lOutFile,lFileSz);
lXYTImgSz := lAHdr.Dim[1]*lAHdr.Dim[2]*l3rdDim*(lAHdr.bitpix div 8);
lXYZImgSz := lAHdr.Dim[1]*lAHdr.Dim[2]*lAHdr.Dim[3]*(lAHdr.bitpix div 8);
l2DSz := lAHdr.Dim[1]*lAHdr.Dim[2]*(lAHdr.bitpix div 8);
lLineLen := lAHdr.Dim[1]*(lAHdr.bitpix div 8);
lZSlices := l3rdDim;
lHalfLines := lAHdr.Dim[2] div 2;
GetMem( lP, lXYTImgSz );
GetMem(lLineP,lLineLen);
FileMode := 0; //set read only
if lnSubvolumes > 1 then begin //Analyze 4D data saved XYZTime, Lipsia saved XYTimeZ
GetMem(lSliceP,l2DSz);
lDataOffset := 1; //bytes between end of header and image data
for lTimePoint := 1 to l3rdDim do begin
lImageOffset := ((lSubvolume-1)*l2DSz)+((lTimePoint-1)*lXYZImgSz)+round(lAHdr.vox_offset);
//showmessage(inttostr(lImageOffset)+'@'+inttostr(lTimePoint)+'/'+inttostr(l3rdDim));
seek(lInFile,lImageOffset);
BlockRead(lInFile, lSliceP^, l2DSz);
Move(lSliceP[1],lP[lDataOffset],l2DSz);
lDataOffset := lDataOffset + l2DSz;
end; //for each
FreeMem(lSliceP);
end else //if 4D, reorder dimensions, else direct copy
BlockRead(lInFile, lP^, lXYTImgSz);
//NEXT: Vista is BIGENDIAN, so we need to byte-swap multibyte datatypes
if (not lByteSwap) and (lAHdr.datatype> 3) then begin //convert littleendian to bigendian
if (lAHdr.datatype=4) then begin //16-bit data
lVoxels := lXYTImgSz div 2;
lWordP := WordP(lP);
for lInc := 1 to lVoxels do
lWordP[lInc] := swap(lWordP[lInc]);
end else if (lAHdr.datatype=64) then begin //64-bit data
lVoxels := lXYTImgSz div 8;
lDoubleP := DoubleP(lP);
for lInc := 1 to lVoxels do
Xswap8r(lDoubleP[lInc]);
end else begin //32-bit data
lVoxels := lXYTImgSz div 4;
lLongIntP := LongIntP(lP);
for lInc := 1 to lVoxels do
swap4 (lLongIntP[lInc]);
end; //data swapping
end; //end.. little to bigendian
//NEXT: 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^,lXYTImgSz);
end; //for subvolumes: once for 2D/3D volumes, once per slice for 4D fMRI data
close(lOutFile);
close(lInFile);
freemem(lLineP);
freemem(lP);//
end; //for lHdr to lnHdr: copy each image
end; (**)
(*procedure write_slc (lFileName: string; var pDICOMdata: DICOMdata;var lSz: integer; lDICOM3: boolean);
const kMaxRA = 41;
lXra: array [1..kMaxRA] of byte = (7,8,9,21,22,26,27,
35,36,44,45,
50,62,66,78,
81,95,
97,103,104,105,106,111,
113,123,127,
129,139,142,
146,147,148,149,155,156,157,
166,167,168,169,170);
var
fp: file;
lX,lClr,lPos,lRApos: integer;
lP: bytep;
procedure WriteString(lStr: string; lCR: boolean);
var
n,lStrLen : Integer;
begin
lStrLen := length(lStr);
for n := 1 to lstrlen do begin
lPos := lPos + 1;
lP[lPos] := ord(lStr[n]);
end;
if lCR then begin
lPos := lPos + 1;
lP[lPos] := ord(kCR);
end;
end;
begin
lSz := 0;
getmem(lP,2048);
lPos := 0;
WriteString('11111',true);
WriteString(inttostr(pDicomData.XYZdim[1])+' '+inttostr(pDicomData.XYZdim[2])+' '+inttostr(pDicomData.XYZdim[3])+' 8',true);
WriteString(floattostrf(pDicomData.XYZmm[1],ffFixed,7,7)+' '+floattostrf(pDicomData.XYZmm[2],ffFixed,7,7)+' '+floattostrf(pDicomData.XYZmm[3],ffFixed,7,7),true);
WriteString('1 1 0 0',true); //mmunits,MR,original,nocompress
WriteString('16 12 X',false); //icon is 8x8 grid, so 64 bytes for red,green blue
for lClr := 1 to 3 do begin
lRApos := 1;
for lX := 1 to 192 do begin
inc(lPos);
if (lRApos <= kMaxRA) and (lX = lXra[lRApos]) then begin
inc(lRApos);
lP[lPos] := 200;
end else
lP[lPos] := 0;
end; {icongrid 1..192}
end; {RGB}
if lFileName <> '' then begin
AssignFile(fp, lFileName);
Rewrite(fp, 1);
blockwrite(fp,lP^,lPos);
close(fp);
end;
freemem(lP);
lSz := lPos;
end;*)
procedure read_interfile_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string);
label 333;
const UNIXeoln = chr(10);
var lTmpStr,lInStr,lUpCaseStr: string;
lHdrEnd,lFloat,lUnsigned: boolean;
lPos,lLen,FileSz,linPos: integer;
fp: file;
lCharRA: bytep;
function readInterFloat:real;
var lStr: string;
begin
lStr := '';
While (lPos <= lLen) and (lInStr[lPos] <> ';') do begin
if lInStr[lPos] in ['+','-','e','E','.','0'..'9'] then
lStr := lStr+(linStr[lPos]);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -