« back to all changes in this revision
Viewing changes to dcm2nii/dicomcompat.pas
- browse files at revision 1
- compare with another revision
- download diff
- download tarball
- view history from revision 1
- Committer: Bazaar Package Importer
- Author(s): Michael Hanke
- Date: 2010-07-29 22:07:43 UTC
- Revision ID: james.westby@ubuntu.com-20100729220743-q621ts2zj806gu0n
Tags: upstream-0.20100725.1~dfsg.1
Import upstream version 0.20100725.1~dfsg.1
- files added:
- btn
- btn/new
- common
- dcm2nii
- dcm2nii/example
- dcm2nii/example/lesions
- example
- example/dataset
- fpmath
- fpmath/demo
- fpmath/demo/curfit
- fpmath/demo/equation
- fpmath/demo/fmath
- fpmath/demo/fourier
- fpmath/demo/integral
- fpmath/demo/matrices
- fpmath/demo/optim
- fpmath/demo/polynom
- fpmath/demo/proba
- fpmath/demo/random
- fpmath/demo/stat
- fpmath/dll
- html
- html/images
- html/images/draw
- html/peri
- html/peri/images
- html/tutorial
- html/tutorial/images
- lut
- multislice
- npm
- npm/dmath
- npm/npm.app
- npm/npm.app/Contents
- npm/npm.app/Contents/MacOS
- npm/old
- render
- rgb
- templates
added
removed
dcm2nii/dicomcompat.pas
1
unit dicomcompat;
2
interface
3
uses
4
{$Define NoTroubleshoot}
5
{$IFDEF FPC}
6
gzio2,
7
{$ELSE}
8
gziod,
9
{$ENDIF}
10
11
SysUtils,Classes,define_types,filename,dicomtypes,dicomfastread,prefs,convertsimple;
12
{$H+}
13
var
14
kUseDateTimeForID: boolean = false;
15
procedure read_afni_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string; var lRotation1,lRotation2,lRotation3: integer);
16
procedure read_ecat_data(var lDICOMdata: DICOMdata;lVerboseRead,lReadECAToffsetTables:boolean; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
17
procedure read_siemens_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
18
procedure read_ge_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
19
procedure read_interfile_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string);
20
procedure read_voxbo_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string);
21
procedure read_VFF_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string);
22
procedure read_picker_data(lVerboseRead: boolean; var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
23
procedure read_tiff_data(var lDICOMdata: DICOMdata; var lReadOffsets,lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
24
procedure read_dicom_data_compat(lReadJPEGtables,lVerboseRead,lAutoDECAT7,lReadECAToffsetTables,lAutodetectInterfile,lAutoDetectGenesis,lReadColorTables: boolean; var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string; var lPrefs: TPrefs);
25
26
var
27
gSizeMMWarningShown : boolean = false;
28
gECATJPEG_table_entries: integer = 0;
29
gECATJPEG_pos_table,gECATJPEG_size_table : LongIntP;
30
red_table_size : Integer = 0;
31
green_table_size : Integer = 0;
32
blue_table_size : Integer = 0;
33
red_table : ByteP;
34
green_table : ByteP;
35
blue_table : ByteP;
36
implementation
37
38
uses dialogsx;
39
40
procedure read_ecat_data(var lDICOMdata: DICOMdata;lVerboseRead,lReadECAToffsetTables:boolean; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
41
label
42
121,539;
43
const
44
kMaxnSLices = 6000;
45
kStrSz = 40;
46
var
47
lLongRA: LongIntp;
48
lECAT7sigUpcase,lECAT7sig : array [0..6] of Char;
49
lParse,lSPos,lFPos{,lScomplement},lF,lS,lYear,lFrames,lVox,lHlfVox,lJ,lPass,lVolume,lNextDirectory,lSlice,lSliceSz,lVoxelType,lPos,lEntry,
50
lSlicePos,lLongRApos,lLongRAsz,{lSingleRApos,lSingleRAsz,}{lMatri,}lX,lY,lZ,lCacheSz,lImgSz,lSubHeadStart,lMatrixStart,lMatrixEnd,lInt,lInt2,lInt3,lINt4,n,filesz: LongInt;
51
lPlanes,lGates,lAqcType,lFileType: word;
52
lXmm,lYmm,lZmm,lCalibrationFactor, lQuantScale: real;
53
FP: file;
54
lCreateTable,lSwapBytes,lMR,lECAT6: boolean;
55
function xWord(lPos: longint): word;
56
var
57
s: word;
58
begin
59
seek(fp,lPos);
60
BlockRead(fp, s, 2, n);
61
if lSwapBytes then
62
result := swap(s)
63
else result := s; //assign address of s to inguy
64
end;
65
66
function swap32i(lPos: longint): Longint;
67
type
68
swaptype = packed record
69
case byte of
70
0:(Word1,Word2 : word); //word is 16 bit
71
1:(Long:LongInt);
72
end;
73
swaptypep = ^swaptype;
74
var
75
s : LongInt;
76
inguy:swaptypep;
77
outguy:swaptype;
78
begin
79
seek(fp,lPos);
80
BlockRead(fp, s, 4, n);
81
inguy := @s; //assign address of s to inguy
82
if not lSwapBytes then begin
83
result := inguy^.long;
84
exit;
85
end;
86
outguy.Word1 := swap(inguy^.Word2);
87
outguy.Word2 := swap(inguy^.Word1);
88
swap32i:=outguy.Long;
89
end;
90
function StrRead (lPos, lSz: longint) : string;
91
var
92
I: integer;
93
tx : array [1..kStrSz] of Char;
94
begin
95
result := '';
96
if lSz > kStrSz then exit;
97
seek(fp, lPos{-1});
98
BlockRead(fp, tx, lSz*SizeOf(Char), n);
99
for I := 1 to (lSz-1) do begin
100
if tx[I] in [' ','[',']','+','-','.','\','~','/', '0'..'9','a'..'z','A'..'Z'] then
101
{if (tx[I] <> kCR) and (tx[I] <> UNIXeoln) then}
102
result := result + tx[I];
103
end;
104
end;
105
function fswap4r (lPos: longint): single;
106
type
107
swaptype = packed record
108
case byte of
109
0:(Word1,Word2 : word); //word is 16 bit
110
1:(float:single);
111
end;
112
swaptypep = ^swaptype;
113
var
114
s:single;
115
inguy:swaptypep;
116
outguy:swaptype;
117
begin
118
seek(fp,lPos);
119
if not lSwapBytes then begin
120
BlockRead(fp, result, 4, n);
121
exit;
122
end;
123
BlockRead(fp, s, 4, n);
124
inguy := @s; //assign address of s to inguy
125
outguy.Word1 := swap(inguy^.Word2);
126
outguy.Word2 := swap(inguy^.Word1);
127
fswap4r:=outguy.float;
128
end;
129
function fvax4r (lPos: longint): single;
130
type
131
swaptype = packed record
132
case byte of
133
0:(Word1,Word2 : word); //word is 16 bit
134
1:(float:single);
135
end;
136
swaptypep = ^swaptype;
137
var
138
s:single;
139
lT1,lT2 : word;
140
inguy:swaptypep;
141
begin
142
seek(fp,lPos);
143
BlockRead(fp, s, 4, n);
144
inguy := @s;
145
if (inguy^.Word1 =0) and (inguy^.Word2 = 0) then begin
146
result := 0;
147
exit;
148
end;
149
lT1 := inguy^.Word1 and $80FF;
150
lT2 := ((inguy^.Word1 and $7F00) +$FF00) and $7F00;
151
inguy^.Word1 := inguy^.Word2;
152
inguy^.Word2 := (lt1+lT2);
153
fvax4r:=inguy^.float;
154
end;
155
begin
156
Clear_Dicom_Data(lDicomData);
157
if gECATJPEG_table_entries <> 0 then begin
158
freemem (gECATJPEG_pos_table);
159
freemem (gECATJPEG_size_table);
160
gECATJPEG_table_entries := 0;
161
end;
162
lHdrOK:= false;
163
lQuantScale:= 1;
164
lCalibrationFactor := 1;
165
lLongRASz := 0;
166
lLongRAPos := 0;
167
lImageFormatOK := false;
168
lVolume := 1;
169
if not fileexists(lFileName) then begin
170
Msg('Unable to find the image '+lFileName);
171
exit;
172
end;
173
FileMode := 0; //set to readonly
174
AssignFile(fp, lFileName);
175
Reset(fp, 1);
176
FileSz := FileSize(fp);
177
if filesz < (2048) then begin
178
Msg('This file is to small to be a ECAT format image.');
179
goto 539;
180
end;
181
seek(fp, 0);
182
BlockRead(fp, lECAT7Sig, 6*SizeOf(Char){, n});
183
for lInt4 := 0 to (5) do begin
184
if lECAT7Sig[lInt4] in ['a'..'z','A'..'Z'] then
185
lECAT7SigUpCase[lInt4] := upcase(lECAT7Sig[lInt4])
186
else
187
lECAT7SigUpCase[lInt4] := ' ';
188
end;
189
if (lECAT7SigUpCase[0]='M') and (lECAT7SigUpCase[1]='A') and (lECAT7SigUpCase[2]='T') and (lECAT7SigUpCase[3]='R') and
190
(lECAT7SigUpCase[4]='I') and (lECAT7SigUpCase[5]='X') then
191
lECAT6 := false
192
else
193
lECAT6 := true;
194
if lEcat6 then begin
195
lSwapBytes := false;
196
lFileType := xWord(27*2);
197
if lFileType > 255 then lSwapBytes := not lSwapBytes;
198
lFileType := xWord(27*2);
199
lAqcType := xWord(175*2);
200
lPlanes := xWord(188*2);
201
lFrames := xword(189*2);
202
lGates := xWord(190*2);
203
lYear := xWord(70);
204
if (lPlanes < 1) or (lFrames < 1) or (lGates < 1) then begin
205
case MsgDlg('Warning: one of the planes/frames/gates values is less than 1 ['+inttostr(lPlanes)+'/'+inttostr(lFrames)+'/'+inttostr(lGates)+']. Is this file really ECAT 6 format? Press abort to cancel conversion. ',
206
mterror,[mbOK,mbAbort], 0) of
207
mrAbort: goto 539;
208
end; //case
209
end else if (lYear < 1940) or (lYear > 3000) then begin
210
case MsgDlg('Warning: the year value appears invalid ['+inttostr(lYear)+']. Is this file really ECAT 6 format? Press abort to cancel conversion. ',
211
mterror,[mbOK,mbAbort], 0) of
212
mrAbort: goto 539;
213
end; //case
214
end;
215
if lVerboseRead then begin
216
lDynStr :='ECAT6 data';
217
lDynStr :=lDynStr+kCR+('Patient Name:'+StrRead(190,32));
218
lDynStr :=lDynStr+kCR+('Patient ID:'+StrRead(174,16));
219
lDynStr :=lDynStr+kCR+('Study Desc:'+StrRead(318,32));
220
lDynStr := lDynStr+kCR+('Facility: '+StrRead(356,20));
221
lDynStr := lDynStr+kCR+('Planes: '+inttostr(lPlanes));
222
lDynStr := lDynStr+kCR+('Frames: '+inttostr(lFrames));
223
lDynStr := lDynStr+kCR+('Gates: '+inttostr(lGates));
224
lDynStr := lDynStr+kCR+('Date DD/MM/YY: '+ inttostr(xWord(66))+'/'+inttostr(xWord(68))+'/'+inttostr(lYear));
225
end; {show summary}
226
end else begin //NOT ECAT6
227
lSwapBytes := true;
228
lFileType := xWord(50);
229
if lFileType > 255 then lSwapBytes := not lSwapBytes;
230
lFileType := xWord(50);
231
lAqcType := xWord(328);
232
lPlanes := xWord(352);
233
lFrames := xWord(354);
234
lGates := xWord(356);
235
lCalibrationFactor := fswap4r(144);
236
if {(true) or} (lPlanes < 1) or (lFrames < 1) or (lGates < 1) then begin
237
case MsgDlg('Warning: on of the planes/frames/gates values is less than 1 ['+inttostr(lPlanes)+'/'+inttostr(lFrames)+'/'+inttostr(lGates)+']. Is this file really ECAT 7 format? Press abort to cancel conversion. ',
238
mterror,[mbOK,mbAbort], 0) of
239
mrAbort: goto 539;
240
end; //case
241
end; //error
242
if lVerboseRead then begin
243
lDynStr := 'ECAT 7 format';
244
lDynStr := lDynStr+kCR+('Serial Number:'+StrRead(52,10));
245
lDynStr := lDynStr+kCR+('Patient Name:'+StrRead(182,32));
246
lDynStr := lDynStr+kCR+('Patient ID:'+StrRead(166,16));
247
lDynStr := lDynStr+kCR+('Study Desc:'+StrRead(296,32));
248
lDynStr := lDynStr+kCR+('Facility: '+StrRead(332,20));
249
lDynStr := lDynStr+kCR+('Scanner: '+inttostr(xWord(48)));
250
lDynStr := lDynStr+kCR+('Planes: '+inttostr(lPlanes));
251
lDynStr := lDynStr+kCR+('Frames: '+inttostr(lFrames));
252
lDynStr := lDynStr+kCR+('Gates: '+inttostr(lGates));
253
lDynStr := lDynStr+kCR+'Calibration: '+floattostr(lCalibrationFactor);
254
end; {lShow Summary}
255
end; //lECAT7
256
if lFiletype = 9 then lFiletype := 7; //1364: treat projections as Volume16's
257
if not (lFileType in [1,2,3,4,7]) then begin
258
Msg('This software does not recognize the ECAT file type. Selected filetype: '+inttostr(lFileType));
259
goto 539;
260
end;
261
lVoxelType := 2;
262
if lFileType = 3 then lVoxelType := 4;
263
if lVerboseRead then begin
264
case lFileType of
265
1: lDynStr := lDynStr+kCR+('File type: Scan File');
266
2: lDynStr := lDynStr+kCR+('File type: Image File'); //x
267
3: lDynStr := lDynStr+kCR+('File type: Attn File');
268
4: lDynStr := lDynStr+kCR+('File type: Norm File');
269
7: lDynStr := lDynStr+kCR+('File type: Volume 16'); //x
270
end; //lfiletye case
271
case lAqcType of
272
1:lDynStr := lDynStr+kCR+('Acquisition type: Blank');
273
2:lDynStr := lDynStr+kCR+('Acquisition type: Transmission');
274
3:lDynStr := lDynStr+kCR+('Acquisition type: Static Emission');
275
4:lDynStr := lDynStr+kCR+('Acquisition type: Dynamic Emission');
276
5:lDynStr := lDynStr+kCR+('Acquisition type: Gated Emission');
277
6:lDynStr := lDynStr+kCR+('Acquisition type: Transmission Rect');
278
7:lDynStr := lDynStr+kCR+('Acquisition type: Emission Rect');
279
8:lDynStr := lDynStr+kCR+('Acquisition type: Whole Body Transm');
280
9:lDynStr := lDynStr+kCR+('Acquisition type: Whole Body Static');
281
else lDynStr := lDynStr+kCR+('Acquisition type: Undefined');
282
end; //case AqcType
283
end; //verbose read
284
if ((lECAT6) and (lFiletype =2)) or ({(not lECAT6) and} (lFileType=7)) then //Kludge
285
else begin
286
Msg('Unusual ECAT filetype. Please contact the author.');
287
goto 539;
288
end;
289
lHdrOK:= true;
290
lImageFormatOK := true;
291
lLongRASz := kMaxnSlices * sizeof(longint);
292
getmem(lLongRA,lLongRAsz);
293
lPos := 512;
294
//lSingleRASz := kMaxnSlices * sizeof(single);
295
//getmem(lSingleRA,lSingleRAsz);
296
//lMatri := 0;
297
lVolume := 1;
298
lPass := 0;
299
121:
300
lEntry := 1;
301
lInt := swap32i(lPos);
302
lInt2 := swap32i(lPos+4);
303
lNextDirectory := lInt2;
304
while true do begin
305
inc(lEntry);
306
lPos := lPos + 16;
307
lInt := swap32i(lPos);
308
lInt2 := swap32i(lPos+4);
309
lInt3 := swap32i(lPos+8);
310
lInt4 := swap32i(lPos+12);
311
lInt2 := lInt2 - 1;
312
lSubHeadStart := lINt2 *512;
313
lMatrixStart := ((lInt2) * 512)+512 {add subhead sz};
314
lMatrixEnd := lInt3 * 512;
315
if (lInt4 = 1) and (lMatrixStart < FileSz) and (lMatrixEnd <= FileSz) then begin
316
if (lFileType= 7) {or (lFileType = 4) } or (lFileType = 2) then begin //Volume of 16-bit integers
317
if lEcat6 then begin
318
lX := xWord(lSubHeadStart+(66*2));
319
lY := xWord(lSubHeadStart+(67*2));
320
lZ := 1;//uxWord(lSubHeadStart+8);
321
lXmm := 10*fvax4r(lSubHeadStart+(92*2));// fswap4r(lSubHeadStart+(92*2));
322
lYmm := lXmm;//read32r(lSubHeadStart+(94*2));
323
lZmm := 10 * fvax4r(lSubHeadStart+(94*2));
324
lCalibrationFactor := fvax4r(lSubHeadStart+(194*2));
325
lQuantScale := fvax4r(lSubHeadStart+(86*2));
326
if lVerboseRead then
327
lDynStr := lDynStr+kCR+'Plane '+inttostr(lPass+1)+' Calibration/Scale Factor: '+floattostr(lCalibrationFactor)+'/'+floattostr(lQuantScale);
328
end else begin
329
//02 or 07
330
lX := xWord(lSubHeadStart+4);
331
lY := xWord(lSubHeadStart+6);
332
lZ := xWord(lSubHeadStart+8);
333
//if lFileType <> 4 then begin
334
lXmm := 10*fswap4r(lSubHeadStart+34);
335
lYmm := 10*fswap4r(lSubHeadStart+38);
336
lZmm := 10*fswap4r(lSubHeadStart+42);
337
lQuantScale := fswap4r(lSubHeadStart+26);
338
if lVerboseRead then
339
lDynStr := lDynStr+kCR+'Volume: '+inttostr(lPass+1)+' Scale Factor: '+floattostr(lQuantScale);
340
//end; //filetype <> 4
341
end; //ecat7
342
if true then begin
343
//FileMode := 2; //set to read/write
344
inc(lPass);
345
lImgSz := lX * lY * lZ * lVoxelType; {2 bytes per voxel}
346
lSliceSz := lX * lY * lVoxelType;
347
if lZ < 1 then begin
348
lHdrOK := false;
349
goto 539;
350
end;
351
lSlicePos := lMatrixStart;
352
if ((lECAT6) and (lPass = 1)) or ( (not lECAT6)) then begin
353
lDICOMdata.XYZdim[1] := lX;
354
lDICOMdata.XYZdim[2] := lY;
355
lDICOMdata.XYZdim[3] := lZ;
356
lDICOMdata.XYZmm[1] := lXmm;
357
lDICOMdata.XYZmm[2] := lYmm;
358
lDICOMdata.XYZmm[3] := lZmm;
359
case lVoxelType of
360
1: begin
361
Msg('Error: 8-bit data not supported [yet]. Please contact the author.');
362
lDicomData.Allocbits_per_pixel := 8;
363
lHdrOK := false;
364
goto 539;
365
end;
366
4: begin
367
Msg('Error: 32-bit data not supported [yet]. Please contact the author.');
368
lHdrOK := false;
369
goto 539;
370
end;
371
else begin //16-bit integers
372
lDicomData.Allocbits_per_pixel := 16;
373
end;
374
end; {case lVoxelType}
375
end else begin //if lECAT6
376
if (lDICOMdata.XYZdim[1] <> lX) or (lDICOMdata.XYZdim[2] <> lY) or (lDICOMdata.XYZdim[3] <> lZ) then begin
377
Msg('Error: different slices in this volume have different slice sizes. Please contact the author.');
378
lHdrOK := false;
379
goto 539;
380
end; //dimensions have changed
381
//lSlicePos :=((lMatri-1)*lImgSz);
382
end; //ECAT6
383
lVox := lSliceSz div 2;
384
lHlfVox := lSliceSz div 4;
385
for lSlice := 1 to lZ do begin
386
if (not lECAT6) then
387
lSlicePos := ((lSlice-1)*lSliceSz)+lMatrixStart;
388
if lLongRAPos >= kMaxnSLices then begin
389
lHdrOK := false;
390
goto 539;
391
end;
392
inc(lLongRAPos);
393
lLongRA^[lLongRAPos] := lSlicePos;
394
{inc(lSingleRAPos);
395
if lCalibTableType = 1 then
396
lSingleRA[lSingleRAPos] := lQuantScale
397
else
398
lSingleRA[lSingleRAPos] := lCalibrationFactor *lQuantScale;}
399
400
end; //slice 1..lZ
401
if not lECAT6 then inc(lVolume);
402
end; //fileexistsex
403
end; //correct filetype
404
end; //matrix start/end within filesz
405
if (lMatrixStart > FileSz) or (lMatrixEnd >= FileSz) then goto 539;
406
if ((lEntry mod 32) = 0) then begin
407
if ((lNextDirectory-1)*512) <= lPos then goto 539; //no more directories
408
lPos := (lNextDirectory-1)*512;
409
goto 121;
410
end; //entry 32
411
end ; //while true
412
539:
413
CloseFile(fp);
414
FileMode := 2; //set to read/write
415
lDicomData.XYZdim[3] := lLongRApos;
416
if not lECAT6 then dec(lVolume); //ECAT7 increments immediately before exiting loop - once too often
417
lDicomData.XYZdim[4] :=(lVolume);
418
if lSwapBytes then
419
lDicomData.little_endian := 0
420
else
421
lDicomData.little_endian := 1;
422
if (lLongRApos > 0) and (lHdrOK) then begin
423
lDicomData.ImageStart := lLongRA^[1];
424
lCreateTable := false;
425
if (lLongRApos > 1) then begin
426
lFPos := lDICOMdata.ImageStart;
427
for lS := 2 to lLongRApos do begin
428
lFPos := lFPos + lSliceSz;
429
if lFPos <> lLongRA^[lS] then lCreateTable := true;
430
end;
431
if (lCreateTable) and (lReadECAToffsetTables) then begin
432
gECATJPEG_table_entries := lLongRApos;
433
getmem (gECATJPEG_pos_table, gECATJPEG_table_entries*sizeof(longint));
434
getmem (gECATJPEG_size_table, gECATJPEG_table_entries*sizeof(longint));
435
for lS := 1 to gECATJPEG_table_entries do
436
gECATJPEG_pos_table^[lS] := lLongRA^[lS]
437
end else if (lCreateTable) then
438
lImageFormatOK := false; //slices are offset within this file
439
end;
440
if (lVerboseRead) and (lHdrOK) then begin
441
lDynStr :=lDynStr+kCR+('XYZdim:'+inttostr(lX)+'/'+inttostr(lY)+'/'+inttostr(gECATJPEG_table_entries));
442
lDynStr :=lDynStr+kCR+('XYZmm: '+floattostrf(lDicomData.XYZmm[1],ffFixed,7,7)+'/'+floattostrf(lDicomData.XYZmm[2],ffFixed,7,7)
443
+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,7,7));
444
//xlDynStr :=lDynStr+kCR+('Bits per voxel: '+inttostr(lDicomData.Storedbits_per_pixel));
445
lDynStr :=lDynStr+kCR+('Image Start: '+inttostr(lDicomData.ImageStart));
446
if lCreateTable then
447
lDynStr :=lDynStr+kCR+('Note: staggered slice offsets');
448
end
449
end;
450
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
451
if lLongRASz > 0 then
452
freemem(lLongRA);
453
(*if (lSingleRApos > 0) and (lHdrOK) and (lCalibTableType <> 0) then begin
454
gECAT_scalefactor_entries := lSingleRApos;
455
getmem (gECAT_scalefactor_table, gECAT_scalefactor_entries*sizeof(single));
456
for lS := 1 to gECAT_scalefactor_entries do
457
gECAT_scalefactor_table[lS] := lSingleRA[lS];
458
end;
459
if lSingleRASz > 0 then
460
freemem(lSingleRA);*)
461
end;
462
463
(*procedure write_slc (lFileName: string; var pDICOMdata: DICOMdata;var lSz: integer; lDICOM3: boolean);
464
const kMaxRA = 41;
465
lXra: array [1..kMaxRA] of byte = (7,8,9,21,22,26,27,
466
35,36,44,45,
467
50,62,66,78,
468
81,95,
469
97,103,104,105,106,111,
470
113,123,127,
471
129,139,142,
472
146,147,148,149,155,156,157,
473
166,167,168,169,170);
474
var
475
fp: file;
476
lX,lClr,lPos,lRApos: integer;
477
lP: bytep;
478
procedure WriteString(lStr: string; lCR: boolean);
479
var
480
n,lStrLen : Integer;
481
begin
482
lStrLen := length(lStr);
483
for n := 1 to lstrlen do begin
484
lPos := lPos + 1;
485
lP[lPos] := ord(lStr[n]);
486
end;
487
if lCR then begin
488
lPos := lPos + 1;
489
lP[lPos] := ord(kCR);
490
end;
491
end;
492
493
begin
494
lSz := 0;
495
getmem(lP,2048);
496
lPos := 0;
497
WriteString('11111',true);
498
WriteString(inttostr(pDicomData.XYZdim[1])+' '+inttostr(pDicomData.XYZdim[2])+' '+inttostr(pDicomData.XYZdim[3])+' 8',true);
499
WriteString(floattostrf(pDicomData.XYZmm[1],ffFixed,7,7)+' '+floattostrf(pDicomData.XYZmm[2],ffFixed,7,7)+' '+floattostrf(pDicomData.XYZmm[3],ffFixed,7,7),true);
500
WriteString('1 1 0 0',true); //mmunits,MR,original,nocompress
501
WriteString('16 12 X',false); //icon is 8x8 grid, so 64 bytes for red,green blue
502
for lClr := 1 to 3 do begin
503
lRApos := 1;
504
for lX := 1 to 192 do begin
505
inc(lPos);
506
if (lRApos <= kMaxRA) and (lX = lXra[lRApos]) then begin
507
inc(lRApos);
508
lP[lPos] := 200;
509
end else
510
lP[lPos] := 0;
511
end; {icongrid 1..192}
512
end; {RGB}
513
if lFileName <> '' then begin
514
AssignFile(fp, lFileName);
515
Rewrite(fp, 1);
516
blockwrite(fp,lP^,lPos);
517
close(fp);
518
end;
519
freemem(lP);
520
lSz := lPos;
521
end;*)
522
procedure read_interfile_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string);
523
label 333;
524
const UNIXeoln = chr(10);
525
var lTmpStr,
526
lInStr,lUpCaseStr: string;
527
lHdrEnd,lFloat,lUnsigned: boolean;
528
lPos,lLen,FileSz,linPos: integer;
529
fp: file;
530
lCharRA: bytep;
531
function readInterFloat:real;
532
var lStr: string;
533
begin
534
lStr := '';
535
While (lPos <= lLen) and (lInStr[lPos] <> ';') do begin
536
if lInStr[lPos] in ['+','-','e','E','.','0'..'9'] then
537
lStr := lStr+(linStr[lPos]);
538
inc(lPos);
539
end;
540
try
541
result := strtofloat(lStr);
542
except
543
on EConvertError do begin
544
Msg('Unable to convert the string '+lStr+' to a number');
545
result := 1;
546
exit;
547
end;
548
end; {except}
549
end;
550
function readInterStr:string;
551
var lStr: string;
552
begin
553
lStr := '';
554
While (lPos <= lLen) and (lInStr[lPos] = ' ') do begin
555
inc(lPos);
556
end;
557
While (lPos <= lLen) and (lInStr[lPos] <> ';') do begin
558
if lInStr[lPos] <> ' ' then //1.39 build 6
559
lStr := lStr+upcase(linStr[lPos]); //zebra upcase
560
inc(lPos);
561
end;
562
result := lStr;
563
end; //interstr func
564
begin
565
lHdrOK := false;
566
lFloat := false;
567
lUnsigned := false;
568
lImageFormatOK := true;
569
Clear_Dicom_Data(lDicomData);
570
lDynStr := '';
571
FileMode := 0; //set to readonly
572
AssignFile(fp, lFileName);
573
Reset(fp, 1);
574
FileSz := FileSize(fp);
575
lHdrEnd := false;
576
//lDicomData.ImageStart := FileSz;
577
GetMem( lCharRA, FileSz+1 );
578
BlockRead(fp, lCharRA^, FileSz, linpos);
579
if lInPos <> FileSz then Msg('Disk error: Unable to read full input file.');
580
linPos := 1;
581
CloseFile(fp);
582
FileMode := 2; //set to read/write
583
repeat
584
linstr := '';
585
while (linPos < FileSz) and (lCharRA^[linPos] <> ord(kCR)) and (lCharRA^[linPos] <> ord(UNIXeoln)) do begin
586
lInStr := lInstr + chr(lCharRA^[linPos]);
587
inc(linPos);
588
end;
589
inc(lInPos); //read EOLN
590
lLen := length(lInStr);
591
lPos := 1;
592
lUpcaseStr := '';
593
While (lPos <= lLen) and (lInStr[lPos] <> ';') and (lInStr[lPos] <> '=') and (lUpCaseStr <>'INTERFILE') do begin
594
if lInStr[lPos] in ['[',']','(',')','/','+','-',{' ',} '0'..'9','a'..'z','A'..'Z'] then
595
lUpCaseStr := lUpCaseStr+upcase(linStr[lPos]);
596
inc(lPos);
597
end;
598
inc(lPos); {read equal sign in := statement}
599
if lUpCaseStr ='INTERFILE' then begin
600
lHdrOK := true;
601
lDicomData.little_endian := 0;
602
end;
603
if lUpCaseStr ='DATASTARTINGBLOCK'then lDicomData.ImageStart := 2048 * round(readInterFloat);
604
if lUpCaseStr ='DATAOFFSETINBYTES'then lDicomData.ImageStart := round(readInterFloat);
605
if (lUpCaseStr ='MATRIXSIZE[1]') or (lUpCaseStr ='MATRIXSIZE[X]') then lDicomData.XYZdim[1] := round(readInterFloat);
606
if (lUpCaseStr ='MATRIXSIZE[2]')or (lUpCaseStr ='MATRIXSIZE[Y]')then lDicomData.XYZdim[2] := round(readInterFloat);
607
if (lUpCaseStr ='MATRIXSIZE[3]')or (lUpCaseStr ='MATRIXSIZE[Z]') or (lUpCaseStr ='NUMBEROFSLICES') or (lUpCaseStr ='TOTALNUMBEROFIMAGES') then begin
608
lDicomData.XYZdim[3] := round(readInterFloat);
609
end;
610
if lUpCaseStr ='IMAGEDATABYTEORDER' then begin
611
if readInterStr = 'LITTLEENDIAN' then lDicomData.little_endian := 1;
612
end;
613
if lUpCaseStr ='NUMBERFORMAT' then begin
614
lTmpStr := readInterStr;
615
if (lTmpStr = 'ASCII') or (lTmpStr='BIT') then begin
616
lHdrOK := false;
617
Msg('This software can not convert '+lTmpStr+' data type.');
618
goto 333;
619
end;
620
if lTmpStr = 'UNSIGNEDINTEGER' then lUnsigned := true;
621
if (lTmpStr='FLOAT') or (lTmpStr='SHORTFLOAT') or (lTmpStr='LONGFLOAT') then begin //1395
622
lFloat := true;
623
end;
624
end;
625
if lUpCaseStr ='NAMEOFDATAFILE' then lFileName := ExtractFilePath(lFileName)+readInterStr;
626
if lUpCaseStr ='NUMBEROFBYTESPERPIXEL' then
627
lDicomData.Allocbits_per_pixel := round(readInterFloat)*8;
628
if (lUpCaseStr ='SCALINGFACTOR(MM/PIXEL)[1]') or (lUpCaseStr ='SCALINGFACTOR(MM/PIXEL)[X]') then
629
lDicomData.XYZmm[1] := (readInterFloat);
630
if (lUpCaseStr ='SCALINGFACTOR(MM/PIXEL)[2]') or (lUpCaseStr ='SCALINGFACTOR(MM/PIXEL)[Y]')then lDicomData.XYZmm[2] := (readInterFloat);
631
if (lUpCaseStr ='SCALINGFACTOR(MM/PIXEL)[3]')or (lUpCaseStr ='SCALINGFACTOR(MM/PIXEL)[Z]')or (lUpCaseStr ='SLICETHICKNESS')then lDicomData.XYZmm[3] := (readInterFloat);
632
if (lUpCaseStr ='ENDOFINTERFILE') then lHdrEnd := true;
633
if not lHdrOK then goto 333;
634
if lInStr <> '' then
635
lDynStr := lDynStr + lInStr+kCr;
636
lHdrOK := true;
637
until (linPos >= FileSz) or (lHdrEnd){EOF(fp)};
638
//xlDicomData.Storedbits_per_pixel := lDicomData.Allocbits_per_pixel;
639
lImageFormatOK := true;
640
if (not lFLoat) and (lUnsigned) and ((lDicomData.Allocbits_per_pixel = 16)) then begin
641
Msg('Warning: this Interfile image uses UNSIGNED 16-bit data [values 0..65535]. Analyze specifies SIGNED 16-bit data [-32768..32767]. Some images may not transfer well. [Future versions of MRIcro should fix this].');
642
lImageFormatOK := false;
643
end else if (not lFLoat) and (lDicomData.Allocbits_per_pixel > 16) then begin
644
Msg('WARNING: The image '+lFileName+' is a '+inttostr(lDicomData.Allocbits_per_pixel)+'-bit integer data type. This software may display this as SIGNED data. Bits per voxel: '+inttostr(lDicomData.Allocbits_per_pixel));
645
lImageFormatOK := false;
646
end else if (lFloat) then begin //zebra change float check
647
//Msg('WARNING: The image '+lFileName+' uses floating point [real] numbers. The current software can only read integer data type Interfile images.');
648
lDicomData.Float := true;
649
//lImageFormatOK := false;
650
end;
651
333:
652
FreeMem( lCharRA);
653
end; //interfile
654
655
656
657
//afni start
658
function ParseFileName (lFilewExt:String): string;
659
var
660
lLen,lInc: integer;
661
lName: String;
662
begin
663
lName := '';
664
lLen := length(lFilewExt);
665
lInc := lLen+1;
666
if lLen > 0 then
667
repeat
668
dec(lInc);
669
until (lFileWExt[lInc] = '.') or (lInc = 1);
670
if lInc > 1 then
671
for lLen := 1 to (lInc - 1) do
672
lName := lName + lFileWExt[lLen]
673
else
674
lName := lFilewExt; //no extension
675
ParseFileName := lName;
676
end;
677
678
procedure read_afni_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string; var lRotation1,lRotation2,lRotation3: integer);
679
//label 333;
680
const UNIXeoln = chr(10);
681
kTab = ord(chr(9));
682
kSpace = ord(' ');
683
var lTmpStr,lInStr,lUpCaseStr: string;
684
lHdrEnd: boolean;
685
lMSBch: char;
686
lOri : array [1..4] of single;
687
lTmpInt,lPos,lLen,FileSz,linPos: integer;
688
fp: file;
689
lCharRA: bytep;
690
procedure readAFNIeoln;
691
begin
692
while (linPos < FileSz) and (lCharRA^[linPos] <> ord(kCR)) and (lCharRA^[linPos] <> ord(UNIXeoln)) do
693
inc(linPos);
694
inc(lInPos); //read EOLN
695
end;
696
function readAFNIFloat:real;
697
var lStr: string;
698
lCh:char;
699
begin
700
lStr := '';
701
while (linPos < FileSz) and ((lStr='') or ((lCharRA^[lInPos] <> kTab) and (lCharRA^[lInPos] <> kSpace))) do begin
702
lCh:= chr(lCharRA^[linPos]);
703
if lCh in ['+','-','e','E','.','0'..'9'] then
704
lStr := lStr+lCh;
705
inc(linPos);
706
end;
707
if lStr = '' then exit;
708
try
709
result := strtofloat(lStr);
710
except
711
on EConvertError do begin
712
Msg('Unable to convert the string '+lStr+' to a number');
713
result := 1;
714
exit;
715
end;
716
end; {except}
717
end;
718
begin
719
lHdrOK := false;
720
lImageFormatOK := true;
721
Clear_Dicom_Data(lDicomData);
722
lDynStr := '';
723
lTmpStr := string(StrUpper(PChar(ExtractFileExt(lFileName))));
724
if lTmpStr <> '.HEAD' then exit;
725
for lInPos := 1 to 3 do
726
lOri[lInPos] := -6666;
727
FileMode := 0; //set to readonly
728
AssignFile(fp, lFileName);
729
Reset(fp, 1);
730
FileSz := FileSize(fp);
731
lHdrEnd := false;
732
//lDicomData.ImageStart := FileSz;
733
GetMem( lCharRA, FileSz+1 );
734
BlockRead(fp, lCharRA^, FileSz, linpos);
735
if lInPos <> FileSz then Msg('Disk error: Unable to read full input file.');
736
linPos := 1;
737
CloseFile(fp);
738
FileMode := 2; //set to read/write
739
repeat
740
linstr := '';
741
while (linPos < FileSz) and (lCharRA^[linPos] <> ord(kCR)) and (lCharRA^[linPos] <> ord(UNIXeoln)) do begin
742
lInStr := lInstr + chr(lCharRA^[linPos]);
743
inc(linPos);
744
end;
745
inc(lInPos); //read EOLN
746
lLen := length(lInStr);
747
lPos := 1;
748
lUpcaseStr := '';
749
While (lPos <= lLen) do begin
750
if lInStr[lPos] in ['_','[',']','(',')','/','+','-','=',{' ',} '0'..'9','a'..'z','A'..'Z'] then
751
lUpCaseStr := lUpCaseStr+upcase(linStr[lPos]);
752
inc(lPos);
753
end;
754
inc(lPos); {read equal sign in := statement}
755
if lUpCaseStr ='NAME=DATASET_DIMENSIONS'then begin
756
lImageFormatOK := true;
757
lHdrOK := true;
758
lFileName := parsefilename(lFilename)+'.BRIK'; //always UPPERcase
759
readAFNIeoln;
760
lDICOMdata.XYZdim[1] := round(readAFNIFloat);
761
lDICOMdata.XYZdim[2] := round(readAFNIFloat);
762
lDICOMdata.XYZdim[3] := round(readAFNIFloat);
763
//lDicomData.ImageStart := 2048 * round(readInterFloat);
764
end;
765
if lUpCaseStr ='NAME=BRICK_FLOAT_FACS'then begin
766
readAFNIeoln;
767
lDICOMdata.IntenScale := readAFNIFloat; //1380 read slope of intensity
768
end;
769
if lUpCaseStr ='NAME=DATASET_RANK'then begin
770
readAFNIeoln;
771
//2nd value is number of volumes
772
readAFNIFloat;
773
lDICOMdata.XYZdim[4] := round(readAFNIFloat);
774
end;
775
if lUpCaseStr ='NAME=BRICK_TYPES'then begin
776
readAFNIeoln;
777
lTmpInt := round(readAFNIFloat);
778
case lTmpInt of
779
0:lDicomData.Allocbits_per_pixel := 8;
780
1:begin
781
lDicomData.Allocbits_per_pixel := 16;
782
//lDicomData.MaxIntensity := 65535; //Old AFNI were UNSIGNED, new ones are SIGNED???
783
end;
784
3:begin
785
lDicomData.Allocbits_per_pixel := 32;
786
lDicomData.Float := true;
787
end;
788
else begin
789
lHdrEnd := true;
790
Msg('Unsupported AFNI BRICK_TYPES: '+inttostr(lTmpInt));
791
end;
792
793
end; //case
794
{datatype
795
0 = byte (unsigned char; 1 byte)
796
1 = short (2 bytes, signed)
797
3 = float (4 bytes, assumed to be IEEE format)
798
5 = complex (8 bytes: real+imaginary parts)}
799
end;
800
if lUpCaseStr ='NAME=BYTEORDER_STRING'then begin
801
readAFNIeoln;
802
if ((linPos+2) < FileSz) then begin
803
lMSBch := chr(lCharRA^[linPos+1]);
804
if lMSBCh = 'L' then lDicomData.Little_Endian := 1;
805
if lMSBCh = 'M' then begin
806
lDicomData.Little_Endian := 0;
807
end;
808
linPos := lInPos + 2;
809
end;
810
//littleendian
811
end;
812
if lUpCaseStr ='NAME=ORIGIN'then begin
813
readAFNIeoln;
814
lOri[1] := (abs(readAFNIFloat));
815
lOri[2] := (abs(readAFNIFloat));
816
lOri[3] := (abs(readAFNIFloat));
817
//Xori,YOri,ZOri
818
end;
819
if lUpCaseStr ='NAME=DELTA'then begin
820
readAFNIeoln;
821
lDICOMdata.XYZmm[1] := abs(readAFNIFloat);
822
lDICOMdata.XYZmm[2] := abs(readAFNIFloat);
823
lDICOMdata.XYZmm[3] := abs(readAFNIFloat);
824
825
//Xmm,Ymm,Zmm
826
end;
827
if lUpCaseStr ='NAME=ORIENT_SPECIFIC'then begin
828
readAFNIeoln;
829
lRotation1 := round(readAFNIFloat);
830
lRotation2 := round(readAFNIFloat);
831
lRotation3 := round(readAFNIFloat);
832
end; //ORIENT_SPECIFIC rotation details
833
if lInStr <> '' then
834
lDynStr := lDynStr + lInStr+kCr;
835
until (linPos >= FileSz) or (lHdrEnd){EOF(fp)};
836
//xlDicomData.Storedbits_per_pixel := lDicomData.Allocbits_per_pixel;
837
for lInPos := 1 to 3 do begin
838
if lOri[lInPos] < -6666 then //value not set
839
lDICOMdata.XYZori[lInPos] := round((1.0+lDICOMdata.XYZdim[lInPos])/2)
840
else if lDICOMdata.XYZmm[lInPos] <> 0 then
841
lDICOMdata.XYZori[lInPos] := round(1.5+lOri[lINPos] / lDICOMdata.XYZmm[lInPos]);
842
end;
843
// lDicomData.Float := true;
844
FreeMem( lCharRA);
845
end; //interfile
846
//afni end
847
//voxbo start
848
procedure read_voxbo_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string);
849
label 333;
850
const UNIXeoln = chr(10);
851
kTab = chr(9);
852
var lTmpStr,lInStr,lUpCaseStr: string;
853
lFileTypeKnown,lHdrEnd,lFloat: boolean;
854
lStartPos,lPos,lLen,FileSz,linPos: integer;
855
fp: file;
856
lCharRA: bytep;
857
procedure readVBfloats (var lF1,lF2,lF3: double);
858
// While (lPos <= lLen) and ((lInStr[lPos] = kTab) or (lInStr[lPos] = ' ')) do begin
859
// inc(lPos);
860
var //lDigit : boolean;
861
n,lItemIndex: integer;
862
lStr,lfStr: string;
863
begin
864
lf1 := 1;
865
lf2 := 1;
866
lf3 := 1;
867
n := 0;
868
for lItemIndex := 1 to 3 do begin
869
inc(n);
870
While (lPos <= lLen) and ((lInStr[lPos] = kTab) or (lInStr[lPos] = ' ')) do
871
inc(lPos);
872
if lPos > lLen then
873
exit;
874
lStr := '';
875
repeat
876
lStr := lStr+upcase(linStr[lPos]);
877
inc(lPos);
878
until (lPos > lLen) or (lInStr[lPos] = kTab) or (lInStr[lPos] = ' ');
879
if lStr <> '' then begin //string to convert
880
try
881
case n of
882
1: lF1 := strtofloat(lStr);
883
2: lF2 := strtofloat(lStr);
884
3: lF3 := strtofloat(lStr);
885
end;
886
except
887
on EConvertError do begin
888
Msg('Unable to convert the string '+lfStr+' to a real number');
889
exit;
890
end;
891
end; {except}
892
end; //if string to convert
893
end;
894
end;
895
896
procedure readVBints (var lI1,lI2,lI3: integer);
897
var lF1,lF2,lF3: double;
898
begin
899
readVBfloats (lF1,lF2,lF3);
900
lI1 := round(lF1);
901
lI2 := round(lF2);
902
lI3 := round(lF3);
903
end;
904
function readVBStr:string;
905
var lStr: string;
906
begin
907
lStr := '';
908
While (lPos <= lLen) and ((lInStr[lPos] = kTab) or (lInStr[lPos] = ' ')) do begin
909
inc(lPos);
910
end;
911
While (lPos <= lLen) {and (lInStr[lPos] <> ';')} do begin
912
lStr := lStr+upcase(linStr[lPos]); //zebra upcase
913
inc(lPos);
914
end;
915
result := lStr;
916
end; //interstr func
917
begin
918
lHdrOK := false;
919
lFloat := false;
920
lImageFormatOK := true;
921
Clear_Dicom_Data(lDicomData);
922
lDynStr := '';
923
FileMode := 0; //set to readonly
924
AssignFile(fp, lFileName);
925
Reset(fp, 1);
926
FileSz := FileSize(fp);
927
lHdrEnd := false;
928
//lDicomData.ImageStart := FileSz;
929
GetMem( lCharRA, FileSz+1 );
930
BlockRead(fp, lCharRA^, FileSz, linpos);
931
if lInPos <> FileSz then Msg('Disk error: Unable to read full input file.');
932
linPos := 1;
933
CloseFile(fp);
934
FileMode := 2; //set to read/write
935
lFileTypeKnown := false;
936
repeat
937
linstr := '';
938
939
while (linPos < FileSz) and (lCharRA^[linPos] <> ord(kCR)) and (lCharRA^[linPos] <> ord(UNIXeoln)) do begin
940
lInStr := lInstr + chr(lCharRA^[linPos]);
941
inc(linPos);
942
end;
943
inc(lInPos); //read EOLN
944
lLen := length(lInStr);
945
lPos := 1;
946
lUpcaseStr := '';
947
While (lPos <= lLen) and (lInStr[lPos] <> ':') do begin
948
if lInStr[lPos] in ['[',']','(',')','/','+','-', '0'..'9','a'..'z','A'..'Z'] then
949
lUpCaseStr := lUpCaseStr+upcase(linStr[lPos]);
950
inc(lPos);
951
end;
952
inc(lPos); {read equal sign in := statement}
953
if (lHdrOK) and (not lFileTypeKnown) and (lUpCaseStr = 'CUB1') then
954
lFileTypeKnown := true;
955
if (lHdrOK) and (not lFileTypeKnown) then begin
956
Msg('This software can not read this kind of VoxBo image. (Type:"'+lUpCaseStr+'")');
957
lHdrEnd := true;
958
lHdrOK := false;
959
end;
960
if (not lHdrOK) and (lUpCaseStr ='VB98') then begin
961
lDicomData.little_endian := 0;//all VoxBo files are Big Endian!
962
lStartPos := linPos;
963
lFileTypeKnown := true; //test for While Loop
964
while (linPos < FileSz) and lFileTypeKnown do begin
965
if (lCharRA^[linPos-1] = $0C) and (lCharRA^[linPos] = $0A) then begin
966
lFileTypeKnown := false;
967
lDicomData.ImageStart := linPos;
968
FileSz := linPos; //size of VoxBo header
969
end;
970
inc(linPos);
971
end;
972
if lFileTypeKnown then begin //end of file character not found: abort!
973
Msg('Unable to find the end of the VoxBo header.');
974
lHdrEnd := true
975
end else
976
lHdrOK := true;
977
linPos := lStartPos; //now that we have found the header size, we can start from the beginning of the header
978
end;
979
if not lHdrOK then lHdrEnd := true;
980
if (lUpCaseStr ='BYTEORDER') and (readVBStr = 'LSBFIRST') then
981
lDicomData.little_endian := 1;
982
if lUpCaseStr ='DATATYPE'then begin
983
lTmpStr := readVBStr;
984
if lTmpStr = 'Byte' then
985
lDicomData.Allocbits_per_pixel := 8
986
else if (lTmpStr = 'INTEGER') or (lTmpStr = 'INT16') then
987
lDicomData.Allocbits_per_pixel := 16
988
else if (lTmpStr = 'LONG') or (lTmpStr = 'INT32') then
989
lDicomData.Allocbits_per_pixel := 32
990
else if (lTmpStr = 'FLOAT') then begin
991
lFloat := true;
992
lDicomData.Allocbits_per_pixel := 32;
993
end else if (lTmpStr = 'DOUBLE') then begin
994
lFloat := true;
995
lDicomData.Allocbits_per_pixel := 64;
996
end else begin
997
Msg('Unknown VoxBo data format: '+lTmpStr);
998
end;
999
end;
1000
if lUpCaseStr ='VOXDIMS(XYZ)'then readVBints(lDicomData.XYZdim[1],lDicomData.XYZdim[2],lDicomData.XYZdim[3]);
1001
if (lUpCaseStr ='VOXSIZES(XYZ)') then readVBfloats(lDicomData.XYZmm[1],lDicomData.XYZmm[2],lDicomData.XYZmm[3]);
1002
if (lUpCaseStr ='ORIGIN(XYZ)')then begin
1003
readVBints(lDicomData.XYZori[1],lDicomData.XYZori[2],lDicomData.XYZori[3]);
1004
inc(lDicomData.XYZori[1]);//1393
1005
inc(lDicomData.XYZori[2]);//1393
1006
inc(lDicomData.XYZori[3]);//1393
1007
end;
1008
if not lHdrOK then goto 333;
1009
if lInStr <> '' then
1010
lDynStr := lDynStr + lInStr+kCr;
1011
until (linPos >= FileSz) or (lHdrEnd){EOF(fp)};
1012
//xlDicomData.Storedbits_per_pixel := lDicomData.Allocbits_per_pixel;
1013
//xlDicomData.Rotate180deg := true;
1014
lImageFormatOK := true;
1015
if (lFloat) then begin //zebra change float check
1016
lDicomData.Float := true;
1017
//lImageFormatOK := false;
1018
end;
1019
333:
1020
FreeMem( lCharRA);
1021
end;
1022
//voxbo end
1023
1024
procedure read_vff_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string);
1025
label 333;
1026
const UNIXeoln = chr(10);
1027
var lInStr,lUpCaseStr: string;
1028
//lHdrEnd: boolean;
1029
lPos,lLen,FileSz,linPos: integer;
1030
lDummy1,lDummy2,lDummy3 : double;
1031
fp: file;
1032
lCharRA: bytep;
1033
procedure readVFFvals (var lFloat1,lFloat2,lFloat3: double);
1034
var lStr: string;
1035
lDouble: DOuble;
1036
lInc: integer;
1037
begin
1038
for lInc := 1 to 3 do begin
1039
lStr := '';
1040
While (lPos <= lLen) and (lInStr[lPos] = ' ') do begin
1041
inc(lPos);
1042
end;
1043
While (lPos <= lLen) and (lInStr[lPos] <> ';') and (lInStr[lPos] <> ' ') do begin
1044
if lInStr[lPos] in ['+','-','e','E','.','0'..'9'] then
1045
lStr := lStr+(linStr[lPos]);
1046
inc(lPos);
1047
end;
1048
if lStr <> '' then begin
1049
try
1050
lDouble := strtofloat(lStr);
1051
except
1052
on EConvertError do begin
1053
Msg('Unable to convert the string '+lStr+' to a number');
1054
exit;
1055
end;
1056
end; {except}
1057
case lInc of
1058
2: lFloat2 := lDouble;
1059
3: lFloat3 := lDouble;
1060
else lFloat1 := lDouble;
1061
end;
1062
end; //lStr <> ''
1063
end; //lInc 1..3
1064
end; //interstr func
1065
begin
1066
lHdrOK := false;
1067
lImageFormatOK := true;
1068
Clear_Dicom_Data(lDicomData);
1069
lDicomData.little_endian := 0; //big-endian
1070
lDynStr := '';
1071
FileMode := 0; //set to readonly
1072
AssignFile(fp, lFileName);
1073
Reset(fp, 1);
1074
FileSz := FileSize(fp);
1075
if FileSz > 2047 then FileSz := 2047;
1076
GetMem( lCharRA, FileSz+1 );
1077
BlockRead(fp, lCharRA^, FileSz, linpos);
1078
if lInPos <> FileSz then Msg('Disk error: Unable to read full input file.');
1079
lInPos := 1;
1080
while (lCharRA^[lInPos] <> 12) and (lInPos < FileSz) do begin
1081
inc(lInPos);
1082
end;
1083
inc(lInPos);
1084
if (lInPos >= FileSz) or (lInPos < 12) then goto 333; //unable to find
1085
lDynStr := lDynStr + 'Sun VFF Volume File Format'+kCr;
1086
lDicomData.ImageStart := lInPos;
1087
FileSz := lInPos-1;
1088
linPos := 1;
1089
CloseFile(fp);
1090
FileMode := 2; //set to read/write
1091
repeat
1092
linstr := '';
1093
while (linPos < FileSz) and (lCharRA^[linPos] <> ord(kCR)) and (lCharRA^[linPos] <> ord(UNIXeoln)) do begin
1094
lInStr := lInstr + chr(lCharRA^[linPos]);
1095
inc(linPos);
1096
end;
1097
inc(lInPos); //read EOLN
1098
lLen := length(lInStr);
1099
lPos := 1;
1100
lUpcaseStr := '';
1101
While (lPos <= lLen) and (lInStr[lPos] <> ';') and (lInStr[lPos] <> '=') and (lUpCaseStr <>'NCAA') do begin
1102
if lInStr[lPos] in ['[',']','(',')','/','+','-',{' ',} '0'..'9','a'..'z','A'..'Z'] then
1103
lUpCaseStr := lUpCaseStr+upcase(linStr[lPos]);
1104
inc(lPos);
1105
end;
1106
inc(lPos); {read equal sign in := statement}
1107
if lUpCaseStr ='NCAA' then begin
1108
lHdrOK := true;
1109
end;
1110
if lUpCaseStr ='BITS' then begin
1111
lDummy1 := 8;
1112
readVFFvals(lDummy1,lDummy2,lDummy3);
1113
lDicomData.Allocbits_per_pixel := round(lDummy1);
1114
end;
1115
if lUpCaseStr ='SIZE' then begin
1116
lDummy1 := 1; lDummy2 := 1; lDummy3 := 1;
1117
readVFFvals(lDummy1,lDummy2,lDummy3);
1118
lDicomData.XYZdim[1] := round(lDummy1);
1119
lDicomData.XYZdim[2] := round(lDummy2);
1120
lDicomData.XYZdim[3] := round(lDummy3);
1121
end;
1122
if lUpCaseStr ='ASPECT' then begin
1123
lDummy1 := 1; lDummy2 := 1; lDummy3 := 1;
1124
readVFFvals(lDummy1,lDummy2,lDummy3);
1125
lDicomData.XYZmm[1] := (lDummy1);
1126
lDicomData.XYZmm[2] := (lDummy2);
1127
lDicomData.XYZmm[3] := (lDummy3);
1128
end;
1129
if not lHdrOK then goto 333;
1130
if lInStr <> '' then
1131
lDynStr := lDynStr + lInStr+kCr;
1132
//lHdrOK := true;
1133
until (linPos >= FileSz);
1134
//xlDicomData.Storedbits_per_pixel := lDicomData.Allocbits_per_pixel;
1135
lImageFormatOK := true;
1136
333:
1137
FreeMem( lCharRA);
1138
end;
1139
//********************************************************************
1140
(*procedure ShellSortItems (first, last: integer; var lPositionRA, lIndexRA: LongintP; var lRepeatedValues: boolean);
1141
{Shell sort chuck uses this- see 'Numerical Recipes in C' for similar sorts.}
1142
label
1143
555;
1144
const
1145
tiny = 1.0e-5;
1146
aln2i = 1.442695022;
1147
var
1148
n,t, nn, m, lognb2, l, k, j, i: longint;
1149
begin
1150
lRepeatedValues := false;
1151
n := abs(last - first + 1);
1152
lognb2 := trunc(ln(n) * aln2i + tiny);
1153
m := last;
1154
for nn := 1 to lognb2 do
1155
begin
1156
m := m div 2;
1157
k := last - m;
1158
for j := 1 to k do begin
1159
i := j;
1160
555: {<- LABEL}
1161
l := i + m;
1162
if (lIndexRA^[lPositionRA^[l]] = lIndexRA^[lPositionRA^[i]]) then begin
1163
lRepeatedValues := true;
1164
exit;
1165
end;
1166
if (lIndexRA^[lPositionRA^[l]] < lIndexRA^[lPositionRA^[i]]) then begin
1167
//swap values for i and l
1168
t := lPositionRA^[i];
1169
lPositionRA^[i] := lPositionRA^[l];
1170
lPositionRA^[l] := t;
1171
i := i - m;
1172
if (i >= 1) then
1173
goto 555;
1174
end
1175
end
1176
end
1177
end; //shellsort is fast and requires less memory than quicksort *)
1178
1179
1180
(*procedure PAR2DICOMstudyDate(var lDicomData: DICOMdata);
1181
{input: lDicomData.StudyDate = 2002.12.29 / 19:48:58.0000
1182
output: StudyDate = YYYYMMDD StudyTime= hhmmss }
1183
var
1184
I: integer;
1185
lStr: string;
1186
begin
1187
if length(lDicomData.StudyDate) < 14 then exit;
1188
lStr := '';
1189
for I := 1 to length(lDicomData.StudyDate) do
1190
if lDicomData.StudyDate[I] in ['0'..'9'] then
1191
lStr := lStr+ lDicomData.StudyDate[I];
1192
if length(lStr) < 14 then exit;
1193
lDicomData.StudyDate := '';
1194
for I := 1 to 8 do
1195
lDicomData.StudyDate := lDicomData.StudyDate+lStr[I];
1196
lDicomData.StudyTime := '';
1197
for I := 9 to 14 do
1198
lDicomData.StudyTime := lDicomData.StudyTime+lStr[I];
1199
lDicomData.PatientIDInt := StudySecSince2K(lDicomData.StudyDate,lDicomData.StudyTime);
1200
end;
1201
type tRange = record
1202
Min,Val,Max: double; //some vals are ints, others floats
1203
end;
1204
1205
procedure read_PAR_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK:boolean; var lDynStr: string;var lFileName: string; lReadOffsetTables: boolean; var lOffset_pos_table: LongIntp; var lOffsetTableEntries: integer; lReadVaryingScaleFactors: boolean; var lVaryingScaleFactors_table,lVaryingIntercept_table: Singlep; var lVaryingScaleFactorsTableEntries,lnum4Ddatasets: integer);
1206
label 333; //1384 now reads up to 8 dimensional data....
1207
const UNIXeoln = chr(10);
1208
kMaxnSLices = 32000;
1209
kXdim = 1;
1210
kYdim = 2;
1211
kBitsPerVoxel = 3;
1212
kSliceThick = 4;
1213
kSliceGap = 5;
1214
kXmm = 6;
1215
kYmm = 7;
1216
kSlope = 8;
1217
kIntercept = 9;
1218
kCalibratedSlope = 10; //1393 - attempt to use calibrated values
1219
kDynTime = 11;
1220
kSlice = 12;
1221
kEcho = 13;
1222
kDyn = 14;
1223
kCardiac = 15;
1224
kType = 16;
1225
kSequence = 17;
1226
kIndex = 18;
1227
lIsParVers3x: boolean = true;
1228
lRepeatedValues : boolean = false;
1229
lSlicesNotInSequence: boolean = false;
1230
lMaxSlice : integer = 0;
1231
var
1232
lErrorStr,lInStr,lUpCaseStr,lReportedTRStr: string;
1233
lSliceSequenceRA,lSortedSliceSequence: LongintP;
1234
lSliceIndexRA: array [1..kMaxnSlices] of Longint;
1235
lSliceSlopeRA,lSliceInterceptRA,lCalibratedSliceSlopeRA: array [1..kMaxnSlices] of single;
1236
lSliceHeaderRA: array [1..32] of double;
1237
lRangeRA: array [kXdim..kIndex] of tRange;
1238
lMaxIndex,lSliceSz,lSliceInfoCount,lPos,lLen,lFileSz,lHdrPos,linPos,lInc: LongInt;
1239
fp: file;
1240
lCharRA: bytep;
1241
1242
procedure MinMaxTRange (var lDimension: tRange; lNewVal: double); //nested
1243
begin
1244
lDimension.Val := lNewVal;
1245
if lSliceInfoCount < 2 then begin
1246
lDimension.Min := lDimension.Val;
1247
lDimension.Max := lDimension.Val;
1248
end;
1249
if lNewVal < lDimension.Min then lDimension.Min := lNewVal;
1250
if lNewVal > lDimension.Max then lDimension.Max := lNewVal;
1251
end; //nested InitTRange proc
1252
1253
function readParStr:string;//nested
1254
var lStr: string;
1255
begin
1256
lStr := '';
1257
While (lPos <= lLen) do begin
1258
if (lStr <> '') or (linStr[lPos]<>' ') then //strip leading spaces
1259
lStr := lStr+(linStr[lPos]);
1260
inc(lPos);
1261
end; //while lPOs < lLen
1262
result := lStr;
1263
end; //nested func ReadParStr
1264
function readParFloat:double;//nested
1265
var lStr: string;
1266
begin
1267
lStr := '';
1268
result := 1;
1269
While (lPos <= lLen) and ((lStr='') or(lInStr[lPos] <> ' ')) do begin
1270
if lInStr[lPos] in ['+','-','e','E','.','0'..'9'] then
1271
lStr := lStr+(linStr[lPos]);
1272
inc(lPos);
1273
end;
1274
if lStr = '' then exit;
1275
try
1276
result := strtofloat(lStr);
1277
except
1278
on EConvertError do begin
1279
Msg('read_PAR_data: Unable to convert the string '+lStr+' to a number');
1280
result := 1;
1281
exit;
1282
end;
1283
end; {except}
1284
end; //nested func ReadParFloat
1285
begin
1286
//Initialize parameters
1287
lnum4Ddatasets := 1;
1288
lSliceInfoCount := 0;
1289
for lInc := kXdim to kIndex do //initialize all values: important as PAR3 will not explicitly report all
1290
MinMaxTRange(lRangeRA[lInc],0);
1291
lHdrOK := false;
1292
lImageFormatOK := false;
1293
lIsParVers3x := true;
1294
lOffsetTableEntries := 0;
1295
lVaryingScaleFactorsTableEntries := 0;
1296
Clear_Dicom_Data(lDicomData);
1297
lDynStr := '';
1298
//Read text header to buffer (lCharRA)
1299
FileMode := 0; //set to readonly
1300
AssignFile(fp, lFileName);
1301
Reset(fp, 1);
1302
lFileSz := FileSize(fp);
1303
GetMem( lCharRA, lFileSz+1 ); //note: must free dynamic memory: goto 333 if any error
1304
GetMem (lSliceSequenceRA, kMaxnSLices*sizeof(longint)); //note: must free dynamic memory: goto 333 if any error
1305
BlockRead(fp, lCharRA^, lFileSz, lInpos);
1306
if lInPos <> lFileSz then begin
1307
Msg('read_PAR_data: Disk error, unable to read full input file.');
1308
goto 333;
1309
end;
1310
linPos := 1;
1311
CloseFile(fp);
1312
FileMode := 2; //set to read/write
1313
//Next: read each line of header file...
1314
repeat //for each line in file....
1315
linstr := '';
1316
while (linPos < lFileSz) and (lCharRA^[linPos] <> ord(kCR)) and (lCharRA^[linPos] <> ord(UNIXeoln)) do begin
1317
lInStr := lInstr + chr(lCharRA^[linPos]);
1318
inc(linPos);
1319
end;
1320
inc(lInPos); //read EOLN
1321
lLen := length(lInStr);
1322
lPos := 1;
1323
lUpcaseStr := '';
1324
if lLen < 1 then
1325
//ignore blank lines
1326
else if (lInStr[1] = '*') and (not lHdrOK) then //# -> comment
1327
//ignore comment lines prior to start of header
1328
else if (lInStr[1] = '#') and (lHdrOK) then //# -> comment
1329
//ignore comment lines
1330
else if (lInStr[1] = '.') or (not lHdrOK) then begin // GENERAL_INFORMATION section (line starts with '.')
1331
//Note we also read in lines that do not have '.' if we have HdrOK=false, this allows us to detect the DATADESCRIPTIONFILE signature
1332
While (lPos <= lLen) and (lInStr[lPos] <> ':') and ((not lHdrOK) or (lInStr[lPos] <> '#')) do begin
1333
if lInStr[lPos] in ['[',']','(',')','/','+','-',{' ',} '0'..'9','a'..'z','A'..'Z'] then
1334
lUpCaseStr := lUpCaseStr+upcase(linStr[lPos]);
1335
inc(lPos);
1336
end; //while reading line
1337
inc(lPos); {read equal sign in := statement}
1338
lDynStr := lDynStr + lInStr+kCR;
1339
if (not lHdrOK) and (lUpcaseStr = ('DATADESCRIPTIONFILE')) then begin //1389 PAR file
1340
lHdrOK := true;
1341
lDicomData.little_endian := 1;
1342
end;
1343
1344
1345
1346
if (lUpCaseStr ='REPETITIONTIME[MSEC]') then
1347
lDicomData.TR := round(readParFloat);
1348
if (lUpCaseStr ='MAXNUMBEROFSLICES/LOCATIONS') then
1349
lDicomData.XYZdim[3] := round(readParFloat);
1350
if (lUpCaseStr ='SLICETHICKNESS[MM]') then
1351
MinMaxTRange(lRangeRA[kSliceThick],readParFloat);
1352
if (lUpCaseStr ='SLICEGAP[MM]') then
1353
MinMaxTRange(lRangeRA[kSliceGap],readParFloat);
1354
if lUpCaseStr = 'RECONRESOLUTION(XY)' then begin
1355
MinMaxTRange(lRangeRA[kXdim],readParFloat);
1356
MinMaxTRange(lRangeRA[kYdim],readParFloat);
1357
end;
1358
if lUpCaseStr = 'RECONSTRUCTIONNR' then
1359
lDicomData.AcquNum := round(readParFloat);
1360
if lUpCaseStr = 'ACQUISITIONNR' then
1361
lDicomData.SeriesNum := round(readParFloat);
1362
if lUpCaseStr = 'MAXNUMBEROFDYNAMICS' then begin
1363
lDicomData.XYZdim[4] := round(readParFloat);
1364
end;
1365
if lUpCaseStr = 'EXAMINATIONDATE/TIME' then begin
1366
lDicomData.StudyDate := readParStr;
1367
PAR2DICOMstudyDate(lDicomData);
1368
end;
1369
//if lUpCaseStr = 'PROTOCOLNAME' then
1370
// lDicomData.modality := readParStr;
1371
if lUpCaseStr = 'PATIENTNAME' then
1372
lDicomData.PatientName := readParStr;
1373
if lUpCaseStr ='IMAGEPIXELSIZE[8OR16BITS]' then begin
1374
MinMaxTRange(lRangeRA[kBitsPerVoxel],readParFloat);
1375
end;
1376
if not lHdrOK then begin
1377
Msg('read_PAR_data: Error reading header');
1378
goto 333;
1379
end;
1380
end else begin //SliceInfo: IMAGE_INFORMATION (line does NOT start with '.' or '#')
1381
inc(lSliceInfoCount);
1382
if (lSliceInfoCount < 2) and (lRangeRA[kBitsPerVoxel].val < 1) then //PARvers3 has imagedepth in general header, only in image header for later versions
1383
lIsParVers3x := false;
1384
for lHdrPos := 1 to 26 do
1385
lSliceHeaderRA[lHdrPos] := readparfloat;
1386
//The next few values are in the same location for both PAR3 and PAR4
1387
MinMaxTRange(lRangeRA[kSlice], round(lSliceHeaderRA[1]));
1388
MinMaxTRange(lRangeRA[kEcho], round(lSliceHeaderRA[2]));
1389
MinMaxTRange(lRangeRA[kDyn], round(lSliceHeaderRA[3]));
1390
MinMaxTRange(lRangeRA[kCardiac], round(lSliceHeaderRA[4]));
1391
MinMaxTRange(lRangeRA[kType], round(lSliceHeaderRA[5]));
1392
MinMaxTRange(lRangeRA[kSequence], round(lSliceHeaderRA[6]));
1393
MinMaxTRange(lRangeRA[kIndex], round(lSliceHeaderRA[7]));
1394
if lIsParVers3x then begin //Read PAR3 data
1395
MinMaxTRange(lRangeRA[kIntercept], lSliceHeaderRA[8]);; //8=intercept in PAR3
1396
MinMaxTRange(lRangeRA[kSlope],lSliceHeaderRA[9]); //9=slope in PAR3
1397
MinMaxTRange(lRangeRA[kCalibratedSlope],lSliceHeaderRA[10]); //10=lcalibrated slope in PAR3 1393 - attempt to use calibrated values
1398
MinMaxTRange(lRangeRA[kXmm],lSliceHeaderRA[23]); //23 PIXEL SPACING X in PAR3
1399
MinMaxTRange(lRangeRA[kYmm],lSliceHeaderRA[24]); //24 PIXEL SPACING Y IN PAR3
1400
MinMaxTRange(lRangeRA[kDynTime],(lSliceHeaderRA[26])); //26= dyn_scan_begin_time in PAR3
1401
end else begin //not PAR: assume PAR4
1402
for lHdrPos := 27 to 32 do
1403
lSliceHeaderRA[lHdrPos] := readparfloat;
1404
MinMaxTRange(lRangeRA[kBitsPerVoxel],lSliceHeaderRA[8]);//8 BITS in PAR4
1405
MinMaxTRange(lRangeRA[kXdim], lSliceHeaderRA[10]); //10 XDim in PAR4
1406
MinMaxTRange(lRangeRA[kYdim], lSliceHeaderRA[11]); //11 YDim in PAR4
1407
MinMaxTRange(lRangeRA[kIntercept],lSliceHeaderRA[12]); //12=intercept in PAR4
1408
MinMaxTRange(lRangeRA[kSlope],lSliceHeaderRA[13]); //13=lslope in PAR4
1409
MinMaxTRange(lRangeRA[kCalibratedSlope],lSliceHeaderRA[14]); //14=lcalibrated slope in PAR4 1393 - attempt to use calibrated values
1410
MinMaxTRange(lRangeRA[kSliceThick],lSliceHeaderRA[23]);//23 SLICE THICK in PAR4
1411
MinMaxTRange(lRangeRA[kSliceGap], lSliceHeaderRA[24]); //24 SLICE GAP in PAR4
1412
MinMaxTRange(lRangeRA[kXmm],lSliceHeaderRA[29]); //29 PIXEL SPACING X in PAR4
1413
MinMaxTRange(lRangeRA[kYmm],lSliceHeaderRA[30]); //30 PIXEL SPACING Y in PAR4
1414
MinMaxTRange(lRangeRA[kDynTime],(lSliceHeaderRA[32]));//32= dyn_scan_begin_time in PAR4
1415
end; //PAR4
1416
if lSliceInfoCount < kMaxnSlices then begin
1417
lSliceSequenceRA^[lSliceInfoCount] := ( (round(lRangeRA[kSequence].val)+round(lRangeRA[kType].val)+round(lRangeRA[kCardiac].val+lRangeRA[kEcho].val)) shl 24)+(round(lRangeRA[kDyn].val) shl 10)+round(lRangeRA[kSlice].val);
1418
lSliceSlopeRA [lSliceInfoCount] := lRangeRA[kSlope].Val;
1419
lCalibratedSliceSlopeRA [lSliceInfoCount] := lRangeRA[kCalibratedSlope].Val;
1420
lSliceInterceptRA [lSliceInfoCount] := lRangeRA[kIntercept].val;
1421
lSliceIndexRA[lSliceInfoCount]:= round(lRangeRA[kIndex].val);
1422
end;
1423
end; //SliceInfo Line
1424
until (linPos >= lFileSz);//until done reading entire file...
1425
//describe generic DICOM parameters
1426
lDicomData.XYZdim[1] := round(lRangeRA[kXdim].Val);
1427
lDicomData.XYZdim[2] := round(lRangeRA[kYdim].Val);
1428
lDicomData.XYZdim[3] := 1+round(lRangeRA[kSlice].Max-lRangeRA[kSlice].Min);
1429
if (lSliceInfoCount mod lDicomData.XYZdim[3]) <> 0 then
1430
Msg('read_PAR_data: Total number of slices not divisible by number of slices per volume. Reconstruction error?');
1431
if lDicomData.XYZdim[3] > 0 then
1432
lDicomData.XYZdim[4] := lSliceInfoCount div lDicomData.XYZdim[3] //nVolumes = nSlices/nSlicePerVol
1433
else
1434
lDicomData.XYZdim[4] := 1;
1435
1436
lDicomData.XYZmm[1] := lRangeRA[kXmm].Val;
1437
lDicomData.XYZmm[2] := lRangeRA[kYmm].Val;
1438
lDicomData.XYZmm[3] := lRangeRA[kSliceThick].Val+lRangeRA[kSliceGap].Val;
1439
lDicomData.Allocbits_per_pixel := round(lRangeRA[kBitsPerVoxel].Val);
1440
lDicomData.IntenScale := lRangeRA[kSlope].Val;
1441
lDicomData.IntenIntercept := lRangeRA[kIntercept].Val;
1442
if gPARprecise then begin
1443
if (lDicomData.IntenIntercept <> 0) or (lRangeRA[kCalibratedSlope].val = 0) then
1444
Msg('Warning: Unable to save calibrated Philips image intensity (non-zero scaling intercept). Turn off Etc/Options/CalibratedScaling to hide warning.');
1445
if (lRangeRA[kSlope].min = lRangeRA[kSlope].max)
1446
and (lRangeRA[kIntercept].min = lRangeRA[kIntercept].max)
1447
and (lRangeRA[kCalibratedSlope].min = lRangeRA[kCalibratedSlope].max)
1448
and (lDicomData.IntenIntercept = 0) and (lRangeRA[kCalibratedSlope].val <> 0) then
1449
lDicomData.IntenScale := 1 / lRangeRA[kCalibratedSlope].val;
1450
end; //if PARprecise
1451
//Next: report number of Dynamic scans, this allows people to parse DynScans from Type/Cardiac/Echo/Sequence 4D files
1452
lnum4Ddatasets := (round(lRangeRA[kDyn].Max - lRangeRA[kDyn].Min)+1)*lDicomData.XYZdim[3]; //slices in each dynamic session
1453
if ((lSliceInfoCount mod lnum4Ddatasets) = 0) and ((lSliceInfoCount div lnum4Ddatasets) > 1) then
1454
lnum4Ddatasets := (lSliceInfoCount div lnum4Ddatasets) //infer multiple Type/Cardiac/Echo/Sequence
1455
else
1456
lnum4Ddatasets := 1;
1457
//next: Determine actual interscan interval
1458
if (lDicomData.XYZdim[4] > 1) and ((lRangeRA[kDynTime].max-lRangeRA[kDynTime].min)> 0) {1384} then begin
1459
lReportedTRStr := 'Reported TR: '+floattostrf(lDicomData.TR,ffFixed,8,2)+kCR;
1460
lDicomData.TR := (lRangeRA[kDynTime].max-lRangeRA[kDynTime].min) /(lDicomData.XYZdim[4] - 1)*1000; //infer TR in ms
1461
end else
1462
lReportedTRStr :='';
1463
//next: report header details
1464
lDynStr := 'Philips PAR/REC Format' //'PAR/REC Format'
1465
+kCR+ 'Patient name:'+lDicomData.PatientName
1466
+kCR+ 'XYZ dim: ' +inttostr(lDicomData.XYZdim[1])+'/'+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
1467
+kCR+'Volumes: ' +inttostr(lDicomData.XYZdim[4])
1468
+kCR+'XYZ mm: '+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
1469
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2)
1470
+kCR+'TR: '+floattostrf(lDicomData.TR,ffFixed,8,2)
1471
+kCR+lReportedTRStr+kCR+lDynStr;
1472
//if we get here, the header is fine, next steps will see if image format is readable...
1473
lHdrOK := true;
1474
if lSliceInfoCount < 1 then
1475
goto 333;
1476
//next: see if slices are in sequence
1477
lSlicesNotInSequence := false;
1478
if lSliceInfoCount > 1 then begin
1479
lMaxSlice := lSliceSequenceRA^[1];
1480
lMaxIndex := lSliceIndexRA[1];
1481
lInc := 1;
1482
repeat
1483
inc(lInc);
1484
if lSliceSequenceRA^[lInc] < lMaxSlice then //not in sequence if image has lower slice order than previous image
1485
lSlicesNotInSequence := true
1486
else
1487
lMaxSlice := lSliceSequenceRA^[lInc];
1488
if lSliceIndexRA[lInc] < lMaxIndex then //not in sequence if image has lower slice index than previous image
1489
lSlicesNotInSequence := true
1490
else
1491
lMaxIndex := lSliceIndexRA[lInc];
1492
until (lInc = lSliceInfoCount) or (lSlicesNotInSequence);
1493
end; //at least 2 slices
1494
//Next: report any errors
1495
lErrorStr := '';
1496
if (lSlicesNotInSequence) and (not lReadOffsetTables) then
1497
lErrorStr := lErrorStr + ' Slices not saved sequentially [using MRIcro''s ''Philips PAR to Analyze'' command may solve this]'+kCR;
1498
if lSliceInfoCount > kMaxnSlices then
1499
lErrorStr := lErrorStr + ' Too many slices: >'+inttostr(kMaxnSlices)+kCR;
1500
if (not lReadVaryingScaleFactors) and ( (lRangeRA[kSlope].min <> lRangeRA[kSlope].max)
1501
or (lRangeRA[kIntercept].min <> lRangeRA[kIntercept].max)) then
1502
lErrorStr := lErrorStr + ' Differing intensity slope/intercept [using MRIcro''s ''Philips PAR to Analyze'' command may solve this]'+kCR;
1503
if (lRangeRA[kBitsPerVoxel].min <> lRangeRA[kBitsPerVoxel].max) then //5D file space+time+cardiac
1504
lErrorStr := lErrorStr + ' Differing bits per voxel'+kCR;
1505
//if (lRangeRA^[kCardiac].min <> lRangeRA^[kCardiac].max) then //5D file space+time+cardiac
1506
// lErrorStr := lErrorStr + 'Multiple cardiac timepoints'+kCR;
1507
//if (lRangeRA^[kEcho].min <> lRangeRA^[kEcho].max) then //5D file space+time+echo
1508
// lErrorStr := lErrorStr + 'Multiple echo timepoints'+kCR;
1509
if (lRangeRA[kSliceThick].min <> lRangeRA[kSliceThick].max) or (lRangeRA[kSliceGap].min <> lRangeRA[kSliceGap].max)
1510
or (lRangeRA[kXdim].min <> lRangeRA[kXdim].max) or (lRangeRA[kYDim].min <> lRangeRA[kYDim].max)
1511
or (lRangeRA[kXmm].min <> lRangeRA[kXmm].max) or (lRangeRA[kYmm].min <> lRangeRA[kYmm].max) then
1512
lErrorStr := lErrorStr + ' Multiple/varying slice dimensions'+kCR;
1513
//if any errors were encountered, report them....
1514
if lErrorStr <> '' then begin
1515
Msg('read_PAR_data: This software can not convert this Philips data:'+kCR+lErrorStr);
1516
goto 333;
1517
end;
1518
//Next sort image indexes here...
1519
if (lSliceInfoCount > 1) and(lSlicesNotInSequence) and ( lReadOffsetTables) then begin //sort image order...
1520
//ShellSort (first, last: integer; var lPositionRA, lIndexLoRA,lIndexHiRA: LongintP; var lRepeatedValues: boolean)
1521
GetMem (lOffset_pos_table, lSliceInfoCount*sizeof(longint));
1522
for lInc := 1 to lSliceInfoCount do
1523
lOffset_pos_table^[lInc] := lInc;
1524
ShellSortItems (1, lSliceInfoCount,lOffset_pos_table,lSliceSequenceRA, lRepeatedValues);
1525
if lRepeatedValues then begin
1526
Msg('read_PAR_data: fatal error, slices do not appear to have unique indexes [multiple copies of same slice]');
1527
FreeMem (lOffset_pos_table);
1528
goto 333;
1529
end;
1530
lOffsetTableEntries := lSliceInfoCount;
1531
end; //sort image order...
1532
//Next, generate list of scale slope
1533
if (lSliceInfoCount > 1) and (lReadVaryingScaleFactors) and ( (lRangeRA[kSlope].min <> lRangeRA[kSlope].max)
1534
or (lRangeRA[kIntercept].min <> lRangeRA[kIntercept].max)) then begin {create offset LUT}
1535
lVaryingScaleFactorsTableEntries := lSliceInfoCount;
1536
getmem (lVaryingScaleFactors_table, lVaryingScaleFactorsTableEntries*sizeof(single));
1537
getmem (lVaryingIntercept_table, lVaryingScaleFactorsTableEntries*sizeof(single));
1538
if lOffsetTableEntries = lSliceInfoCount then begin //need to sort slices
1539
1540
for lInc := 1 to lSliceInfoCount do begin
1541
lVaryingScaleFactors_table^[lInc] := lSliceSlopeRA[lOffset_pos_table^[lInc]];
1542
lVaryingIntercept_table^[lInc] := lSliceInterceptRA[lOffset_pos_table^[lInc]];
1543
if gPARprecise then begin
1544
if (lVaryingIntercept_table^[lInc] <> 0) or (lCalibratedSliceSlopeRA[lOffset_pos_table^[lInc]]=0) then
1545
Msg('Warning: Unable to save calibrated Philips image intensity (non-zero scaling intercept). Turn off Etc/Options/CalibratedScaling to hide warning.')
1546
else begin
1547
lVaryingScaleFactors_table^[lInc] := 1 / lCalibratedSliceSlopeRA[lOffset_pos_table^[lInc]];
1548
end;
1549
end; //if PARprecise
1550
1551
end;
1552
end else begin //if sorted, else unsorted
1553
1554
for lInc := 1 to lSliceInfoCount do begin
1555
lVaryingScaleFactors_table^[lInc] := lSliceSlopeRA[lInc];
1556
lVaryingIntercept_table^[lInc] := lSliceInterceptRA[lInc];
1557
if gPARprecise then begin
1558
if (lVaryingIntercept_table^[lInc] <> 0) or (lCalibratedSliceSlopeRA[lInc]=0) then
1559
Msg('Warning: Unable to save calibrated Philips image intensity (non-zero scaling intercept). Turn off Etc/Options/CalibratedScaling to hide warning.')
1560
else
1561
lVaryingScaleFactors_table^[lInc] := 1 / lCalibratedSliceSlopeRA[lInc];
1562
end; //if PARprecise
1563
1564
end;
1565
end; //slices sorted
1566
end;//read scale factors
1567
//Next: now adjust Offsets to point to byte offset instead of slice number
1568
lSliceSz := lDicomData.XYZdim[1]*lDicomData.XYZdim[2]*(lDicomData.Allocbits_per_pixel div 8);
1569
if lOffsetTableEntries = lSliceInfoCount then
1570
for lInc := 1 to lSliceInfoCount do
1571
lOffset_pos_table^[lInc] := lSliceSz * (lSliceIndexRA[lOffset_pos_table^[lInc]]);
1572
//report if 5D/6D/7D file is being saved as 4D
1573
if (lRangeRA[kCardiac].min <> lRangeRA[kCardiac].max)
1574
or (lRangeRA[kEcho].min <> lRangeRA[kEcho].max) //5D file space+time+echo
1575
or (lRangeRA[kType].min <> lRangeRA[kType].max) //5D file space+time+echo
1576
or (lRangeRA[kSequence].min <> lRangeRA[kSequence].max) then //5D file space+time+echo
1577
Msg('Warning: note that this image has more than 4 dimensions (multiple Cardiac/Echo/Type/Sequence)');
1578
//if we get here, the Image Format is OK
1579
lImageFormatOK := true;
1580
lFileName := changefileextX(lFilename,'.rec'); //for Linux: case sensitive extension search '.rec' <> '.REC'
1581
333: //abort clause: skips lHdrOK and lImageFormatOK
1582
//next: free dynamically allocated memory
1583
FreeMem( lCharRA);
1584
FreeMem (lSliceSequenceRA);
1585
end; *)
1586
1587
procedure read_ge_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
1588
label
1589
539;
1590
var
1591
lGap,lSliceThick,lTempFloat: single;
1592
lTemp16,lI: word;
1593
lSeriesOffset,lTemp32,lExamHdr,lImgHdr,lDATFormatOffset,lHdrOffset,lCompress,linitialoffset,n,filesz: LongInt;
1594
tx : array [0..36] of Char;
1595
FP: file;
1596
lGEodd,lGEFlag,{lSpecial,}lMR: boolean;
1597
function GEflag: boolean;
1598
begin
1599
if (tx[0] = 'I') AND (tx[1]= 'M') AND (tx[2] = 'G')AND (tx[3]= 'F') then
1600
result := true
1601
else
1602
result := false;
1603
end;
1604
function swap16i(lPos: longint): word;
1605
var
1606
w : Word;
1607
begin
1608
seek(fp,lPos-2);
1609
BlockRead(fp, W, 2);
1610
result := swap(W);
1611
end;
1612
1613
function swap32i(lPos: longint): Longint;
1614
type
1615
swaptype = packed record
1616
case byte of
1617
0:(Word1,Word2 : word); //word is 16 bit
1618
1:(Long:LongInt);
1619
end;
1620
swaptypep = ^swaptype;
1621
var
1622
s : LongInt;
1623
inguy:swaptypep;
1624
outguy:swaptype;
1625
begin
1626
seek(fp,lPos);
1627
BlockRead(fp, s, 4, n);
1628
inguy := @s; //assign address of s to inguy
1629
outguy.Word1 := swap(inguy^.Word2);
1630
outguy.Word2 := swap(inguy^.Word1);
1631
swap32i:=outguy.Long;
1632
end;
1633
function fswap4r (lPos: longint): single;
1634
type
1635
swaptype = packed record
1636
case byte of
1637
0:(Word1,Word2 : word); //word is 16 bit
1638
1:(float:single);
1639
end;
1640
swaptypep = ^swaptype;
1641
var
1642
s:single;
1643
inguy:swaptypep;
1644
outguy:swaptype;
1645
begin
1646
seek(fp,lPos);
1647
BlockRead(fp, s, 4, n);
1648
inguy := @s; //assign address of s to inguy
1649
outguy.Word1 := swap(inguy^.Word2);
1650
outguy.Word2 := swap(inguy^.Word1);
1651
fswap4r:=outguy.float;
1652
end;
1653
begin
1654
lImageFormatOK := true;
1655
lSeriesOffset := 0;
1656
lSLiceThick := 0;
1657
lGap := 0;
1658
lHdrOK := false;
1659
lHdrOffset := 0;
1660
if not fileexists(lFileName) then begin
1661
lImageFormatOK := false;
1662
exit;
1663
end;
1664
FileMode := 0; //set to readonly
1665
AssignFile(fp, lFileName);
1666
Reset(fp, 1);
1667
FIleSz := FileSize(fp);
1668
lDATFormatOffset := 0;
1669
Clear_Dicom_Data(lDicomData);
1670
if filesz < (3240) then begin
1671
Msg('This file is too small to be a Genesis DAT format image.');
1672
goto 539;
1673
end;
1674
lDynStr:= '';
1675
//lGEFlag := false;
1676
lInitialOffset := 3228;//3240;
1677
seek(fp, lInitialOffset);
1678
BlockRead(fp, tx, 4*SizeOf(Char), n);
1679
lGEflag := GEFlag;
1680
if not lGEFlag then begin
1681
lInitialOffset := 3240;
1682
seek(fp, lInitialOffset);
1683
BlockRead(fp, tx, 4*SizeOf(Char), n);
1684
lGEflag := GEFlag;
1685
end;
1686
lGEodd := lGEFlag;
1687
if not lGEFlag then begin
1688
lInitialOffset := 0;
1689
seek(fp, lInitialOffset);
1690
BlockRead(fp, tx, 4*SizeOf(Char), n);
1691
if not GEflag then begin {DAT format}
1692
lDynStr := lDynStr+'GE Genesis Signa DAT tape format'+kCR;
1693
seek(fp,114);
1694
BlockRead(fp, tx, 4*SizeOf(Char), n);
1695
lDynStr := lDynStr + 'Suite: ';
1696
for lI := 0 to 3 do
1697
lDynStr := lDynStr + tx[lI];
1698
lDynStr := lDynStr + kCR;
1699
1700
seek(fp,114+97);
1701
BlockRead(fp, tx, 25*SizeOf(Char), n);
1702
lDynStr := lDynStr + 'Patient Name: ';
1703
for lI := 0 to 24 do
1704
lDynStr := lDynStr + tx[lI];
1705
lDynStr := lDynStr + kCR;
1706
seek(fp,114+84);
1707
BlockRead(fp, tx, 13*SizeOf(Char), n);
1708
lDynStr := lDynStr + 'Patient ID: ';
1709
for lI := 0 to 12 do
1710
lDynStr := lDynStr + tx[lI];
1711
lDynStr := lDynStr + kCR;
1712
seek(fp, 114+305);
1713
BlockRead(fp, tx, 3*SizeOf(Char), n);
1714
if (tx[0]='M') and (tx[1] = 'R') then
1715
lMR := true
1716
else if (tx[0] = 'C') and(tx[1] = 'T') then
1717
lMR := false
1718
else begin
1719
Msg('Is this a Genesis DAT image? The modality is '+tx[0]+tx[1]+tx[3]
1720
+'. Expected ''MR'' or ''CT''.');
1721
goto 539;
1722
end;
1723
if lMR then
1724
lInitialOffset := 3180
1725
else
1726
lInitialOffset := 3178;
1727
seek(fp, lInitialOffset);
1728
BlockRead(fp, tx, 4*SizeOf(Char), n);
1729
if (tx[0] <> 'I') OR (tx[1] <> 'M') OR (tx[2] <> 'G') OR (tx[3] <> 'F') then begin
1730
Msg('This image does not have the required label ''IMGF''. This is not a Genesis DAT image.');
1731
goto 539;
1732
end else
1733
lDicomData.ImageNum := swap16i(2158+12);
1734
lDicomData.XYZmm[3] := fswap4r (2158+26);// slice thickness mm
1735
lDicomData.XYZmm[1] := fswap4r (2158+50);// pixel size- X
1736
lDicomData.XYZmm[2] := fswap4r (2158+54);//pixel size - Y
1737
lSliceThick := lDicomData.XYZmm[3];
1738
lGap := fswap4r (lHdrOffset+118);//1410 gap thickness mm
1739
if lGap > 0 then
1740
lDicomData.XYZmm[3] := lDicomData.XYZmm[3] + lGap;
1741
lDATFormatOffset := 4;
1742
if lMR then begin
1743
lTemp32 := swap32i(2158+194);
1744
lDynStr := lDynStr +'TR[usec]: '+inttostr(lTemp32) + kCR;
1745
lTemp32 := swap32i(2158+198);
1746
lDynStr := lDynStr +'TInvert[usec]: '+inttostr(lTemp32) + kCR;
1747
lTemp32 := swap32i(2158+202);
1748
lDynStr := lDynStr +'TE[usec]: '+inttostr(lTemp32) + kCR;
1749
lTemp16 := swap16i(2158+210);
1750
lDynStr := lDynStr +'Number of echoes: '+inttostr(lTemp16) + kCR;
1751
lTemp16 := swap16i(2158+212);
1752
lDynStr := lDynStr +'Echo: '+inttostr(lTemp16) + kCR;
1753
1754
lTempFloat := fswap4r (2158+50); //not sure why I changed this to 50... 218 in Clunie's Description
1755
lDynStr := lDynStr +'NEX: '+floattostr(lTempFloat) + kCR;
1756
1757
seek(fp,2158+308);
1758
BlockRead(fp, tx, 33*SizeOf(Char), n);
1759
lDynStr := lDynStr + 'Sequence: ';
1760
for lI := 0 to 32 do
1761
lDynStr := lDynStr + tx[lI];
1762
lDynStr := lDynStr + kCR;
1763
1764
1765
seek(fp,2158+362);
1766
BlockRead(fp, tx, 17*SizeOf(Char), n);
1767
lDynStr := lDynStr + 'Coil: ';
1768
for lI := 0 to 16 do
1769
lDynStr := lDynStr + tx[lI];
1770
lDynStr := lDynStr + kCR;
1771
1772
1773
end;
1774
1775
end; {DAT format}
1776
end;
1777
lDicomData.ImageStart := lDATFormatOffset+linitialoffset + swap32i(linitialoffset+4);//byte displacement to image data
1778
lDicomData.XYZdim[1] := swap32i(linitialoffset+8); //width
1779
lDicomData.XYZdim[2] := swap32i(linitialoffset+12);//height
1780
lDicomData.Allocbits_per_pixel := swap32i(linitialoffset+16);//bits
1781
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
1782
lCompress := swap32i(linitialoffset+20); //compression
1783
lExamHdr := swap32i(linitialoffset+136);
1784
lImgHdr := swap32i(linitialoffset+152);
1785
if (lImgHdr = 0) and (lDicomData.ImageStart = 8432) then begin
1786
lDicomData.ImageNum := swap16i(2310+12);
1787
lDicomData.XYZmm[3] := fswap4r (2310+26);// slice thickness mm
1788
lDicomData.XYZmm[1] := fswap4r (2310+50);// pixel size- X
1789
lDicomData.XYZmm[2] := fswap4r (2310+54);//pixel size - Y
1790
lSliceThick := lDicomData.XYZmm[3];
1791
lGap := fswap4r (lHdrOffset+118);//1410 gap thickness mm
1792
if lGap > 0 then
1793
lDicomData.XYZmm[3] := lDicomData.XYZmm[3] + lGap;
1794
1795
end else if {(lSpecial = false) and} (lDATFormatOffset = 0) then begin
1796
lDynStr := lDynStr+'GE Genesis Signa format'+kCR;
1797
if (not lGEodd) and (lExamHdr <> 0) then begin
1798
lHdrOffset := swap32i(linitialoffset+132);//x132- int ptr to exam heade
1799
//Patient ID
1800
seek(fp,lHdrOffset+84);
1801
BlockRead(fp, tx, 13*SizeOf(Char), n);
1802
lDynStr := lDynStr + 'Patient ID: ';
1803
for lI := 0 to 12 do
1804
lDynStr := lDynStr + tx[lI];
1805
lDynStr := lDynStr + kCR;
1806
//Patient Name
1807
seek(fp,lHdrOffset+97);
1808
BlockRead(fp, tx, 25*SizeOf(Char), n);
1809
lDynStr := lDynStr + 'Patient Name: ';
1810
for lI := 0 to 24 do
1811
lDynStr := lDynStr + tx[lI];
1812
lDynStr := lDynStr + kCR;
1813
//Patient Age
1814
lI := swap16i(lHdrOffset+122);
1815
lDynStr := lDynStr+'Patient Age: '+inttostr(lI)+kCR;
1816
//Modality: MR or CT
1817
seek(fp,lHdrOffset+305);
1818
BlockRead(fp, tx, 3*SizeOf(Char), n);
1819
lDynStr := lDynStr + 'Type: ';
1820
for lI := 0 to 1 do
1821
lDynStr := lDynStr + tx[lI];
1822
lDynStr := lDynStr + kCR;
1823
//Read series header
1824
lSeriesOffset := swap32i(linitialoffset+144);//read size of series header: only read if >0
1825
if lSeriesOffset > 12 then begin
1826
lSeriesOffset := swap32i(linitialoffset+140);//read size of series header: only read if >0
1827
lI := swap16i(lSeriesOffset+10);
1828
//lDynStr := lDynStr+'Series number: '+inttostr(lI)+kCR;
1829
lDicomData.SeriesNum := lI;
1830
end;
1831
1832
1833
//image data
1834
lHdrOffset := swap32i(linitialoffset+148);//x148- int ptr to image heade
1835
end;
1836
if lGEodd then lHdrOffset := 2158+28;
1837
if ((lHdrOffset +58) < FileSz) and (lImgHdr <> 0) then begin
1838
lDicomData.AcquNum := swap16i(lHdrOffset+12); //note SERIES not IMAGE number, despite what Clunies FAQ says
1839
lDicomData.ImageNum := swap16i(lHdrOffset+14); //this is IMAGEnum
1840
1841
//lDynStr := lDynStr +'Image number: '+inttostr(lDicomData.ImageNum)+ kCR;
1842
lDicomData.XYZmm[3] := fswap4r (lHdrOffset{linitialoffset+lHdrOffset}+26);// slice thickness mm
1843
lDicomData.XYZmm[1] := fswap4r (lHdrOffset{linitialoffset+lHdrOffset}+50);// pixel size- X
1844
lDicomData.XYZmm[2] := fswap4r (lHdrOffset{linitialoffset+lHdrOffset}+54);//pixel size - Y
1845
lSliceThick := lDicomData.XYZmm[3];
1846
lGap := fswap4r (lHdrOffset+118);//1410 gap thickness mm
1847
if lGap > 0 then
1848
lDicomData.XYZmm[3] := lDicomData.XYZmm[3] + lGap;
1849
end;
1850
end;
1851
if (lCompress = 3) or (lCompress = 4) then begin
1852
lImageFormatOK := false;//xlDicomData.GenesisCpt := true;
1853
lDynStr := lDynStr+'Compressed data'+kCR;
1854
end else
1855
;//xlDicomData.GenesisCpt := false;
1856
if (lCompress = 2) or (lCompress = 4) then begin
1857
lImageFormatOK := false;//xlDicomData.GenesisPackHdr := swap32i(linitialoffset+64);
1858
lDynStr := lDynStr+'Packed data'+kCR;
1859
end else
1860
//xlDicomData.GenesisPackHdr := 0;
1861
lDynStr := lDynStr+'Series Number: '+inttostr(lDicomData.SeriesNum)
1862
+kCR+'Acquisition Number: '+inttostr(lDicomData.AcquNum)
1863
+kCR+'Image Number: '+inttostr(lDicomData.ImageNum)
1864
+kCR+'Slice Thickness/Gap: '+floattostrf(lSliceThick,ffFixed,8,2)+'/'+floattostrf(lGap,ffFixed,8,2)
1865
+kCR+'XYZ dim: ' +inttostr(lDicomData.XYZdim[1])+'/'+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
1866
+kCR+'XYZ mm: '+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
1867
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2);
1868
lHdrOK := true;
1869
539:
1870
CloseFile(fp);
1871
FileMode := 2; //set to read/write
1872
end;//read_ge
1873
1874
1875
//start siemens
1876
procedure read_siemens_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
1877
label
1878
567;
1879
var
1880
lI: word;
1881
lYear,lMonth,lDay,n,filesz,lFullSz,lMatrixSz,lIHour,lIMin,lISec{,lAHour,lAMin,lASec}: LongInt;
1882
lFlipAngle,lGap,lSliceThick: double;
1883
tx : array [0..26] of Char;
1884
lMagField,lTE,lTR: double;
1885
lInstitution,lName, lID,lMinStr,lSecStr{,lAMinStr,lASecStr}: String;
1886
FP: file;
1887
function swap32i(lPos: longint): Longint;
1888
type
1889
swaptype = packed record
1890
case byte of
1891
0:(Word1,Word2 : word); //word is 16 bit
1892
1:(Long:LongInt);
1893
end;
1894
swaptypep = ^swaptype;
1895
var
1896
s : LongInt;
1897
inguy:swaptypep;
1898
outguy:swaptype;
1899
begin
1900
seek(fp,lPos);
1901
BlockRead(fp, s, 4, n);
1902
inguy := @s; //assign address of s to inguy
1903
outguy.Word1 := swap(inguy^.Word2);
1904
outguy.Word2 := swap(inguy^.Word1);
1905
swap32i:=outguy.Long;
1906
//swap32i:=inguy.Long;
1907
end;
1908
function fswap8r (lPos: longint): double;
1909
type
1910
swaptype = packed record
1911
case byte of
1912
0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit
1913
1:(float:double);
1914
end;
1915
swaptypep = ^swaptype;
1916
var
1917
s:double;
1918
inguy:swaptypep;
1919
outguy:swaptype;
1920
begin
1921
seek(fp,lPos);
1922
BlockRead(fp, s, 8, n);
1923
inguy := @s; //assign address of s to inguy
1924
outguy.Word1 := swap(inguy^.Word4);
1925
outguy.Word2 := swap(inguy^.Word3);
1926
outguy.Word3 := swap(inguy^.Word2);
1927
outguy.Word4 := swap(inguy^.Word1);
1928
fswap8r:=outguy.float;
1929
end;
1930
begin
1931
lImageFormatOK := true;
1932
lHdrOK := false;
1933
if not fileexists(lFileName) then begin
1934
lImageFormatOK := false;
1935
exit;
1936
end;
1937
FileMode := 0; //set to readonly
1938
AssignFile(fp, lFileName);
1939
Reset(fp, 1);
1940
FIleSz := FileSize(fp);
1941
Clear_Dicom_Data(lDicomData);
1942
if filesz < (6144) then begin
1943
Msg('This file is to small to be a Siemens Magnetom Vision image.');
1944
goto 567;
1945
end;
1946
seek(fp, 96);
1947
BlockRead(fp, tx, 7*SizeOf(Char), n);
1948
if (tx[0] <> 'S') OR (tx[1] <> 'I') OR (tx[2] <> 'E') OR (tx[3] <> 'M') then begin {manufacturer is not SIEMENS}
1949
Msg('Is this a Siemens Magnetom Vision image [Manufacturer tag should be ''SIEMENS''].');
1950
goto 567;
1951
end; {manufacturer not siemens}
1952
seek(fp, 105);
1953
BlockRead(fp, Tx, 25*SizeOf(Char), n);
1954
lINstitution := '';
1955
for lI := 0 to 24 do begin
1956
if tx[lI] in ['/','\','a'..'z','A'..'Z',' ','+','-','.',',','0'..'9'] then lINstitution := lINstitution + tx[lI];
1957
end; seek(fp, 768);
1958
BlockRead(fp, Tx, 25*SizeOf(Char), n);
1959
lName := '';
1960
for lI := 0 to 24 do begin
1961
if tx[lI] in ['/','\','a'..'z','A'..'Z',' ','+','-','.',',','0'..'9'] then lName := lName + tx[lI];
1962
end;
1963
seek(fp, 795);
1964
BlockRead(fp, Tx, 12*SizeOf(Char), n);
1965
lID := '';
1966
for lI := 0 to 11 do begin
1967
if tx[lI] in ['/','\','a'..'z','A'..'Z',' ','+','-','.',',','0'..'9'] then lID := lID + tx[lI];
1968
end;
1969
lDicomData.ImageStart := 6144;
1970
lYear := swap32i(0);
1971
lMonth := swap32i(4);
1972
lDay := swap32i(8);
1973
lIHour := swap32i(68);
1974
lIMin := swap32i(72);
1975
lISec := swap32i(76);
1976
lDicomData.XYZmm[3] := fswap8r (1544);
1977
lMagField := fswap8r (2560);
1978
lTR := fswap8r (1560);
1979
lTE := fswap8r (1568);
1980
lDIcomData.AcquNum := swap32i(3212);
1981
lMatrixSz := swap32i(2864);
1982
lDicomData.SiemensSlices := swap32i(4004); //1366
1983
//lFullSz := swap32i(4008);
1984
//lInterleaveIf4 := swap32i(2888);
1985
lFullSz := (2*lMatrixSz*lMatrixSz);//16bitdata
1986
if ((FileSz - 6144) mod lFullSz) = 0 then begin
1987
case ((FileSz-6144) div lFullSz) of
1988
4: lFullSz := 2*lMatrixSz;
1989
9: lFullSz := 3*lMatrixSz;
1990
16: lFullSz := 4*lMatrixSz;
1991
25: lFullSz := 5*lMatrixSz;
1992
36: lFullSz := 6*lMatrixSz;
1993
49: lFullSz := 7*lMatrixSz;
1994
64: lFullSz := 8*lMatrixSz;
1995
else lFullSz := lMatrixSz;
1996
end;
1997
end else lFullSz := lMatrixSz;
1998
{3744/3752 are XY FOV in mm!}
1999
lDicomData.XYZdim[1] := lFullSz;//lMatrixSz; //width
2000
lDicomData.XYZdim[2] := lFullSz;//lMatrixSz;//height
2001
{5000/5008 are size in mm, but wrong for mosaics}
2002
if lMatrixSz <> 0 then begin
2003
lDicomData.XYZmm[2] := fswap8r (3744)/lMatrixSz;
2004
lDicomData.XYZmm[1] := fswap8r (3752)/lMatrixSz;
2005
if ((lDicomData.XYZdim[1] mod lMatrixSz)=0) then
2006
lDicomData.SiemensMosaicX := lDicomData.XYZdim[1] div lMatrixSz;
2007
if ((lDicomData.XYZdim[2] mod lMatrixSz)=0) then
2008
lDicomData.SiemensMosaicY := lDicomData.XYZdim[2] div lMatrixSz;
2009
if lDicomData.SiemensMosaicX < 1 then lDicomData.SiemensMosaicX := 1; //1366
2010
if lDicomData.SiemensMosaicY < 1 then lDicomData.SiemensMosaicY := 1; //1366
2011
end;
2012
lFlipAngle := fswap8r (2112); //1414
2013
{ lDicomData.XYZmm[2] := fswap8r (5000);
2014
lDicomData.XYZmm[1] := fswap8r (5008);}
2015
lSliceThick := lDicomData.XYZmm[3];
2016
lGap := fswap8r (4136); //gap as ratio of slice thickness?!?!
2017
if {lGap > 0} (lGap=-1) or (lGap=-19222) then //1410: exclusion values: do not ask me why 19222: from John Ashburner
2018
else begin
2019
//lDicomData.XYZmm[3] := abs(lDicomData.XYZmm[3] * (1+lGap));
2020
lGap := lDicomData.XYZmm[3] * (lGap);
2021
lDicomData.XYZmm[3] := abs(lDicomData.XYZmm[3] +lGap);
2022
end;
2023
lDicomData.Allocbits_per_pixel := 16;//bits
2024
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
2025
//xlDicomData.GenesisCpt := false;
2026
//xlDicomData.GenesisPackHdr := 0;
2027
lMinStr := inttostr(lIMin);
2028
if length(lMinStr) = 1 then lMinStr := '0'+lMinStr;
2029
lSecStr := inttostr(lISec);
2030
if length(lSecStr) = 1 then lSecStr := '0'+lSecStr;
2031
2032
2033
2034
lDynStr := 'Siemens Magnetom Vision Format'+kCR+'Name: '+lName+kCR+'ID: '+lID+kCR+'Institution: '+lInstitution+kCR+
2035
'Study DD/MM/YYYY: '+inttostr(lDay)+'/'+inttostr(lMonth)+'/'+inttostr(lYear)+kCR+
2036
'Image Hour/Min/Sec: '+inttostr(lIHour)+':'+lMinStr+':'+lSecStr+kCR+
2037
//'Acquisition Hour/Min/Sec: '+inttostr(lAHour)+':'+lAMinStr+':'+lASecStr+kCR+
2038
'Magnetic Field Strength: '+ floattostrf(lMagField,ffFixed,8,2)+kCR+
2039
'Image index: '+inttostr(lDIcomData.AcquNum)+kCR+
2040
'Time Repitition/Echo [TR/TE]: '+ floattostrf(lTR,ffFixed,8,2)+'/'+ floattostrf(lTE,ffFixed,8,2)+kCR+
2041
'Flip Angle: '+ floattostrf(lFlipAngle,ffFixed,8,2)+kCR+
2042
'Slice Thickness/Gap: '+floattostrf(lSliceThick,ffFixed,8,2)+'/'+floattostrf(lGap,ffFixed,8,2)+kCR+
2043
'XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'
2044
+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])+kCR+
2045
'XY matrix:' +inttostr(lDicomData.SiemensMosaicX)+'/'
2046
+inttostr(lDicomData.SiemensMosaicY)+kCR+
2047
'XYZ mm:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
2048
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2);
2049
lHdrOK := true;
2050
//lDIcomData.AcquNum := 0;
2051
567:
2052
CloseFile(fp);
2053
FileMode := 2; //set to read/write
2054
end;
2055
//end siemens
2056
//begin elscint
2057
procedure read_elscint_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
2058
label
2059
539;
2060
var
2061
//lExamHdr,lImgHdr,lDATFormatOffset,lHdrOffset,
2062
{lDate,}lI,lCompress,n,filesz: LongInt;
2063
tx : array [0..41] of Char;
2064
FP: file;
2065
function readStr(lPos,lLen: integer): string;
2066
var lStr: string;
2067
lStrInc: integer;
2068
begin
2069
seek(fp,lPos);
2070
BlockRead(fp, tx, lLen, n);
2071
lStr := '';
2072
for lStrInc := 0 to (lLen-1) do
2073
lStr := lStr + tx[lStrInc];
2074
result := lStr
2075
end;
2076
function read8ch(lPos: integer): char;
2077
begin
2078
seek(fp,40);
2079
BlockRead(fp, result, 1, n);
2080
//lDicomData.ImageNum := ord(tx[0]);
2081
end;
2082
procedure read16i(lPos: longint; var lVal: integer);
2083
var lInWord: word;
2084
begin
2085
seek(fp,lPos);
2086
BlockRead(fp, lInWord, 2);
2087
lVal := lInWord;
2088
end;
2089
procedure read32i(lPos: longint; var lVal: integer);
2090
var lInINt: integer;
2091
begin
2092
seek(fp,lPos);
2093
BlockRead(fp, lInINt, 4);
2094
lVal :=lInINt;
2095
end;
2096
2097
begin
2098
lImageFormatOK := true;
2099
lHdrOK := false;
2100
if not fileexists(lFileName) then begin
2101
lImageFormatOK := false;
2102
exit;
2103
end;
2104
FileMode := 0; //set to readonly
2105
AssignFile(fp, lFileName);
2106
Reset(fp, 1);
2107
FIleSz := FileSize(fp);
2108
Clear_Dicom_Data(lDicomData);
2109
if filesz < (3240) then begin
2110
Msg('This file is too small to be a Elscint format image.');
2111
goto 539;
2112
end;
2113
lDynStr:= '';
2114
read16i(0, lI);
2115
if (lI <> 64206) then begin
2116
Msg('Unable to read this file: it does start with the Elscint signature.');
2117
goto 539;
2118
end;
2119
lDicomdata.little_endian := 1;
2120
lDynStr:= 'Elscint Format'+kCR;
2121
lDynStr := lDynStr+'Patient Name: '+readstr(4,20)+kCR;
2122
lDynStr := lDynStr+'Patient ID: '+readstr(24,13)+kCR;
2123
read16i(38,lDicomData.AcquNum);
2124
lDicomData.ImageNum := ord(read8Ch(40));
2125
lDynStr := lDynStr+'Doctor & Ward: '+readstr(100,20)+kCR;
2126
lDynStr := lDynStr+'Comments: '+readstr(120,40)+kCR;
2127
if ord(read8Ch(163)) = 1 then
2128
lDynStr := lDynStr + 'Sex: M'+kCR
2129
else
2130
lDynStr := lDynStr + 'Sex: F'+kCR;
2131
read16i(200,lI);
2132
lDicomData.XYZmm[3] := lI * 0.1;
2133
read16i(370,lDicomData.XYZdim[1]);
2134
read16i(372,lDicomData.XYZdim[2]);
2135
read16i(374,lI);
2136
lDicomData.XYZmm[1] := lI / 256;
2137
lDicomData.XYZmm[2] := lDicomData.XYZmm[1];
2138
lCompress := ord(read8Ch(376));
2139
//xlDicomData.ElscintCompress := true;
2140
//xread16i(400,lDicomData.WindowWidth);
2141
//x read16i(398,lDicomData.WindowCenter);
2142
case lCompress of
2143
0: begin
2144
lDynStr := lDynStr + 'Compression: None'+kCR;
2145
//xlDicomData.ElscintCompress := false;
2146
end;
2147
1: lImageFormatOK := false;//xlDynStr := lDynStr + 'Compression: Old'+kCR;
2148
2: lImageFormatOK := false;//xlDynStr := lDynStr + 'Compression: 2400 Elite'+kCR;
2149
22: lImageFormatOK := false;//xlDynStr := lDynStr + 'Compression: Twin'+kCR;
2150
else begin
2151
lImageFormatOK := false;//xlDynStr := lDynStr + 'Compression: Unknown '+inttostr(lCOmpress)+kCR;
2152
//lDicomData.ElscintCompress := false;
2153
end;
2154
end;
2155
//lDicomData.XYZdim[1] := swap32i(linitialoffset+8); //width
2156
//lDicomData.XYZdim[2] := swap32i(linitialoffset+12);//height
2157
lDicomData.ImageStart := 396;
2158
lDicomData.Allocbits_per_pixel := 16;
2159
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
2160
if (lDicomData.XYZdim[1]=160) and (lDicomData.XYZdim[2]= 160) and (FIleSz=52224) then begin
2161
lDicomData.ImageStart := 1024;
2162
lImageFormatOK := true;//x//xlDicomData.ElscintCompress := False;
2163
end;
2164
//lDicomData.XYZmm[3] := fswap4r (2310+26);// slice thickness mm
2165
lDynStr := lDynStr+'Image/Study Number: '+inttostr(lDicomData.ImageNum)+'/'+ inttostr(lDicomData.AcquNum)+kCR
2166
+'XYZ dim: ' +inttostr(lDicomData.XYZdim[1])+'/'
2167
+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
2168
//x+kCR+'Window Center/Width: '+inttostr(lDicomData.WindowCenter)+'/'+inttostr(lDicomData.WindowWidth)
2169
+kCR+'XYZ mm: '+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
2170
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2);
2171
lHdrOK := true;
2172
lImageFormatOK := true;
2173
539:
2174
CloseFile(fp);
2175
FileMode := 2; //set to read/write
2176
end;
2177
//end elscint
2178
2179
2180
2181
//start picker
2182
procedure read_picker_data(lVerboseRead: boolean; var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
2183
label 423;
2184
const kPickerHeader =8192;
2185
kRecStart = 280; //is this a constant?
2186
var
2187
lDataStart,lVal,lDBPos,lPos,lRecSz, lNumRecs,lRec,FileSz,n: Longint;
2188
lThkM,lThkN,lSiz: double;
2189
tx : array [0..6] of Char;
2190
FP: file;
2191
lDiskCacheRA: pChar;
2192
function ReadRec(lRecNum: integer): boolean;
2193
var
2194
lNameStr,lValStr: string;
2195
lOffset,lLen,lFPOs,lFEnd: integer;
2196
function ValStrToFloat: double;
2197
var lConvStr: string;
2198
lI: integer;
2199
begin
2200
Result := 0.0;
2201
lLen := Length(lValStr);
2202
if lLen < 1 then exit;
2203
lConvStr := '';
2204
for lI := 1 to lLen do
2205
if lValStr[lI] in ['0'..'9'] then
2206
lConvStr := lConvStr+ lValStr[lI];
2207
if Length(lConvStr) < 1 then exit;
2208
Result := strtofloat(lConvStr);
2209
end;
2210
begin
2211
Result := false;
2212
lFPos := ((lRecNum-1) * lRecSz)+ kRecStart;
2213
lFEnd := lFpos + 6;
2214
lNameStr := '';
2215
for lFPos := lFPos to lFEnd do
2216
if ord(lDiskCacheRA[lFPos]) <> 0 then
2217
lNameStr := lNameStr +lDiskCacheRA[lFPos];
2218
if (lVerboseRead) or (lNameStr = 'RCNFSIZ') or (lNameStr='SCNTHKM') or (lNameStr='SCNTHKN') then begin
2219
lFPos := ((lRecNum-1) * lRecSz)+ kRecStart+8;
2220
lFEnd := lFPos+1;
2221
lOffset := 0;
2222
for lFPos := lFPos to lFend do
2223
lOffset := ((lOffset)shl 8)+(ord(lDiskCacheRA[lFPos]));
2224
lFPos := ((lRecNum-1) * lRecSz)+ kRecStart+10;
2225
lFEnd := lFPos+1;
2226
lLen := 0;
2227
for lFPos := lFPos to lFend do
2228
lLen := ((lLen)shl 8)+(ord(lDiskCacheRA[lFPos]));
2229
lOffset := lDataStart+lOffset+1;
2230
lFEnd := lOffset+lLen-1;
2231
if (lLen < 1) or (lFEnd > kPickerHeader) then exit;
2232
lValStr := '';
2233
for lFPos := (lOffset) to lFEnd do begin
2234
lValStr := lValStr+lDiskCacheRA[lFPos];
2235
end;
2236
if lVerboseRead then lDynStr := lDynStr+kCR+lNameStr+': '+ lValStr;
2237
if (lNameStr = 'RCNFSIZ') then lSiz := ValStrToFloat;
2238
if (lNameStr='SCNTHKM') then lThkM := ValStrToFloat;
2239
if (lNameStr='SCNTHKN') then lThkN := ValStrToFloat;
2240
end; //verboseread, or vital value
2241
result := true;
2242
end;
2243
function FindStr(l1,l2,l3,l4,l5: Char; lReadNum: boolean; var lNum: integer): boolean;
2244
var //lMarker: integer;
2245
lNumStr: String;
2246
begin
2247
Result := false;
2248
repeat
2249
if (lDiskCacheRA[lPos-4]=l1) and (lDiskCacheRA[lPos-3]=l2)
2250
and (lDiskCacheRA[lPos-2]=l3) and (lDiskCacheRA[lPos-1]=l4)
2251
and (lDiskCacheRA[lPos]=l5) then Result := true;
2252
inc (lPos);
2253
until (Result) or (lPos >= kPickerHeader);
2254
if not Result then exit;
2255
if not lReadNum then exit;
2256
Result := false;
2257
lNumStr := '';
2258
repeat
2259
if (lDiskCacheRA[lPos] in ['0'..'9']) then
2260
lNumStr := lNumStr + lDiskCacheRA[lPos]
2261
else if lNumStr <> '' then Result := true;
2262
inc(lPos);
2263
until (Result) or (lPos = kPickerHeader);
2264
lNum := strtoint(lNumStr);
2265
end;
2266
begin
2267
lSiz := 0.0;
2268
lThkM := 0.0;
2269
lThkN := 0.0;
2270
lImageFormatOK := true;
2271
lHdrOK := false;
2272
if not fileexists(lFileName) then begin
2273
lImageFormatOK := false;
2274
exit;
2275
end;
2276
FileMode := 0; //set to readonly
2277
AssignFile(fp, lFileName);
2278
Reset(fp, 1);
2279
FIleSz := FileSize(fp);
2280
Clear_Dicom_Data(lDicomData);
2281
if filesz < (kPickerHeader) then begin
2282
Msg('This file is to small to be a Picker image: '+lFileName );
2283
CloseFile(fp);
2284
FileMode := 2; //set to read/write
2285
exit;
2286
end;
2287
seek(fp, 0);
2288
BlockRead(fp, tx, 4*SizeOf(Char), n);
2289
if (tx[0] <> '*') OR (tx[1] <> '*') OR (tx[2] <> '*') OR (tx[3] <> ' ') then begin {manufacturer is not SIEMENS}
2290
Msg('Is this a Picker image? Expected ''***'' at the start of the file.'+ lFileName);
2291
CloseFile(fp);
2292
FileMode := 2; //set to read/write
2293
exit;
2294
end; {not picker}
2295
if filesz = (kPickerHeader + (1024*1024*2)) then begin
2296
lDICOMdata.XYZdim[1] := 1024;
2297
lDICOMdata.XYZdim[2] := 1024;
2298
lDICOMdata.XYZdim[3] := 1;
2299
lDICOMdata.ImageStart := 8192;
2300
end else
2301
if filesz = (kPickerHeader + (512*512*2)) then begin
2302
lDICOMdata.XYZdim[1] := 512;
2303
lDICOMdata.XYZdim[2] := 512;
2304
lDICOMdata.XYZdim[3] := 1;
2305
lDICOMdata.ImageStart := 8192;
2306
end else
2307
if filesz = (8192 + (256*256*2)) then begin
2308
lDICOMdata.XYZdim[1] := 256;
2309
lDICOMdata.XYZdim[2] := 256;
2310
lDICOMdata.XYZdim[3] := 1;
2311
lDICOMdata.ImageStart := 8192;
2312
end else begin
2313
Msg('This file is the incorrect size to be a Picker image.');
2314
CloseFile(fp);
2315
FileMode := 2; //set to read/write
2316
exit;
2317
end;
2318
getmem(lDiskCacheRA,kPickerHeader*sizeof(char));
2319
seek(fp, 0);
2320
BlockRead(fp, lDiskCacheRA, kPickerHeader, n);
2321
lRecSz := 0;
2322
lNumRecs := 0;
2323
lPos := 5;
2324
if not FindStr('d','b','r','e','c',false, lVal) then goto 423;
2325
lDBPos := lPos;
2326
if not FindStr('r','e','c','s','z',true, lRecSz) then goto 423;
2327
lPos := lDBPos;
2328
if not FindStr('n','r','e','c','s',true, lnumRecs) then goto 423;
2329
lPos := kRecStart; // IS THIS A CONSTANT???
2330
lDataStart :=kRecStart + (lRecSz*lnumRecs)-1; //file starts at 0, so -1
2331
if (lNumRecs = 0) or (lDataStart> kPickerHeader) then goto 423;
2332
lRec := 0;
2333
lDynStr := 'Picker Format';
2334
repeat
2335
inc(lRec);
2336
until (not (ReadRec(lRec))) or (lRec >= lnumRecs);
2337
if lSiz <> 0 then begin
2338
lDICOMdata.XYZmm[1] := lSiz/lDICOMdata.XYZdim[1];
2339
lDICOMdata.XYZmm[2] := lSiz/lDICOMdata.XYZdim[2];
2340
if lVerboseRead then
2341
lDynStr := lDynStr+kCR+'Voxel Size: '+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)
2342
+'x'+ floattostrf(lDicomData.XYZmm[2],ffFixed,8,2);
2343
end;
2344
if (lThkM <> 0) and (lThkN <> 0) then begin
2345
lDICOMdata.XYZmm[3] := lThkN/lThkM;
2346
if lVerboseRead then
2347
lDynStr := lDynStr+kCR+'Slice Thickness: '+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2);
2348
end;
2349
423:
2350
freemem(lDiskCacheRA);
2351
lHdrOK := true;
2352
CloseFile(fp);
2353
FileMode := 2; //set to read/write
2354
end;
2355
//end picker
2356
2357
procedure read_minc_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
2358
var
2359
// lReal: double;
2360
lnOri,lnDim,lStartPosition,nelem0,jj,lDT0,vSizeRA,BeginRA,m,nnelem,nc_type,nc_size,lLen,nelem,j,lFilePosition,lDT,lFileSz,lSignature,lWord: integer;
2361
2362
lOri: array [1..3] of double;
2363
//tx : array [0..80] of Char;
2364
lVarStr,lStr: string;
2365
FP: file;
2366
function dTypeStr (lV: integer): integer;
2367
begin
2368
case lV of
2369
1,2: result := 1;
2370
3: result := 2; //int16
2371
4: result := 4; //int32
2372
5: result := 4; //single
2373
6: result := 8; //double
2374
end;
2375
end; //nested fcn dTypeStr
2376
2377
function read32i: Longint;
2378
type
2379
swaptype = packed record
2380
case byte of
2381
0:(Word1,Word2 : word); //word is 16 bit
2382
1:(Long:LongInt);
2383
end;
2384
swaptypep = ^swaptype;
2385
var
2386
s : LongInt;
2387
inguy:swaptypep;
2388
outguy:swaptype;
2389
begin
2390
seek(fp,lFilePosition);
2391
lFilePosition := lFilePosition + 4;
2392
BlockRead(fp, s, 4);
2393
inguy := @s; //assign address of s to inguy
2394
if lDICOMdata.Little_Endian = 0 then begin
2395
outguy.Word1 := swap(inguy^.Word2);
2396
outguy.Word2 := swap(inguy^.Word1);
2397
end else
2398
outguy.long := inguy^.long;
2399
result:=outguy.Long;
2400
end;
2401
2402
function read64r (lDataType: integer): Double;
2403
type
2404
swaptype = packed record
2405
case byte of
2406
0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit
2407
1:(Long:Double);
2408
end;
2409
swaptypep = ^swaptype;
2410
var
2411
s : Double;
2412
inguy:swaptypep;
2413
outguy:swaptype;
2414
begin
2415
result := 1;
2416
if lDataType <> 6 then begin
2417
Msg('Unknown data type: MRIcro is unable to determine the voxel size.');
2418
exit;
2419
end;
2420
seek(fp,lFilePosition);
2421
lFilePosition := lFilePosition + 8;
2422
BlockRead(fp, s, 8);
2423
inguy := @s; //assign address of s to inguy
2424
if lDICOMdata.Little_Endian = 0 then begin
2425
outguy.Word1 := swap(inguy^.Word4);
2426
outguy.Word2 := swap(inguy^.Word3);
2427
outguy.Word3 := swap(inguy^.Word2);
2428
outguy.Word4 := swap(inguy^.Word1);
2429
end else
2430
outguy.long := inguy^.long;
2431
result:=outguy.Long;
2432
end;
2433
2434
function readname: String;
2435
var lI,lLen: integer;
2436
lCh: char;
2437
begin
2438
result := '';
2439
seek(fp,lFilePosition);
2440
lLen := read32i;
2441
if lLen < 1 then begin
2442
Msg('Terminal error reading netCDF/MINC header (String length < 1)');
2443
exit; //problem
2444
end;
2445
for lI := 1 to lLen do begin
2446
BlockRead(fp, lCh, 1);
2447
result := result + lCh;
2448
end;
2449
lFilePosition := lFilePosition + (((lLen+3) div 4) * 4);
2450
end;
2451
2452
begin
2453
lImageFormatOK := true;
2454
lHdrOK := false;
2455
if not fileexists(lFileName) then begin
2456
lImageFormatOK := false;
2457
exit;
2458
end;
2459
for lnOri := 1 to 3 do
2460
lOri[lnOri] := 0;
2461
lnOri := 4;
2462
lnDim := 4;
2463
FileMode := 0; //set to readonly
2464
AssignFile(fp, lFileName);
2465
Reset(fp, 1);
2466
lFileSz := FileSize(fp);
2467
Clear_Dicom_Data(lDicomData);
2468
if lFilesz < (77) then exit; //to small to be MINC
2469
2470
lFilePosition := 0;
2471
lSignature := read32i;
2472
if not (lSignature=1128547841) then begin
2473
CloseFile(fp);
2474
FileMode := 2; //set to read/write
2475
Msg('Problem with MINC signature: '+ inttostr(lSignature));
2476
exit;
2477
end;
2478
//xlDicomData.Rotate180deg := true;
2479
lWord := read32i;//numrecs
2480
lDT := read32i;
2481
while (lDt=10) or (lDT=11) or (lDT=12) do begin
2482
if lDT = 10 then begin //DT=10, Dimensions
2483
nelem := read32i;
2484
for j := 1 to nelem do begin
2485
lStr := readname;
2486
lLen := read32i;
2487
if lStr = 'xspace' then lDicomData.XYZdim[3] := lLen;//DOES MINC always reverse X and Z? see also XYZmm
2488
if lStr = 'yspace' then lDicomData.XYZdim[2] := lLen;
2489
if lStr = 'zspace' then lDicomData.XYZdim[1] := lLen;
2490
end; //for 1..nelem
2491
lDT := read32i;
2492
end;//DT=10, Dimensions
2493
if lDT = 11 then begin //DT=11, Variables
2494
nelem := read32i;
2495
for j := 1 to nelem do begin
2496
lVarStr := readname;
2497
nnelem := read32i;
2498
for m := 1 to nnelem do
2499
lLen := read32i;
2500
lDT0 := read32i;
2501
if lDT0 = 12 then begin
2502
nelem0 := read32i;
2503
for jj := 1 to nelem0 do begin
2504
lStr := readname;
2505
nc_type := read32i;
2506
nc_size := dTypeStr(nc_Type);
2507
nnelem := read32i;
2508
lStartPosition := lFilePosition;
2509
2510
if (lStr = 'step') then begin
2511
2512
if (lVarStr = 'xspace') or (lVarStr = 'yspace') or (lVarStr = 'zspace') then begin
2513
dec(lnDim);
2514
if (lnDim < 4) and (lnDim>0) then
2515
lDicomData.XYZmm[lnDim] := read64r(nc_Type)
2516
end;
2517
2518
end else if (lStr = 'start') then begin
2519
if (lVarStr = 'xspace') or (lVarStr = 'yspace') or (lVarStr = 'zspace') then begin
2520
dec(lnOri);
2521
if (lnOri < 4) and (lnOri > 0) then
2522
lOri[lnOri] := read64r(nc_Type)
2523
end;
2524
end;
2525
lFilePosition := lStartPosition + ((((nnelem*nc_size)+3) div 4)*4);
2526
2527
end;
2528
lDT0 := read32i;
2529
if lVarStr = 'image' then begin
2530
case lDT0 of
2531
1,2: lDicomData.Allocbits_per_pixel := 8;
2532
3: lDicomData.Allocbits_per_pixel := 16; //int16
2533
4: lDicomData.Allocbits_per_pixel := 32; //int32
2534
5: lDicomData.Allocbits_per_pixel := 32; //single
2535
6: lDicomData.Allocbits_per_pixel := 64; //double
2536
end;
2537
if (lDT0 = 5) or (lDT0 = 6) then
2538
lDicomData.Float := true;
2539
//xlDicomData.Storedbits_per_pixel := lDicomData.Allocbits_per_pixel;
2540
//lImgNC_Type := lDT0;
2541
end;
2542
end;
2543
vSizeRA := read32i;
2544
BeginRA := read32i;
2545
if lVarStr = 'image' then begin
2546
lDICOMdata.ImageStart := BeginRA;
2547
end;
2548
end; //for 1..nelem
2549
lDT := read32i;
2550
end;//DT=11
2551
if lDT = 12 then begin //DT=12, Attributes
2552
nelem := read32i;
2553
for j := 1 to nelem do begin
2554
lStr := readname;
2555
nc_type := read32i;
2556
nc_size := dTypeStr(nc_Type);
2557
nnelem := read32i;
2558
lFilePosition := lFilePosition + ((((nnelem*nc_size)+3) div 4)*4);
2559
end; //for 1..nelem
2560
lDT := read32i;
2561
end;//DT=12, Dimensions
2562
end; //while DT
2563
2564
if lOri[1] <> 0 then
2565
lDicomData.XYZori[1] := round((-lOri[1])/lDicomData.XYZmm[1])+1;
2566
if lOri[2] <> 0 then
2567
lDicomData.XYZori[2] := round((-lOri[2])/lDicomData.XYZmm[2])+1;
2568
if lOri[3] <> 0 then
2569
lDicomData.XYZori[3] := round((-lOri[3])/lDicomData.XYZmm[3])+1;
2570
2571
lDynStr := 'MINC image'+kCR+
2572
'XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'
2573
+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
2574
+kCR+'XYZ origin:' +inttostr(lDicomData.XYZori[1])+'/'
2575
+inttostr(lDicomData.XYZori[2])+'/'+inttostr(lDicomData.XYZori[3])
2576
+kCR+'XYZ size [mm or micron]:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
2577
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2)
2578
+kCR+'Bits per sample/Samples per pixel: '+inttostr( lDICOMdata.Allocbits_per_pixel)
2579
+kCR+'Data offset:' +inttostr(lDicomData.ImageStart);
2580
lHdrOK := true;
2581
lImageFormatOK := true;
2582
CloseFile(fp);
2583
FileMode := 2; //set to read/write
2584
end; //read_minc
2585
2586
2587
2588
//start TIF
2589
procedure read_tiff_data(var lDICOMdata: DICOMdata; var lReadOffsets, lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
2590
label
2591
566, 564;
2592
const
2593
kMaxnSLices = 6000;
2594
var
2595
lLongRA: LongIntP;
2596
lStackSameDim,lContiguous: boolean;
2597
l1stDicomData: DicomData;
2598
//lDouble : double;
2599
//lXmm,lYmm,lZmm: double;
2600
lSingle: single;
2601
lImageDataEndPosition,lStripPositionOffset,lStripPositionType,lStripPositionItems,
2602
lStripCountOffset,lStripCountType,lStripCountItems,
2603
lItem,lTagItems,lTagItemBytes,lTagPointer,lNumerator, lDenominator,
2604
lImage_File_Directory,lTagType,lVal,lDirOffset,lOffset,lFileSz,
2605
lnDirectories,lDir,lnSlices: Integer;
2606
lTag,lWord,lWord2: word;
2607
FP: file;
2608
(*FUNCTION longint2single ({var} s:longint): single;
2609
//returns true if s is Infinity, NAN or Indeterminate
2610
//4byte IEEE: msb[31] = signbit, bits[23-30] exponent, bits[0..22] mantissa
2611
//exponent of all 1s = Infinity, NAN or Indeterminate
2612
VAR Overlay: Single ABSOLUTE s;
2613
BEGIN
2614
result := Overlay;
2615
END;*)
2616
2617
function read64r(lPos: integer):double;
2618
type
2619
swaptype = packed record
2620
case byte of
2621
0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit
2622
1:(float:double);
2623
end;
2624
swaptypep = ^swaptype;
2625
var
2626
inguy:swaptypep;
2627
outguy:swaptype;
2628
s: double;
2629
begin
2630
seek(fp,lPos);
2631
BlockRead(fp, s, 8);
2632
inguy := @s; //assign address of s to inguy
2633
if lDICOMdata.Little_Endian = 0{false} then begin
2634
outguy.Word1 := swap(inguy^.Word4);
2635
outguy.Word2 := swap(inguy^.Word3);
2636
outguy.Word3 := swap(inguy^.Word2);
2637
outguy.Word4 := swap(inguy^.Word1);
2638
end else
2639
outguy.float := inguy^.float;
2640
result:=outguy.float;
2641
end;
2642
2643
function read32i(lPos: longint): Longint;
2644
type
2645
swaptype = packed record
2646
case byte of
2647
0:(Word1,Word2 : word); //word is 16 bit
2648
1:(Long:LongInt);
2649
end;
2650
swaptypep = ^swaptype;
2651
var
2652
s : LongInt;
2653
inguy:swaptypep;
2654
outguy:swaptype;
2655
begin
2656
seek(fp,lPos);
2657
BlockRead(fp, s, 4);
2658
inguy := @s; //assign address of s to inguy
2659
if lDICOMdata.Little_Endian = 0 then begin
2660
outguy.Word1 := swap(inguy^.Word2);
2661
outguy.Word2 := swap(inguy^.Word1);
2662
end else
2663
outguy.long := inguy^.long;
2664
result:=outguy.Long;
2665
end;
2666
function read16(lPos: longint): Longint;
2667
var
2668
s : word;
2669
begin
2670
seek(fp,lPos);
2671
BlockRead(fp, s, 2);
2672
if lDICOMdata.Little_Endian = 0 then
2673
result := swap(s)
2674
else
2675
result := s;
2676
end;
2677
2678
function read8(lPos: longint): Longint;
2679
var
2680
s : byte;
2681
begin
2682
seek(fp,lPos);
2683
BlockRead(fp, s, 1);
2684
result := s;
2685
end;
2686
2687
function readItem(lItemNum,lTagTypeI,lTagPointerI: integer): integer;
2688
begin
2689
if lTagTypeI= 4 then
2690
result := read32i(lTagPointerI+((lItemNum-1)*4))
2691
else
2692
result := read16(lTagPointerI+((lItemNum-1)*2));
2693
end;
2694
2695
begin
2696
Clear_Dicom_Data(lDicomData);
2697
if gECATJPEG_table_entries <> 0 then begin
2698
freemem (gECATJPEG_pos_table);
2699
freemem (gECATJPEG_size_table);
2700
gECATJPEG_table_entries := 0;
2701
end;
2702
//lXmm := -1; //not read
2703
lImageFormatOK := true;
2704
lHdrOK := false;
2705
if not fileexists(lFileName) then begin
2706
lImageFormatOK := false;
2707
exit;
2708
end;
2709
//lLongRASz := kMaxnSlices * sizeof(longint);
2710
getmem(lLongRA,kMaxnSlices*sizeof(longint));
2711
FileMode := 0; //set to readonly
2712
AssignFile(fp, lFileName);
2713
Reset(fp, 1);
2714
lFileSz := FileSize(fp);
2715
Clear_Dicom_Data(lDicomData);
2716
//xlDicomData.PlanarConfig:=0;
2717
if lFilesz < (28) then begin
2718
goto 566;
2719
end;
2720
//TmpStr := string(StrUpper(PChar(ExtractFileExt(lFileName))));
2721
//if not (TmpStr = '.TIF') or (TmpStr = '.TIFF') then exit;
2722
lWord := read16(0);
2723
if lWord = $4d4d then
2724
lDICOMdata.little_endian := 0
2725
else if lWord = $4949 then lDICOMdata.little_endian := 1;
2726
lWord2 := read16(2); //bits per pixel
2727
if ((lWord=$4d4d) or (lWord=$4949)) and (lWord2 = $002a) then
2728
else goto 566;
2729
lOffset := read32i(4);
2730
lImage_File_Directory := 0;
2731
lContiguous := true;
2732
lnSlices := 0;
2733
//xlDicomData.SamplesPerPixel := 1;
2734
//START while for each image_file_directory
2735
while (lOffset > 0) and ((lOffset+2+12+4) < lFileSz) do begin
2736
inc(lImage_File_Directory);
2737
lnDirectories := read16(lOffset);
2738
if (lnDirectories < 1) or ((lOffset+2+(12*lnDirectories)+4) > lFileSz) then
2739
goto 566;
2740
for lDir := 1 to lnDirectories do begin
2741
lDirOffset := lOffset+2+((lDir-1)*12);
2742
lTag := read16(lDirOffset);
2743
lTagType := read16(lDirOffset+2);
2744
lTagItems := read32i(lDirOffset+4);
2745
case lTagType of
2746
1: lVal := 1;//bytes
2747
3: lVal := 2;//word
2748
4: lVal := 4;//long
2749
5: lVal := 8;//rational
2750
else lVal := 1; //CHAR variable length
2751
end;
2752
lTagItemBytes := lVal * lTagItems;
2753
if lTagItemBytes > 4 then
2754
lTagPointer := read32i(lDirOffset+8)
2755
else
2756
lTagPointer := (lDirOffset+8);
2757
case lTagType of
2758
1: lVal := read8(lDirOffset+8);
2759
3: lVal := read16(lDirOffset+8);
2760
4: lVal := read32i(lDirOffset+8);
2761
5: begin //rational: two longs representing numerator and denominator
2762
lVal := read32i(lDirOffset+8);
2763
lNumerator := read32i(lVal);
2764
lDenominator := read32i(lVal+4);
2765
if lDenominator <> 0 then
2766
lSingle := lNumerator/lDenominator
2767
else
2768
lSingle := 1;
2769
if lSingle <> 0 then
2770
lSingle := 1/lSingle; //Xresolution/Yresolution refer to number of pixels per resolution_unit
2771
if lTag = 282 then lDicomData.XYZmm[1] := lSingle;
2772
if lTag = 283 then lDicomData.XYZmm[2] := lSingle;
2773
end;
2774
else lVal := 0;
2775
end;
2776
case lTag of
2777
//254: ;//NewSubFileType
2778
256: lDicomData.XYZdim[1] := lVal;//image_width
2779
257: lDicomData.XYZdim[2] := lVal;//image_height
2780
258: begin //bits per sample
2781
if lTagItemBytes > 4 then lVal := 8;
2782
//if lVal <> 8 then goto 566;
2783
lDicomData.Allocbits_per_pixel := lVal;//bits
2784
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
2785
end;
2786
259: begin
2787
if lVal <> 1 then begin
2788
Msg('TIFF Read Error: Image data is compressed. Currently only uncompressed data is supported.');
2789
goto 566; //compressed data
2790
end;
2791
end;
2792
//x262: if lVal = 0 then lDicomdata.monochrome := 1;//invert colors //photometric_interpretation //MinIsWhite,MinIsBlack,Palette
2793
//270: ; //ImageDescription
2794
273: begin //get offset to data
2795
lStripPositionOffset := lTagPointer;
2796
lStripPositionType := lTagType;
2797
lStripPositionItems := lTagItems;
2798
if (lImage_File_Directory=1) then
2799
lDicomData.ImageStart := readItem(1,lStripPositionType,lStripPositionOffset);
2800
end; //StripOffsets
2801
//274: ; //orientation
2802
277: begin
2803
//xlDicomData.SamplesPerPixel := lVal;
2804
//if lVal <> 1 then goto 566; //samples per pixel
2805
end;
2806
279: begin
2807
lStripCountOffset := lTagPointer;
2808
lStripCountType := lTagType;
2809
lStripCountItems := lTagItems;
2810
end;
2811
//278: message('rows:'+inttostr(lVal));//StripByteCount
2812
//279: message('count:'+inttostr(lVal));//StripByteCount
2813
//282 and 283 are rational values and read separately
2814
284: begin
2815
{xif lVal = 1 then
2816
lDicomData.PlanarConfig:= 0
2817
else
2818
lDicomData.PlanarConfig:= 1;//planarConfig
2819
} end;
2820
34412: begin
2821
//Zeiss data header
2822
//0020h float x size of a pixel (�m or s)
2823
//0024h float y size of a pixel (�m or s)
2824
//0028h float z distance in a sequence (�m or s)
2825
{stream.seek((int)position + 40);
2826
VOXELSIZE_X = swap(stream.readDouble());
2827
stream.seek((int)position + 48);
2828
VOXELSIZE_Y = swap(stream.readDouble());
2829
stream.seek((int)position + 56);
2830
VOXELSIZE_Z = swap(stream.readDouble());}
2831
lVal := read16(lTagPointer+2);
2832
if lVal = 1024 then begin //LSM510 v2.8 images
2833
lDicomData.XYZmm[1]{lXmm} := read64r(lTagPointer+40)*1000000;
2834
lDicomData.XYZmm[2]{lYmm} := read64r(lTagPointer+48)*1000000;
2835
lDicomData.XYZmm[3]{lZmm} := read64r(lTagPointer+56)*1000000;
2836
end;
2837
//following may work if lVal = 2, different type of LSM file I have not seen
2838
//lXmm := longint2single(read32i(lTagPointer+$0020));
2839
//lYmm := longint2single(read32i(lTagPointer+$0024));
2840
//lZmm := longint2single(read32i(lTagPointer+$0028));
2841
end;
2842
//296: ;//resolutionUnit 1=undefined, 2=inch, 3=centimeter
2843
//320??
2844
//LEICA: 34412
2845
//SOFTWARE = 305
2846
//DATE_TIME = 306
2847
//ARTIST = 315
2848
//PREDICTOR = 317
2849
//COLORMAP = 320 => essntially custom LookUpTable
2850
//EXTRASAMPLES = 338
2851
//SAMPLEFORMAT = 339
2852
//JPEGTABLES = 347
2853
// lDicomData.ImageStart := lVal
2854
//else if lImage_File_Directory = 1 then Msg(inttostr(lTag)+'@'+inttostr(lTagPointer)+' value: '+inttostr(lVal));
2855
end; //case lTag
2856
end; //For Each Directory in Image_File_Directory
2857
lOffset := read32i(lOffset+2+(12*lnDirectories));
2858
//NEXT: check that each slice in 3D slice is the same dimension
2859
lStackSameDim := true;
2860
if (lImage_File_Directory=1) then begin
2861
l1stDicomData := lDICOMdata;
2862
lnSlices := 1; //inc(lnSlices);
2863
end else begin
2864
if lDicomData.XYZdim[1] <> l1stDicomData.XYZdim[1] then lStackSameDim := false;
2865
if lDicomData.XYZdim[2] <> l1stDicomData.XYZdim[2] then lStackSameDim := false;
2866
if lDicomData.Allocbits_per_pixel <> l1stDicomData.Allocbits_per_pixel then lStackSameDim := false;
2867
//xif lDicomData.SamplesPerPixel <> l1stDicomData.SamplesPerPixel then lStackSameDim := false;
2868
//xif lDicomData.PlanarConfig <> l1stDicomData.PlanarConfig then lStackSameDim := false;
2869
if not lStackSameDim then begin
2870
//Msg(inttostr(lDicomData.XYZdim[1])+'x'+inttostr(l1stDicomData.XYZdim[1]));
2871
if (lDicomData.XYZdim[1]*lDicomData.XYZdim[2]) > (l1stDicomData.XYZdim[1]*l1stDicomData.XYZdim[2]) then begin
2872
l1stDicomData := lDICOMdata;
2873
lnSlices := 1;
2874
lStackSameDim := true;
2875
end;
2876
//Msg('TIFF Read Error: Different 2D slices in this 3D stack have different dimensions.');
2877
//goto 566;
2878
end else
2879
inc(lnSlices); //if not samedim
2880
end; //check that each slice is same dimension as 1st
2881
//END check each 2D slice in 3D stack is same dimension
2882
//NEXT: check if image data is contiguous
2883
if (lStripCountItems > 0) and (lStripCountItems = lStripPositionItems) then begin
2884
if (lnSlices=1) then lImageDataEndPosition := lDicomData.ImageStart;
2885
for lItem := 1 to lStripCountItems do begin
2886
lVal := readItem(lItem,lStripPositionType,lStripPositionOffset);
2887
if (lVal <> lImageDataEndPosition) then
2888
lContiguous := false;
2889
//Msg(inttostr(lImage_File_Directory)+'@'+inttostr(lItem));
2890
lImageDataEndPosition := lImageDataEndPosition+readItem(lItem,lStripCountType,lStripCountOffset);
2891
if not lcontiguous then begin
2892
if (lReadOffsets) and (lStackSameDim) then begin
2893
lLongRA^[lnSlices] := lVal;
2894
end else if (lReadOffsets) then
2895
//not correct size, but do not generate an error as we will read non-contiguous files
2896
else begin
2897
Msg('TIFF Read Error: Image data is not stored contiguously. '+
2898
'Solution: convert this image using MRIcro''s ''Convert TIFF/Zeiss to Analyze...'' command [Import menu].');
2899
goto 564;
2900
end;
2901
end; //if not contiguous
2902
end; //for each item
2903
end;//at least one StripItem}
2904
//END check image data is contiguous
2905
end; //END while each Image_file_directory
2906
lDicomData := l1stDicomData;
2907
lDicomData.XYZdim[3] := lnSlices;
2908
if (lReadOffsets) and (lnSlices > 1) and (not lcontiguous) then begin
2909
gECATJPEG_table_entries := lnSlices; //Offset tables for TIFF
2910
getmem (gECATJPEG_pos_table, gECATJPEG_table_entries*sizeof(longint));
2911
getmem (gECATJPEG_size_table, gECATJPEG_table_entries*sizeof(longint));
2912
gECATJPEG_pos_table^[1] := l1stDicomData.ImageStart;
2913
for lVal := 2 to gECATJPEG_table_entries do
2914
gECATJPEG_pos_table^[lVal] := lLongRA^[lVal]
2915
end;
2916
lHdrOK := true;
2917
564:
2918
lDynStr := 'TIFF image'+kCR+
2919
'XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'
2920
+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
2921
+kCR+'XYZ size [mm or micron]:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
2922
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2)
2923
+kCR+'Bits per sample/Samples per pixel: '+inttostr( lDICOMdata.Allocbits_per_pixel)
2924
+kCR+'Data offset:' +inttostr(lDicomData.ImageStart);
2925
{if lXmm > 0 then
2926
lDynStr := lDynStr +kCR+'Zeiss XYZ mm:'+floattostr(lXmm)+'/'
2927
+floattostr(lYmm)+'/'
2928
+floattostr(lZmm);}
2929
566:
2930
freemem(lLongRA);
2931
CloseFile(fp);
2932
FileMode := 2; //set to read/write
2933
end;
2934
2935
procedure read_biorad_data(var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;lFileName: string);
2936
var
2937
lCh: char;
2938
lByte: Byte;
2939
lSpaces,liPos,lFileSz,lWord,lNotes,lStart,lEnd: integer;
2940
tx : array [0..80] of Char;
2941
lInfo,lStr,lTmpStr: string;
2942
FP: file;
2943
procedure read16(lPos: longint; var lVal: integer);
2944
var lInWord: word;
2945
begin
2946
seek(fp,lPos);
2947
BlockRead(fp, lInWord, 2);
2948
lVal := lInWord;
2949
end;
2950
procedure read32(lPos: longint; var lVal: integer);
2951
var lInINt: integer;
2952
begin
2953
seek(fp,lPos);
2954
BlockRead(fp, lInINt, 4);
2955
lVal :=lInINt;
2956
end;
2957
2958
begin
2959
lImageFormatOK := true;
2960
lHdrOK := false;
2961
if not fileexists(lFileName) then begin
2962
lImageFormatOK := false;
2963
exit;
2964
end;
2965
FileMode := 0; //set to readonly
2966
AssignFile(fp, lFileName);
2967
Reset(fp, 1);
2968
lFileSz := FileSize(fp);
2969
Clear_Dicom_Data(lDicomData);
2970
if lFilesz < (77) then exit; //to small to be biorad
2971
read16(54,lWord);
2972
if (lWord=12345) then begin
2973
lDicomData.little_endian := 1;
2974
read16(0,lDicomData.XYZdim[1]);
2975
read16(2,lDicomData.XYZdim[2]);
2976
read16(4,lDicomData.XYZdim[3]);
2977
read16(14,lWord);//byte format
2978
if lWord = 1 then
2979
lDicomData.Allocbits_per_pixel := 8
2980
else
2981
lDicomData.Allocbits_per_pixel := 16;//bits
2982
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
2983
lDicomData.ImageStart := 76;
2984
read32(10,lNotes);
2985
lStart := (lDicomData.XYZdim[1]*lDicomData.XYZdim[2]*lDicomData.XYZdim[3])+76;
2986
lEnd := lStart + 96;
2987
lDynStr := 'BIORAD PIC image'+kCR;
2988
while (lNotes > 0) and (lFileSz >= lEnd) do begin
2989
read32(lStart+2,lNotes); //final note has bytes 2..5 set to zero
2990
//read16(lStart+10,lNoteType);
2991
//if lNoteType <> 1 then begin //ignore 'LIVE' notes - they do not include calibration info
2992
seek(fp, lStart+16);
2993
BlockRead(fp, tx, 80{, n});
2994
lStr := '';
2995
liPos := 0;
2996
repeat
2997
lCh := tx[liPos];
2998
lByte := ord(lCh);
2999
if (lByte >= 32) and (lByte <= 126) then
3000
lStr := lStr+lCh
3001
else lByte := 0;
3002
inc(liPos);
3003
until (liPos = 80) or (lByte = 0);
3004
if length(lStr) > 6 then begin
3005
lInfo := '';
3006
for liPos := 1 to 6 do
3007
lInfo := lInfo+upcase(lStr[liPos]);
3008
ltmpstr := '';
3009
lSpaces := 0;
3010
for liPos := 1 to 80 do begin
3011
if lStr[liPos]=' ' then inc(lSpaces)
3012
else if lSpaces = 3 then
3013
ltmpstr := ltmpstr + lStr[liPos];
3014
end;
3015
if ltmpstr = '' then {no value to read}
3016
else if lInfo = 'AXIS_2' then
3017
lDicomData.XYZmm[1] := strtofloat(ltmpstr)
3018
else if lInfo = 'AXIS_3' then
3019
lDicomData.XYZmm[2] := strtofloat(ltmpstr)
3020
else if linfo = 'AXIS_4' then
3021
lDicomData.XYZmm[3] := strtofloat(ltmpstr);
3022
lDynStr := lDynStr+lStr+kCR;
3023
end; //Str length > 6
3024
//end;//notetype
3025
lStart := lEnd;
3026
lEnd := lEnd + 96;
3027
end; //while notes
3028
lHdrOK := true;
3029
//lImageFormatOK := true;
3030
end;//biorad signature
3031
CloseFile(fp);
3032
FileMode := 2; //set to read/write
3033
lDynStr := 'BioRad image'+kCR+
3034
'XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'
3035
+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
3036
+kCR+'XYZ size [mm or micron]:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
3037
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2)
3038
+kCR+'Bits per sample/Samples per pixel: '+inttostr( lDICOMdata.Allocbits_per_pixel)
3039
+kCR+'Data offset:' +inttostr(lDicomData.ImageStart);
3040
end; //biorad
3041
3042
3043
3044
3045
3046
procedure read_dicom_data_compat(lReadJPEGtables,lVerboseRead,lAutoDECAT7,lReadECAToffsetTables,lAutoDetectInterfile,lAutoDetectGenesis,lReadColorTables: boolean; var lDICOMdata: DICOMdata; var lHdrOK, lImageFormatOK: boolean; var lDynStr: string;var lFileName: string; var lPrefs: TPrefs);
3047
label 666,777;
3048
const
3049
kMaxTextBuf = 50000; //maximum for screen output
3050
kDiskCache = 16384; //size of disk buffer
3051
3052
type
3053
dicom_types = (unknown, i8, i16, i32, ui8, ui16, ui32, _string{,_float} );
3054
var
3055
// lTextF: TextFile; //abba
3056
lDICOMdataBackUp: DICOMdata;
3057
lWord,lWord2,lWord3: word;
3058
lWordRA: Wordp;
3059
lDiskCacheRA: pChar{ByteP};
3060
lRot1,lRot2,lRot3 : integer;//rotation dummies for AFNI
3061
FP: file;
3062
lT0,lT1,lT2,lT3:byte;
3063
lImagePositionPatientRead,
3064
lResearchMode,lManufacturerIsPhilips,lManufacturerIsBruker,lMediface0002_0013,lSiemensMosaic0008_0008,lDICM_at_128, lTextOverFlow,lGenesis,lFirstPass,lrOK,lBig,lBigSet,lGrp,explicitVR,first_one : Boolean;
3065
lTestError,lByteSwap,lGELX,time_to_quit,lProprietaryImageThumbnail,lFirstFragment,lOldSiemens_IncorrectMosaicMM : Boolean;
3066
group, element, e_len, remaining, tmp : uint32;
3067
tmpstr : kDICOMstr;
3068
lgrpstr,lStr,info,lDummyStr : string;
3069
t : dicom_types;
3070
lfloat1,lfloat2,lfloat3,lThickness: double;
3071
lTempInt,lEchoNum,lnVol,lnSlicePerVol,lJPEGentries,lErr,liPos,lCacheStart,lCachePos,lDiskCacheSz,n, i,value, Ht,Width,
3072
max16,min16,filesz,where,lMatrixSz,lPhaseEncodingSteps,lJunk,lJunk2,lJunk3 : LongInt;
3073
tx : array [0..96] of Char;
3074
l4DDistanceBetweenSliceCenters,lPhilipsScaleSlope: single;
3075
buff: pCHar;
3076
lColorRA: bytep;
3077
lLongRA: Longintp;
3078
lSingleRA,lInterceptRA: Singlep;
3079
//lPapyrusnSlices,lPapyrusSlice : integer;
3080
//lPapyrusZero,lPapyrus : boolean;
3081
procedure ByteSwap (var lInOut: integer);
3082
var lWord: word;
3083
begin
3084
lWord := lInOut;
3085
lWord := swap(lWord);
3086
lInOut := lWord;
3087
end;
3088
procedure dReadCache (lFileStart: integer);
3089
begin
3090
lCacheStart := lFileStart{lCacheStart + lDiskCacheSz};//eliminate old start
3091
if lCacheStart < 0 then lCacheStart := 0;
3092
if lDiskCacheSz > 0 then freemem(lDiskCacheRA);
3093
if (FileSz-(lCacheStart)) < kDiskCache then
3094
lDiskCacheSz := FileSz - (lCacheStart)
3095
else
3096
lDiskCacheSz := kDiskCache;
3097
lCachePos := 0;
3098
if (lDiskCacheSz < 1) then exit{goto 666};
3099
if (lDiskCacheSz+lCacheStart) > FileSz then exit;
3100
Seek(fp, lCacheStart);
3101
3102
GetMem(lDiskCacheRA, lDiskCacheSz {bytes});
3103
BlockRead(fp, lDiskCacheRA^, lDiskCacheSz, n);
3104
end;
3105
3106
function dFilePos (var lInFP: file): integer;
3107
begin
3108
Result := lCacheStart + lCachePos;
3109
end;
3110
procedure dSeek (var lInFP: file; lPos: integer);
3111
begin
3112
if (lPos >= lCacheStart) and (lPos < (lDiskCacheSz+lCacheStart)) then begin
3113
lCachePos := lPos-lCacheStart;
3114
exit;
3115
end;
3116
dReadCache(lPos);
3117
end;
3118
3119
procedure dBlockRead (var lInfp: file; lInbuff: pChar; e_len: integer; var n: integer);
3120
var lN: integer;
3121
begin
3122
N := 0;
3123
if e_len < 0 then exit;
3124
for lN := 0 to (e_len-1) do begin
3125
if lCachePos >= lDiskCacheSz then begin
3126
dReadCache(lCacheStart+lDiskCacheSz);
3127
if lDiskCacheSz < 1 then exit;
3128
lCachePos := 0;
3129
end;
3130
N := lN;
3131
lInBuff[N] := lDiskCacheRA[lCachePos];
3132
inc(lCachePos);
3133
end;
3134
end;
3135
procedure readfloats (var fp: file; remaining: integer; var lOutStr: string; var lf1, lf2: double; var lReadOK: boolean);
3136
var lDigit : boolean;
3137
li,lLen,n: integer;
3138
lfStr: string;
3139
begin
3140
lf1 := 1;
3141
lf2 := 2;
3142
if e_len = 0 then begin
3143
lReadOK := true;
3144
exit;
3145
end;
3146
if (dFilePos(fp) > (filesz-remaining)) or (remaining < 1) then begin
3147
lOutStr := '';
3148
lReadOK := false;
3149
exit;
3150
end else
3151
lReadOK := true;
3152
lOutStr := '';
3153
GetMem( buff, e_len);
3154
dBlockRead(fp, buff{^}, e_len, n);
3155
for li := 0 to e_len-1 do
3156
if Char(buff[li]) in [{'/','\', delete: rev18}'e','E','+','-','.','0'..'9']
3157
then lOutStr := lOutStr +(Char(buff[li]))
3158
else begin
3159
lOutStr := lOutStr + ' ';
3160
end;
3161
FreeMem( buff);
3162
lfStr := '';
3163
lLen := length(lOutStr);
3164
3165
li := 1;
3166
lDigit := false;
3167
repeat
3168
if (lOutStr[li] in ['+','-','e','E','.','0'..'9']) then
3169
lfStr := lfStr + lOutStr[li];
3170
if lOutStr[li] in ['0'..'9'] then lDigit := true;
3171
inc(li);
3172
until (li > lLen) or (lDigit);
3173
if not lDigit then exit;
3174
if li <= li then begin
3175
repeat
3176
if not (lOutStr[li] in ['+','-','e','E','.','0'..'9']) then lDigit := false
3177
else begin
3178
if lOutStr[li] = 'E' then lfStr := lfStr+'e'
3179
else
3180
lfStr := lfStr + lOutStr[li];
3181
end;
3182
inc(li);
3183
until (li > lLen) or (not lDigit);
3184
end;
3185
//QStr(lfStr);
3186
try
3187
lf1 := strtofloat(lfStr);
3188
except
3189
on EConvertError do begin
3190
Msg('Unable to convert the string '+lfStr+' to a real number');
3191
lf1 := 1;
3192
exit;
3193
end;
3194
end; {except}
3195
lfStr := '';
3196
if li > llen then exit;
3197
repeat
3198
if (lOutStr[li] in ['+','E','e','.','-','0'..'9']) then begin
3199
if lOutStr[li] = 'E' then lfStr := lfStr+'e'
3200
else
3201
lfStr := lfStr + lOutStr[li];
3202
end;
3203
if (lOutStr[li] in ['0'..'9']) then lDigit := true;
3204
inc(li);
3205
until (li > lLen) or ((lDigit) and (lOutStr[li]=' ')); //second half: rev18
3206
if not lDigit then exit;
3207
//QStr(lfStr);
3208
try
3209
lf2 := strtofloat(lfStr);
3210
except
3211
on EConvertError do begin
3212
Msg('Unable to convert the string '+lfStr+' to a real number');
3213
exit;
3214
end;
3215
end;
3216
3217
end;
3218
3219
procedure readfloats3 (var fp: file; remaining: integer; var lOutStr: string; var lf1, lf2,lf3: double; var lReadOK: boolean);
3220
var lDigit : boolean;
3221
lItem,li,lLen,n: integer;
3222
lfTemp: double;
3223
lfStr: string;
3224
begin
3225
lf1 := 0;
3226
lf2 := 0;
3227
lf3 := 0;
3228
lOutStr := '';
3229
if e_len = 0 then begin
3230
lReadOK := true;
3231
exit;
3232
end;
3233
if (dFilePos(fp) > (filesz-remaining)) or (remaining < 1) then begin
3234
lReadOK := false;
3235
exit;
3236
end else
3237
lReadOK := true;
3238
GetMem( buff, e_len);
3239
dBlockRead(fp, buff{^}, e_len, n);
3240
for li := 0 to e_len-1 do
3241
if Char(buff[li]) in [{'/','\', delete: rev18}'e','E','+','-','.','0'..'9']
3242
then lOutStr := lOutStr +(Char(buff[li]))
3243
else lOutStr := lOutStr + ' ';
3244
FreeMem( buff);
3245
li := 1;
3246
lLen := length(lOutStr);
3247
for lItem := 1 to 3 do begin
3248
if li > llen then exit;
3249
lfStr := '';
3250
lLen := length(lOutStr);
3251
lDigit := false;
3252
repeat
3253
if (lOutStr[li] in ['+','-','e','E','.','0'..'9']) then
3254
lfStr := lfStr + lOutStr[li];
3255
if lOutStr[li] in ['0'..'9'] then lDigit := true;
3256
inc(li);
3257
until (li > lLen) or (lDigit);
3258
if not lDigit then exit;
3259
if li <= li then begin
3260
repeat
3261
if not (lOutStr[li] in ['+','-','e','E','.','0'..'9']) then lDigit := false
3262
else begin
3263
if lOutStr[li] = 'E' then lfStr := lfStr+'e'
3264
else
3265
lfStr := lfStr + lOutStr[li];
3266
end;
3267
inc(li);
3268
until (li > lLen) or (not lDigit);
3269
end;
3270
//QStr(lfStr);
3271
try
3272
lftemp := strtofloat(lfStr);
3273
except
3274
on EConvertError do begin
3275
Msg('Unable to convert the string '+lfStr+' to a real number');
3276
//lftemp := 0;
3277
exit;
3278
end;
3279
end; {except}
3280
case lItem of
3281
2: lf2 := lftemp;
3282
3: lf3 := lftemp;
3283
else lf1 := lftemp;
3284
end; //case of lItem
3285
end; //for each of 3 lItems
3286
end; //readfloats3
3287
3288
procedure CheckIntersliceDistance (var lMinDistance: single);
3289
var
3290
lX,lY,lZ,lDx: double;
3291
begin
3292
readfloats3 (fp, remaining, lDummyStr, lX, lY,lZ, lROK);
3293
3294
e_len := 0;
3295
remaining := 0;
3296
//compute Distance between current slice and 1st slice...
3297
lDx := sqrt( sqr(lX-lDicomData.PatientPosX)+sqr(lY-lDicomData.PatientPosY)+sqr(lZ-lDicomData.PatientPosZ));
3298
if (lDx > 0) and (lDx < lMinDistance) then //if 0 then this is a repeat, not a new slice
3299
lMinDistance := lDx;
3300
end;
3301
3302
procedure readfloats6 (var fp: file; remaining: integer; var lOutStr: string; var lf1, lf2,lf3,lf4,lf5,lf6: double; var lReadOK: boolean);
3303
var lDigit : boolean;
3304
lItem,li,lLen,n: integer;
3305
lfTemp: single;
3306
lfStr: string;
3307
begin
3308
lf1 := 0;
3309
lf2 := 0;
3310
lf3 := 0;
3311
lf4 := 0;
3312
lf5 := 0;
3313
lf6 := 0;
3314
lOutStr := '';
3315
if e_len = 0 then begin
3316
lReadOK := true;
3317
exit;
3318
end;
3319
if (dFilePos(fp) > (filesz-remaining)) or (remaining < 1) then begin
3320
lReadOK := false;
3321
exit;
3322
end else
3323
lReadOK := true;
3324
GetMem( buff, e_len);
3325
dBlockRead(fp, buff{^}, e_len, n);
3326
for li := 0 to e_len-1 do
3327
if Char(buff[li]) in [{'/','\', delete: rev18}'e','E','+','-','.','0'..'9']
3328
then lOutStr := lOutStr +(Char(buff[li]))
3329
else lOutStr := lOutStr + ' ';
3330
FreeMem( buff);
3331
li := 1;
3332
lLen := length(lOutStr);
3333
for lItem := 1 to 6 do begin
3334
if li > llen then exit;
3335
lfStr := '';
3336
lLen := length(lOutStr);
3337
lDigit := false;
3338
repeat
3339
if (lOutStr[li] in ['+','-','e','E','.','0'..'9']) then
3340
lfStr := lfStr + lOutStr[li];
3341
if lOutStr[li] in ['0'..'9'] then lDigit := true;
3342
inc(li);
3343
until (li > lLen) or (lDigit);
3344
if not lDigit then exit;
3345
if li <= li then begin
3346
repeat
3347
if not (lOutStr[li] in ['+','-','e','E','.','0'..'9']) then lDigit := false
3348
else begin
3349
if lOutStr[li] = 'E' then lfStr := lfStr+'e'
3350
else
3351
lfStr := lfStr + lOutStr[li];
3352
end;
3353
inc(li);
3354
until (li > lLen) or (not lDigit);
3355
end;
3356
3357
//QStr(lfStr);
3358
try
3359
lftemp := strtofloat(lfStr);
3360
except
3361
on EConvertError do begin
3362
Msg('Unable to convert the string '+lfStr+' to a real number');
3363
//lftemp := 0;
3364
exit;
3365
end;
3366
end; {except}
3367
case lItem of
3368
2: lf2 := lftemp;
3369
3: lf3 := lftemp;
3370
4: lf4 := lftemp;
3371
5: lf5 := lftemp;
3372
6: lf6 := lftemp;
3373
else lf1 := lftemp;
3374
end; //case of lItem
3375
end; //for each of 3 lItems
3376
end;
3377
3378
function read16( var fp : File; var lReadOK: boolean ): uint16;
3379
var
3380
t1, t2 : uint8;
3381
n : Integer;
3382
begin
3383
if dFilePos(fp) > (filesz-2) then begin
3384
read16 := 0;
3385
lReadOK := false;
3386
exit;
3387
end else
3388
lReadOK := true;
3389
GetMem( buff, 2);
3390
dBlockRead(fp, buff{^}, 2, n);
3391
T1 := ord(buff[0]);
3392
T2 := ord(buff[1]);
3393
freemem(buff);
3394
if lDICOMdata.little_endian <> 0
3395
then Result := (t1 + t2*256) AND $FFFF
3396
else Result := (t1*256 + t2) AND $FFFF;
3397
end;
3398
3399
function ReadStr(var fp: file; remaining: integer; var lReadOK: boolean; VAR lmaxval:integer) : string;
3400
var lInc, lN,Val,n: integer;
3401
t1, t2 : uint8;
3402
lStr : String;
3403
begin
3404
lMaxVal := 0;
3405
if dFilePos(fp) > (filesz-remaining) then begin
3406
lReadOK := false;
3407
exit;
3408
end else
3409
lReadOK := true;
3410
Result := '';
3411
lN := remaining div 2;
3412
if lN < 1 then exit;
3413
lStr := '';
3414
for lInc := 1 to lN do begin
3415
GetMem( buff, 2);
3416
dBlockRead(fp, buff{^}, 2, n);
3417
T1 := ord(buff[0]);
3418
T2 := ord(buff[1]);
3419
freemem(buff);
3420
if lDICOMdata.little_endian <> 0 then
3421
Val := (t1 + t2*256) AND $FFFF
3422
else
3423
Val := (t1*256 + t2) AND $FFFF;
3424
if lInc < lN then
3425
lStr := lStr + inttostr(Val)+ ', '
3426
else
3427
lStr := lStr + inttostr(Val);
3428
if Val > lMaxVal then
3429
lMaxVal := Val;
3430
end;
3431
Result := lStr;
3432
if odd(remaining) then begin
3433
getmem(buff,1);
3434
dBlockRead(fp, buff{t1}, SizeOf(uint8), n);
3435
freemem(buff);
3436
end;
3437
end;
3438
3439
(*function ReadStrABC(var fp: file; remaining: integer; var lReadOK: boolean; VAR lA,lB,lC:integer) : string;
3440
var lInc, lN,Val,n: integer;
3441
t1, t2 : uint8;
3442
lStr : String;
3443
begin
3444
lA := 0;
3445
lB := 0;
3446
lC := 0;
3447
if dFilePos(fp) > (filesz-remaining) then begin
3448
lReadOK := false;
3449
exit;
3450
end else
3451
lReadOK := true;
3452
Result := '';
3453
lN := remaining div 2;
3454
if lN < 1 then exit;
3455
lStr := '';
3456
for lInc := 1 to lN do begin
3457
GetMem( buff, 2);
3458
dBlockRead(fp, buff{^}, 2, n);
3459
T1 := ord(buff[0]);
3460
T2 := ord(buff[1]);
3461
freemem(buff);
3462
if lDICOMdata.little_endian <> 0 then
3463
Val := (t1 + t2*256) AND $FFFF
3464
else
3465
Val := (t1*256 + t2) AND $FFFF;
3466
if lInc < lN then
3467
lStr := lStr + inttostr(Val)+ ', '
3468
else
3469
lStr := lStr + inttostr(Val);
3470
if lInc = 1 then
3471
lA := Val;
3472
if lInc = 2 then
3473
lB := Val;
3474
if lInc = 3 then
3475
lC := Val;
3476
3477
3478
end;
3479
Result := lStr;
3480
if odd(remaining) then begin
3481
getmem(buff,1);
3482
dBlockRead(fp, buff{t1}, SizeOf(uint8), n);
3483
freemem(buff);
3484
end;
3485
end; *)
3486
3487
function ReadStrHex(var fp: file; remaining: integer; var lReadOK: boolean) : string;
3488
var lInc, lN,Val,n: integer;
3489
t1, t2 : uint8;
3490
lStr : String;
3491
begin
3492
if dFilePos(fp) > (filesz-remaining) then begin
3493
lReadOK := false;
3494
exit;
3495
end else
3496
lReadOK := true;
3497
Result := '';
3498
lN := remaining div 2;
3499
if lN < 1 then exit;
3500
lStr := '';
3501
for lInc := 1 to lN do begin
3502
GetMem( buff, 2);
3503
dBlockRead(fp, buff, 2, n);
3504
T1 := ord(buff[0]);
3505
T2 := ord(buff[1]);
3506
freemem(buff);
3507
if lDICOMdata.little_endian <> 0 then
3508
Val := (t1 + t2*256) AND $FFFF
3509
else
3510
Val := (t1*256 + t2) AND $FFFF;
3511
if lInc < lN then lStr := lStr + 'x'+inttohex(Val,4)+ ', '
3512
else lStr := lStr + 'x'+inttohex(Val,4);
3513
end;
3514
Result := lStr;
3515
if odd(remaining) then begin
3516
getmem(buff,1);
3517
dBlockRead(fp, {t1}buff, SizeOf(uint8), n);
3518
freemem(buff);
3519
end;
3520
end;
3521
function SomaTomFloat: double;
3522
var lSomaStr: String;
3523
begin
3524
//dSeek(fp,5992); //Slice Thickness from 5790 "SL 3.0"
3525
//dSeek(fp,5841); //Field of View from 5838 "FoV 281"
3526
//dSeek(fp,lPos);
3527
lSomaStr := '';
3528
tx[0] := 'x';
3529
while (length(lSomaStr) < 64) and (tx[0] <> chr(0)) and (tx[0] <> '/') do begin
3530
dBlockRead(fp, tx, 1, n);
3531
if tx[0] in ['+','-','.','0'..'9','e','E'] then
3532
lSomaStr := lSomaStr + tx[0];
3533
end;
3534
if length(lSOmaStr) > 0 then
3535
result := StrToFloat(lSomaStr)
3536
else
3537
result := 0;
3538
end;
3539
3540
function PGMreadInt: integer;
3541
//reads integer from PGM header, disregards comment lines (which start with '#' symbol);
3542
var lStr: string;
3543
lDigit: boolean;
3544
3545
begin
3546
Result := 1;
3547
lStr := '';
3548
repeat
3549
dBlockRead(fp, tx, 1, n);
3550
if tx[0] = '#' then begin //comment
3551
repeat
3552
dBlockRead(fp, tx, 1, n);
3553
until (ord(tx[0]) = $0A) or (dFilePos(fp) > (filesz-4)); //eoln indicates end of comment
3554
end; //finished reading comment
3555
if tx[0] in ['0'..'9'] then begin
3556
lStr := lStr + tx[0];
3557
lDigit := true;
3558
end else
3559
lDigit := false;
3560
until ((lStr <> '') and (not lDigit)) or (dFilePos(fp) > (filesz-4)); //read digits until you hit whitespace
3561
if lStr <> '' then
3562
Result := strtoint(lStr);
3563
3564
{lStr := '';
3565
tx[0] := 'x';
3566
while (length(lStr) < 64) and (ord(tx[0]) <> $0A) do begin
3567
dBlockRead(fp, tx, 1, n);
3568
if tx[0] in ['#','+','-','.','0'..'9','e','E',' ','a'..'z','A'..'Z'] then
3569
lStr := lStr + tx[0];
3570
end;
3571
result := lStr; }
3572
end;
3573
3574
function read32 ( var fp : File; var lReadOK: boolean ): uint32;
3575
var
3576
t1, t2, t3, t4 : byte;
3577
n : Integer;
3578
begin
3579
if dFilePos(fp) > (filesz-4) then begin
3580
Read32 := 0;
3581
lReadOK := false;
3582
exit;
3583
end else
3584
lReadOK := true;
3585
GetMem( buff, 4);
3586
dBlockRead(fp, buff{^}, 4, n);
3587
T1 := ord(buff[0]);
3588
T2 := ord(buff[1]);
3589
T3 := ord(buff[2]);
3590
T4 := ord(buff[3]);
3591
freemem(buff);
3592
if lDICOMdata.little_endian <> 0 then
3593
Result := t1 + (t2 shl 8) + (t3 shl 16) + (t4 shl 24)
3594
else
3595
Result := t4 + (t3 shl 8) + (t2 shl 16) + (t1 shl 24)
3596
//if lDICOMdata.little_endian <> 0
3597
//then Result := (t1 + t2*256 + t3*256*256 + t4*256*256*256) AND $FFFFFFFF
3598
//else Result := (t1*256*256*256 + t2*256*256 + t3*256 + t4) AND $FFFFFFFF;
3599
end;
3600
3601
function read32r ( var fp : File; var lReadOK: boolean ): single; //1382
3602
type
3603
swaptype = packed record
3604
case byte of
3605
0:(Word1,Word2 : word); //word is 16 bit
3606
1:(float:single);
3607
end;
3608
swaptypep = ^swaptype;
3609
var
3610
s:single;
3611
inguy:swaptypep;
3612
outguy:swaptype;
3613
begin
3614
if dFilePos(fp) > (filesz-4) then begin
3615
read32r := 0;
3616
lReadOK := false;
3617
exit;
3618
end else
3619
lReadOK := true;
3620
//GetMem( buff, 8);
3621
dBlockRead(fp, @s, 4, n);
3622
inguy := @s; //assign address of s to inguy
3623
if lDICOMdata.little_endian <> 1 then begin
3624
outguy.Word1 := swap(inguy^.Word2);
3625
outguy.Word2 := swap(inguy^.Word1);
3626
end else
3627
outguy.float := s; //1382 read64 needs to handle little endian in this way as well...
3628
read32r:=outguy.float;
3629
end;
3630
3631
function read64 ( var fp : File; var lReadOK: boolean ): double;
3632
type
3633
swaptype = packed record
3634
case byte of
3635
0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit
3636
1:(float:double);
3637
end;
3638
swaptypep = ^swaptype;
3639
var
3640
s:double;
3641
inguy:swaptypep;
3642
outguy:swaptype;
3643
begin
3644
if dFilePos(fp) > (filesz-8) then begin
3645
Read64 := 0;
3646
lReadOK := false;
3647
exit;
3648
end else
3649
lReadOK := true;
3650
//GetMem( buff, 8);
3651
dBlockRead(fp, @s, 8, n);
3652
inguy := @s; //assign address of s to inguy
3653
if lDICOMdata.little_endian <> 1 then begin
3654
outguy.Word1 := swap(inguy^.Word4);
3655
outguy.Word2 := swap(inguy^.Word3);
3656
outguy.Word3 := swap(inguy^.Word2);
3657
outguy.Word4 := swap(inguy^.Word1);
3658
end else
3659
outguy.float := inguy^.float; //1382
3660
read64:=outguy.float;
3661
end;
3662
3663
//magma
3664
function SafeStrToInt(var lInput: string): integer;
3665
var li,lLen: integer;
3666
begin
3667
result := 0;
3668
lLen := length(lInput);
3669
lStr := '';
3670
if lLen < 1 then exit;
3671
for li := 1 to lLen do
3672
if lInput[li] in ['+','-','0'..'9']
3673
then lStr := lStr +lInput[li];
3674
Val(lStr,li,lErr);
3675
if lErr = 0 then
3676
result := lI;//strtoint(lStr);
3677
end;
3678
3679
3680
procedure DICOMHeaderStringToInt (var lInput: integer);
3681
var li: integer;
3682
begin
3683
t := _string;
3684
lStr := '';
3685
if dFilePos(fp) > (filesz-e_len) then exit;//goto 666;
3686
GetMem( buff, e_len);
3687
dBlockRead(fp, buff{^}, e_len, n);
3688
for li := 0 to e_len-1 do
3689
if Char(buff[li]) in ['+','-','0'..'9']
3690
then lStr := lStr +(Char(buff[li]));
3691
FreeMem( buff);
3692
Val(lStr,li,lErr);
3693
if lErr = 0 then lInput := li;//strtoint(lStr);
3694
remaining := 0;
3695
tmp := lInput;
3696
end;
3697
3698
procedure DICOMHeaderString (var lInput: kDICOMStr);
3699
var li,lStartPos: integer;
3700
begin
3701
t := _string;
3702
lStartPos := dFilePos(fp);
3703
lInput := '';
3704
if e_len < 1 then exit; //DICOM: should always be even
3705
GetMem( buff, e_len);
3706
dBlockRead(fp, buff{^}, e_len, n);
3707
for li := 0 to e_len-1 do
3708
if Char(buff[li]) in ['+','-','/','\',' ','0'..'9','a'..'z','A'..'Z'] then
3709
lInput := lInput +(Char(buff[li]))
3710
else {if (buff[i] = 0) then}
3711
lInput := lInput +' ';
3712
3713
FreeMem( buff);
3714
dseek(fp, lStartPos);
3715
end;
3716
procedure DICOMHeaderStringTime (var lInput: kDICOMstr);
3717
var li,lStartPos: integer;
3718
begin
3719
t := _string;
3720
lStartPos := dFilePos(fp);
3721
lInput := '';
3722
if e_len < 1 then exit; //DICOM: should always be even
3723
GetMem( buff, e_len);
3724
dBlockRead(fp, buff{^}, e_len, n);
3725
for li := 0 to e_len-1 do
3726
if Char(buff[li]) in ['+','-','/','\',' ','0'..'9','a'..'z','A'..'Z','.'] then
3727
lInput := lInput +(Char(buff[li]))
3728
else if li <> (e_len-1) then
3729
lInput := lInput +':'
3730
else
3731
lInput := lInput +' ';
3732
3733
FreeMem( buff);
3734
dseek(fp, lStartPos);
3735
end;
3736
3737
begin
3738
//Init
3739
//for lnVol := 1 to kMaxOrderVal do
3740
// lDICOMdata.OrderSlope[lDICOMdata.nOrder] := 0; //show this was not set
3741
lGELX := false;
3742
lByteSwap := false;
3743
Clear_Dicom_Data(lDicomData);
3744
Clear_Dicom_Data(lDICOMdataBackUp);
3745
lDicomData.XYZdim[1] := 1;
3746
lImagePositionPatientRead := false;// for 4D files, we need first volume
3747
l4DDistanceBetweenSliceCenters := maxint;
3748
lEchoNum := 0;
3749
lThickness := 0;
3750
lTestError := false;
3751
lPhilipsScaleSlope := 0;
3752
lManufacturerIsPhilips := false;
3753
lManufacturerIsBruker := false;
3754
lnVol := 0;
3755
lnSlicePerVol := 0;
3756
lResearchMode := false;
3757
lMatrixSz := 0;
3758
lPhaseEncodingSteps := 0;
3759
lSiemensMosaic0008_0008 := false;
3760
lMediface0002_0013 := false;//false wblate
3761
lOldSiemens_IncorrectMosaicMM := false;
3762
lCacheStart := 0;
3763
lDiskCacheSz := 0;
3764
lDynStr:= '';
3765
lJPEGEntries := 0;
3766
first_one := true;
3767
info := '';
3768
lGrp:= false;
3769
lBigSet := false;
3770
lDICM_at_128 := false; //no DICOM signature
3771
lFirstFragment := true;
3772
lTextOverFlow := false;
3773
lImageFormatOK := true;
3774
lHdrOK := false;
3775
//if lverboseRead then msg('xxx'+lFileName);
3776
if not fileexists(lFileName) then begin
3777
lImageFormatOK := false;
3778
exit;
3779
end;
3780
//if lverboseRead then msg('zzzzz000000000');
3781
TmpStr := string(StrUpper(PChar(ExtractFileExt(lFileName))));
3782
lStr :='';
3783
if TmpStr = '.FDF' then begin
3784
if FDF( lFileName, lDicomData) then begin
3785
lHdrOK := true;
3786
lImageFormatOK := true;
3787
exit;
3788
end;
3789
end;
3790
if (TmpStr = '.REC') then begin //1417z: check in Unix: character upper/lower case may matter
3791
lStr := changefileext(lFilename,'.par');
3792
if fileexists(lStr) then
3793
lFilename := lStr
3794
else begin //Linux is case sensitive 1382...
3795
lStr := changefileext(lFilename,'.PAR');
3796
if fileexists(lStr) then
3797
lFilename := lStr
3798
end;
3799
end;
3800
if (TmpStr = '.BRIK') then begin //1417z: check in Unix: character upper/lower case may matter
3801
lStr := changefileext(lFilename,'.HEAD');
3802
if fileexists(lStr) then lFilename := lStr;
3803
end;
3804
FileMode := 0; //set to readonly
3805
AssignFile(fp, lFileName);
3806
Reset(fp, 1);
3807
FIleSz := FileSize(fp);
3808
if fileSz < 1 then begin
3809
lImageFormatOK := false;
3810
exit;
3811
end;
3812
lDICOMdata.Little_Endian := 1;
3813
if FileSz > 200 then begin
3814
dseek(fp, {0}128);
3815
dBlockRead(fp, tx, 4*SizeOf(Char), n);
3816
if (tx[0] = 'D') and (tx[1] = 'I') and (tx[2] = 'C') and (tx[3] = 'M') then
3817
lDICM_at_128 := true;
3818
end;//filesize > 200: check for 'DICM' at byte 128 - DICOM signature
3819
if (lAutoDetectGenesis) and (FileSz > (5820{114+35+4})) then begin
3820
dseek(fp, 0);
3821
if (ord(tx[0])=206) and (ord(tx[1])=250) then begin
3822
//Elscint format signature: check height and width to make sure
3823
3824
dseek(fp, 370);
3825
group := read16(fp,lrOK);//Width
3826
dseek(fp, 372);
3827
element := read16(fp,lrOK);//Ht
3828
if ((Group=160) or(Group =256) or (Group= 340) or (Group=512) or (group =640)) and
3829
((element=160) or (element =256) or (element= 340) or (element=512) ) then begin
3830
CloseFile(fp);
3831
if lDiskCacheSz > 0 then
3832
freemem(lDiskCacheRA);
3833
FileMode := 2; //set to read/write
3834
read_elscint_data(lDICOMdata, lHdrOK, lImageFormatOK,lDynStr,lFileName);
3835
exit;
3836
end; //confirmed: Elscint
3837
end;
3838
lGenesis := false;
3839
if ((tx[0] <> 'I') OR (tx[1] <> 'M') OR (tx[2] <> 'G') OR (tx[3] <> 'F')) then begin {DAT format}
3840
{if (FileSz > 114+305+4) then begin
3841
dseek(fp, 114+305);
3842
dBlockRead(fp, tx, 3*SizeOf(Char), n);
3843
if ((tx[0]='M') and (tx[1] = 'R')) or ((tx[0] = 'C') and(tx[1] = 'T')) then
3844
lGenesis := true;
3845
end;}
3846
end else
3847
lGenesis := true;
3848
if (not lGenesis) and (FileSz > 3252) then begin
3849
dseek(fp, 3240);
3850
dBlockRead(fp, tx, 4*SizeOf(Char), n);
3851
if ((tx[0] = 'I') AND (tx[1] = 'M')AND (tx[2] = 'G') AND (tx[3] = 'F')) then
3852
lGenesis := true;
3853
if (not lGenesis) then begin
3854
dseek(fp, 3178);
3855
dBlockRead(fp, tx, 4*SizeOf(Char), n);
3856
if ((tx[0] = 'I') AND (tx[1] = 'M')AND (tx[2] = 'G') AND (tx[3] = 'F')) then
3857
lGenesis := true;
3858
end;
3859
if (not lGenesis) then begin
3860
dseek(fp, 3180);
3861
dBlockRead(fp, tx, 4*SizeOf(Char), n);
3862
if ((tx[0] = 'I') AND (tx[1] = 'M')AND (tx[2] = 'G') AND (tx[3] = 'F')) then
3863
lGenesis := true;
3864
end;
3865
if (not lGenesis) then begin //1499K
3866
dseek(fp, 0);
3867
dBlockRead(fp, tx, 4*SizeOf(Char), n);
3868
if ((tx[0] = 'I') AND (tx[1] = 'M')AND (tx[2] = 'G') AND (tx[3] = 'F')) then
3869
lGenesis := true;
3870
end;
3871
3872
end;
3873
if (not lGenesis) and (FileSz > 3252) then begin
3874
dseek(fp, 3228);
3875
dBlockRead(fp, tx, 4*SizeOf(Char), n);
3876
if (tx[0] = 'I') AND (tx[1]= 'M') AND (tx[2] = 'G')AND (tx[3]= 'F') then
3877
lGenesis := true;
3878
end;
3879
if lGenesis then begin
3880
CloseFile(fp);
3881
if lDiskCacheSz > 0 then
3882
freemem(lDiskCacheRA);
3883
FileMode := 2; //set to read/write
3884
read_ge_data(lDICOMdata, lHdrOK, lImageFormatOK,lDynStr,lFileName);
3885
exit;
3886
end;
3887
end; //AutodetectGenesis xxDCIM
3888
3889
if (lAutoDetectInterfile) and (FileSz > 256) and (not lDICM_at_128) then begin
3890
if Copy(extractfilename(lFileName), 1, 4) = 'COR-' then begin
3891
lStr := extractfiledir(lFilename) + '\COR-.info';
3892
TmpStr := extractfiledir(lFilename) + '\COR-128';
3893
if fileexists(lStr) and fileexists(TmpStr) then begin
3894
lFilename := TmpStr;
3895
lDynStr := 'FreeSurfer COR format' + kCR+'Only displaying image 128'+kCR+'Use MRIcro''s Import menu to convert this image'+kCR;
3896
with lDicomData do begin
3897
little_endian := 0; // don't care
3898
ImageStart := 0;
3899
Allocbits_per_pixel := 8;
3900
XYZdim[1] := 256;
3901
XYZdim[2] := 256;
3902
XYZdim[3] := 1;
3903
XYZmm[1] := 1;
3904
XYZmm[2] := 1;
3905
XYZmm[3] := 1;
3906
//xStoredbits_per_pixel:= Allocbits_per_pixel;
3907
END; //WITH
3908
lHdrOK := True;
3909
lImageFormatOK := True;
3910
exit;
3911
end; //COR-.info file exists
3912
end; //if filename is COR-
3913
//start TIF
3914
//TIF IMAGES DO NOT ALWAYS HAVE EXTENSION if (TmpStr = '.TIF') or (TmpStr = '.TIFF') then begin
3915
dseek(fp, 0);
3916
lWord := read16(fp,lrOK);
3917
if lWord = $4d4d then
3918
lDICOMdata.little_endian := 0
3919
else if lWord = $4949 then lDICOMdata.little_endian := 1;
3920
//dseek(fp, 2);
3921
lWord2 := read16(fp,lrOK); //bits per pixel
3922
if ((lWord=$4d4d) or (lWord=$4949)) and (lWord2 = $002a) then begin
3923
CloseFile(fp);
3924
if lDiskCacheSz > 0 then
3925
freemem(lDiskCacheRA);
3926
FileMode := 2; //set to read/write
3927
read_tiff_data(lDICOMdata, lReadECAToffsetTables, lHdrOK, lImageFormatOK, lDynStr, lFileName);
3928
//if lHdrOk then exit;
3929
exit;
3930
end;//TIF signature
3931
//end; //.TIF extension
3932
//end TIF
3933
//start BMP 1667
3934
TmpStr := string(StrUpper(PChar(ExtractFileExt(lFileName))));
3935
if TmpStr = '.BMP' then begin
3936
dseek(fp, 0);
3937
lWord := read16(fp,lrOK);
3938
dseek(fp, 28);
3939
lWord2 := read16(fp,lrOK); //bits per pixel
3940
if (lWord=19778) and (lWord2 = 8) then begin //bitmap signature
3941
dseek(fp, 10);
3942
lDicomData.ImageStart := read32(fp,lrOK);//1078;
3943
dseek(fp, 18);
3944
lDicomData.XYZdim[1] := read32(fp,lrOK);
3945
//dseek(fp, 22);
3946
lDicomData.XYZdim[2] := read32(fp,lrOK);
3947
lDicomData.XYZdim[3] := 1;//read16(fp,lrOK);
3948
lDicomData.Allocbits_per_pixel := 8;//bits
3949
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
3950
lDynStr := 'BMP format';
3951
CloseFile(fp);
3952
if lDiskCacheSz > 0 then
3953
freemem(lDiskCacheRA);
3954
FileMode := 2; //set to read/write
3955
lHdrOK := true;
3956
lImageFormatOK:= true;
3957
exit;
3958
end;//bmp signature
3959
end; //.BMP extension
3960
//end BMP
3961
if TmpStr = '.VOL' then begin //start SPACE vol format 1382
3962
dseek(fp, 0);
3963
dBlockRead(fp, tx, 6*SizeOf(Char), n);
3964
if (tx[0] = 'm') and (tx[1] = 'd') and (tx[2] = 'v') and (tx[3] = 'o') and (tx[4] = 'l') and (tx[5] = '1') then begin
3965
lDicomData.ImageStart := read32(fp,lrOK);//1078;
3966
lDICOMdata.little_endian := 1;
3967
lDicomData.XYZdim[1] := read32(fp,lrOK);
3968
lDicomData.XYZdim[2] := read32(fp,lrOK);
3969
lDicomData.XYZdim[3] := read32(fp,lrOK);
3970
lDicomData.XYZmm[1] := read32r(fp,lrOK);
3971
lDicomData.XYZmm[2] := read32r(fp,lrOK);
3972
lDicomData.XYZmm[3] := read32r(fp,lrOK);
3973
lDicomData.Allocbits_per_pixel := 8;//bits
3974
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
3975
lDynStr := 'Space VOL format';
3976
CloseFile(fp);
3977
if lDiskCacheSz > 0 then
3978
freemem(lDiskCacheRA);
3979
FileMode := 2; //set to read/write
3980
lHdrOK := true;
3981
lImageFormatOK:= true;
3982
exit;
3983
end;//vol signature
3984
end; //.VOL extension
3985
//end space .VOL format
3986
//start DF3 PovRay DF3 density files
3987
if (TmpStr = '.DF3') then begin
3988
dseek(fp, 0);
3989
lWord := swap (read16(fp,lrOK));
3990
lWord2 := swap (read16(fp,lrOK));
3991
lWord3 := swap (read16(fp,lrOK));
3992
//note: I assume all df3 headers are little endian. is this always true? if not, unswapped values could be tested for filesize
3993
lMatrixSz := (lWord*lWord2*lWord3)+6;
3994
if (lMatrixSz=FileSz)then begin //df3 signature
3995
lDicomData.ImageStart := 6;//1078;
3996
lDicomData.XYZdim[1] := lWord;
3997
//dseek(fp, 22);
3998
lDicomData.XYZdim[2] := lWord2;
3999
lDicomData.XYZdim[3] := lWord3;
4000
lDicomData.Allocbits_per_pixel := 8;//bits
4001
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
4002
CloseFile(fp);
4003
if lDiskCacheSz > 0 then
4004
freemem(lDiskCacheRA);
4005
FileMode := 2; //set to read/write
4006
lDynStr := 'PovRay DF3 density format';
4007
lHdrOK := true;
4008
lImageFormatOK:= true;
4009
exit;
4010
end;//df3 signature
4011
end;
4012
//end df3
4013
4014
//start .PGM
4015
if (TmpStr = '.PGM') or (TmpStr = '.PPM') then begin
4016
dseek(fp, 0);
4017
lWord := read16(fp,lrOK);
4018
if (lWord=13648){'P5'=1x8BIT GRAYSCALE} or (lWord=13904) {'P6'=3x8bit RGB} then begin //bitmap signature
4019
{repeat
4020
PGMreadStr(lDicomData.XYZdim[1],lDicomData.XYZdim[2]);
4021
until (lDicomData.XYZdim[2] > 0) ;}
4022
lDicomData.XYZdim[1] := PGMreadInt;
4023
lDicomData.XYZdim[2] := PGMreadInt;
4024
PGMreadInt; //read maximum value
4025
4026
lDicomData.XYZdim[3] := 1;//read16(fp,lrOK);
4027
lDicomData.Allocbits_per_pixel := 8;//bits
4028
//xlDicomData.Storedbits_per_pixel:= lDicomData.Allocbits_per_pixel;
4029
lDicomData.ImageStart := dFilepos(fp);
4030
if lWord = 13904 then begin//RGB
4031
//xlDicomData.SamplesPerPixel := 3;
4032
//xlDicomData.PlanarConfig := 0;//RGBRGBRGB..., not RRR..RGGG..GBBB...B
4033
end;
4034
lDynStr:='PGM/PPM format 8-bit grayscale image [data saved in binary, not ASCII format]';
4035
CloseFile(fp);
4036
if lDiskCacheSz > 0 then
4037
freemem(lDiskCacheRA);
4038
FileMode := 2; //set to read/write
4039
lHdrOK := true;
4040
lImageFormatOK:= true;
4041
exit;
4042
end else if (lWord=12880){'P2'=1x8BIT ASCII} or (lWord=13136) {'P3'=3x8bit ASCI} then begin
4043
Msg('Warning: this image appears to be an ASCII ppm/pgm image. This software can only read binary ppm/pgm images');
4044
end;//pgm/ppm binary signature signature
4045
end; //.PPM/PGM extension
4046
4047
//end .pgm
4048
4049
//start BioRadPIC 1667
4050
if TmpStr = '.PIC' then begin
4051
dseek(fp, 54);
4052
lWord := read16(fp,lrOK);
4053
if (lWord=12345) then begin
4054
CloseFile(fp);
4055
if lDiskCacheSz > 0 then
4056
freemem(lDiskCacheRA);
4057
FileMode := 2; //set to read/write
4058
read_biorad_data(lDICOMdata, lHdrOK, lImageFormatOK,lDynStr,lFileName);
4059
exit;
4060
end;//biorad signature
4061
end; //.PIC extension biorad?
4062
//end BIORAD PIC
4063
if TmpStr = '.HEAD' then begin
4064
read_afni_data(lDICOMdata, lHdrOK, lImageFormatOK, lDynStr, lFileName,lRot1,lRot2,lRot3);
4065
if (lHdrOK) and (lImageFormatOK) then begin
4066
CloseFile(fp);
4067
if lDiskCacheSz > 0 then
4068
freemem(lDiskCacheRA);
4069
FileMode := 2; //set to read/write
4070
exit;
4071
end;
4072
end;
4073
dseek(fp, 0);
4074
dBlockRead(fp, tx, 20*SizeOf(Char), n);
4075
if (tx[0] = 'n') and (tx[1] = 'c') and (tx[2] = 'a') and (tx[3] = 'a') then begin
4076
//SUN Vision File Format = .vff
4077
CloseFile(fp);
4078
if lDiskCacheSz > 0 then
4079
freemem(lDiskCacheRA);
4080
FileMode := 2; //set to read/write
4081
read_vff_data(lDICOMdata, lHdrOK, lImageFormatOK, lDynStr, lFileName);
4082
exit;
4083
end;
4084
liPos := 1;
4085
lStr :='';
4086
{999 While (liPos <= 20) and (lStr <> 'INTERFILE') do begin
4087
if tx[liPos] in ['i','n','t','e','r', 'f','i','l','e','I','N','T','E','R', 'F','I','L','E'] then
4088
lStr := lStr+upcase(tx[liPos]);
4089
inc(liPos);
4090
end; }
4091
if lStr = 'INTERFILE' then begin
4092
CloseFile(fp);
4093
if lDiskCacheSz > 0 then
4094
freemem(lDiskCacheRA);
4095
FileMode := 2; //set to read/write
4096
read_interfile_data(lDICOMdata, lHdrOK, lImageFormatOK, lDynStr, lFileName);
4097
if lHdrOk then exit;
4098
exit;
4099
end; //'INTERFILE' in first 20 char
4100
end;//detectint
4101
// try DICOM part 10 i.e. a 128 byte file preamble followed by "DICM"
4102
if filesz <= 300 then goto 666;
4103
{begin siemens somatom: DO THIS BEFORE MAGNETOM: BOTH HAVE 'SIEMENS' SIGNATURE, SO CHECK FOR 'SOMATOM'}
4104
if filesz = 530432 then begin
4105
dseek(fp, 281);
4106
dBlockRead(fp, tx, 8*SizeOf(Char), n);
4107
if (tx[0] = 'S') and (tx[1] = 'O') and (tx[2] = 'M') and (tx[3] = 'A') and (tx[4] = 'T') and (tx[5] = 'O') and (tx[6] = 'M') then begin
4108
lDicomData.ImageStart := 6144;
4109
lDicomData.Allocbits_per_pixel := 16;
4110
//xlDicomData.Storedbits_per_pixel := 16;
4111
lDicomData.little_endian := 0;
4112
lDicomData.XYZdim[1] := 512;
4113
lDicomData.XYZdim[2] := 512;
4114
lDicomData.XYZdim[3] := 1;
4115
dSeek(fp,5999); //Study/Image from 5292 "STU/IMA 1070/16"
4116
lDicomData.AcquNum := trunc(SomaTomFloat);//Slice Thickness from 5790 "SL 3.0"
4117
lDicomData.ImageNum := trunc(SomaTomFloat);//Slice Thickness from 5790 "SL 3.0"
4118
dSeek(fp,5792); //Slice Thickness from 5790 "SL 3.0"
4119
lDicomData.XYZmm[3] := SomaTomFloat;//Slice Thickness from 5790 "SL 3.0"
4120
dSeek(fp,5841); //Field of View from 5838 "FoV 281"
4121
lDicomData.XYZmm[1] := SomaTomFloat; //Field of View from 5838 "FoV 281"
4122
lDicomData.XYZmm[2] := lDicomData.XYZmm[1]/lDicomData.XYZdim[2];//do mm[2] first before FOV is overwritten
4123
lDicomData.XYZmm[1] := lDicomData.XYZmm[1]/lDicomData.XYZdim[1];
4124
if lVerboseRead then
4125
lDynStr := 'Siemens Somatom Format'+kCR+
4126
'Image Series/Number: '+inttostr(lDicomData.AcquNum)+'/'+inttostr(lDicomData.ImageNum)+kCR+
4127
'XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'
4128
+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
4129
+kCR+'XYZ mm:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
4130
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2);
4131
CloseFile(fp);
4132
if lDiskCacheSz > 0 then
4133
freemem(lDiskCacheRA);
4134
FileMode := 2; //set to read/write
4135
lImageFormatOK := true;
4136
lHdrOK := true;
4137
exit;
4138
end; //signature found
4139
end; //correctsize for somatom
4140
{end siemens somatom}
4141
4142
{siemens magnetom}
4143
dseek(fp,96);
4144
dBlockRead(fp, tx, 7*SizeOf(Char), n);
4145
if (tx[0] = 'S') and (tx[1] = 'I') and (tx[2] = 'E') and (tx[3] = 'M') and (tx[4] = 'E') and (tx[5] = 'N') and (tx[6] = 'S') then begin
4146
CloseFile(fp);
4147
if lDiskCacheSz > 0 then
4148
freemem(lDiskCacheRA);
4149
FileMode := 2; //set to read/write
4150
read_siemens_data(lDICOMdata, lHdrOK, lImageFormatOK, lDynStr, lFileName);
4151
exit;
4152
end;
4153
{end siemens magnetom vision}
4154
{siemens somatom plus}
4155
dseek(fp, 0);
4156
dBlockRead(fp, tx, 8*SizeOf(Char), n);
4157
if (tx[0] = 'S') and (tx[1] = 'I') and (tx[2] = 'E') and (tx[3] = 'M') and (tx[4] = 'E') and (tx[5] = 'N') and (tx[6] = 'S') then begin
4158
lDicomData.ImageStart := 8192;
4159
lDicomData.Allocbits_per_pixel := 16;
4160
//xlDicomData.Storedbits_per_pixel := 16;
4161
lDicomData.little_endian := 0;
4162
dseek(fp, 1800); //slice thickness
4163
lDicomData.XYZmm[3] := read64(fp,lrOK);
4164
dseek(fp, 4100);
4165
lDicomData.AcquNum := read32(fp,lrOK);
4166
dseek(fp, 4108);
4167
lDicomData.ImageNum := read32(fp,lrOK);
4168
dseek(fp, 4992); //X FOV
4169
lDicomData.XYZmm[1] := read64(fp,lrOK);
4170
dseek(fp, 5000); //Y FOV
4171
lDicomData.XYZmm[2] := read64(fp,lrOK);
4172
dseek(fp, 5340);
4173
lDicomData.XYZdim[1] := read32(fp,lrOK);
4174
dseek(fp, 5344);
4175
lDicomData.XYZdim[2] := read32(fp,lrOK);
4176
lDicomData.XYZdim[3] := 1;
4177
if lDicomData.XYZdim[1] > 0 then
4178
lDicomData.XYZmm[1] := lDicomData.XYZmm[1]/lDicomData.XYZdim[1];
4179
if lDicomData.XYZdim[2] > 0 then
4180
lDicomData.XYZmm[2] := lDicomData.XYZmm[2]/lDicomData.XYZdim[2];
4181
if lVerboseRead then
4182
lDynStr := 'Siemens Somatom Plus Format'+kCR+
4183
'Image Series/Number: '+inttostr(lDicomData.AcquNum)+'/'+inttostr(lDicomData.ImageNum)+kCR+
4184
'XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'
4185
+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
4186
+kCR+'XYZ mm:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
4187
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2);
4188
4189
CloseFile(fp);
4190
if lDiskCacheSz > 0 then
4191
freemem(lDiskCacheRA);
4192
FileMode := 2; //set to read/write
4193
lImageFormatOK := true;
4194
lHdrOK := true;
4195
exit;
4196
end;
4197
{end siemens somatom plus }
4198
{picker}
4199
dseek(fp,0);
4200
dBlockRead(fp, tx, 8*SizeOf(Char), n);
4201
if (tx[0]='C') and (tx[1]='D') and (tx[2]='F') and (ord(tx[3]) = 1) then begin
4202
CloseFile(fp);
4203
if lDiskCacheSz > 0 then
4204
freemem(lDiskCacheRA);
4205
FileMode := 2; //set to read/write
4206
read_minc_data(lDICOMdata, lHdrOK, lImageFormatOK,lDynStr,lFileName);
4207
exit;
4208
end;
4209
if (lAutoDECAT7) and (tx[0]='M') and (tx[1]='A') and (tx[2]='T') and (tx[3]='R') and (tx[4]='I') and (tx[5]='X') then begin
4210
CloseFile(fp);
4211
if lDiskCacheSz > 0 then
4212
freemem(lDiskCacheRA);
4213
FileMode := 2; //set to read/write
4214
read_ecat_data(lDICOMdata, lVerboseRead,lReadECAToffsetTables,lHdrOK, lImageFormatOK, lDynStr, lFileName);
4215
exit;
4216
end;
4217
if (tx[0] = '*') AND (tx[1] = '*') AND (tx[2] = '*') AND (tx[3] = ' ') then begin {picker Standard}
4218
CloseFile(fp);
4219
if lDiskCacheSz > 0 then
4220
freemem(lDiskCacheRA);
4221
FileMode := 2; //set to read/write
4222
read_picker_data(lVerboseRead,lDICOMdata, lHdrOK, lImageFormatOK, lDynStr, lFileName);
4223
exit;
4224
end; {not picker standard}
4225
//Start Picker Prism
4226
ljunk := filesz-2048;
4227
lDICOMdata.little_endian := 0;
4228
//start: read x
4229
dseek(fp, 322);
4230
Width := read16(fp,lrOK);
4231
4232
//start: read y
4233
dseek(fp, 326);
4234
Ht := read16(fp,lrOK);
4235
lMatrixSz := Width * Ht;
4236
4237
//check if correct filesize for picker prism
4238
if (ord(tx[0]) = 1) and (ord(tx[1])=2) and ((ljunk mod lMatrixSz)=0){128*128*2bytes = 32768} then begin //Picker PRISM
4239
lDicomData.little_endian := 0;
4240
lDicomData.XYZdim[1] := Width;
4241
lDicomData.XYZdim[2] := Ht;
4242
lDicomData.XYZdim[3] := (ljunk div 32768); {128*128*2bytes = 32768}
4243
lDicomData.Allocbits_per_pixel := 16;
4244
//xlDicomData.Storedbits_per_pixel := 16;
4245
lDicomData.ImageStart := 2048;
4246
//start: read slice thicness
4247
dseek(fp,462);
4248
dBlockRead(fp, tx, 12*SizeOf(Char), n);
4249
lStr := '';
4250
for ljunk := 0 to 11 do
4251
if tx[ljunk] in ['0'..'9','.'] then
4252
lStr := lStr+ tx[ljunk];
4253
if lStr <> '' then
4254
lDicomData.XYZmm[3] := strtofloat(lStr);
4255
//start: voxel size
4256
dseek(fp,594);
4257
dBlockRead(fp, tx, 12*SizeOf(Char), n);
4258
lStr := '';
4259
for ljunk := 0 to 11 do
4260
if tx[ljunk] in ['0'..'9','.'] then
4261
lStr := lStr+ tx[ljunk];
4262
if lStr <> '' then
4263
lDicomData.XYZmm[1] := strtofloat(lStr);
4264
lDicomData.XYZmm[2] := lDicomData.XYZmm[1];
4265
//end: read voxel sizes
4266
//start: patient name
4267
dseek(fp,26);
4268
dBlockRead(fp, tx, 22*SizeOf(Char), n);
4269
lStr := '';
4270
ljunk := 0;
4271
while (ljunk < 22) and (ord(tx[ljunk]) <> 0) do begin
4272
lStr := lStr+ tx[ljunk];
4273
inc(ljunk);
4274
end;
4275
lDicomData.PatientName := lStr;
4276
//start: patient ID
4277
dseek(fp,48);
4278
dBlockRead(fp, tx, 15*SizeOf(Char), n);
4279
lstr := '';
4280
ljunk := 0;
4281
while (ljunk < 15) and (ord(tx[ljunk]) <> 0) do begin
4282
lstr := lstr+ tx[ljunk];
4283
inc(ljunk);
4284
end;
4285
//xlDicomData.PatientID := lStr;
4286
//start: scan time
4287
dseek(fp,186);
4288
dBlockRead(fp, tx, 25*SizeOf(Char), n);
4289
lstr := '';
4290
ljunk := 0;
4291
while (ljunk < 25) and (ord(tx[ljunk]) <> 0) do begin
4292
lstr := lstr+ tx[ljunk];
4293
inc(ljunk);
4294
end;
4295
//start: scanner type
4296
dseek(fp,2);
4297
dBlockRead(fp, tx, 25*SizeOf(Char), n);
4298
lgrpstr := '';
4299
ljunk := 0;
4300
while (ljunk < 25) and (ord(tx[ljunk]) <> 0) do begin
4301
lgrpstr := lgrpstr+ tx[ljunk];
4302
inc(ljunk);
4303
end;
4304
//report results
4305
if lVerboseRead then
4306
lDynStr := 'Picker Format '+lgrpstr+kCR+
4307
'Patient Name: '+lDicomData.PatientName+kCR+
4308
//x'Patient ID: '+lDicomData.PatientID+kCR+
4309
'Scan Time: '+lStr+kCR+
4310
'XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'
4311
+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3])
4312
+kCR+'XYZ mm:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'
4313
+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2);
4314
CloseFile(fp);
4315
if lDiskCacheSz > 0 then
4316
freemem(lDiskCacheRA);
4317
FileMode := 2; //set to read/write
4318
lImageFormatOK := true;
4319
lHdrOK := true;
4320
exit;
4321
4322
end; //end Picker PRISM
4323
lMatrixSz := 0;
4324
4325
lDICOMdata.little_endian := 1;
4326
lBig := false;
4327
dseek(fp, {0}128);
4328
//where := FilePos(fp);
4329
dBlockRead(fp, tx, 4*SizeOf(Char), n);
4330
if (tx[0] <> 'D') OR (tx[1] <> 'I') OR (tx[2] <> 'C') OR (tx[3] <> 'M') then begin
4331
4332
//if filesz > 132 then begin
4333
dseek(fp, 0{128}); //skip the preamble - next 4 bytes should be 'DICM'
4334
//where := FilePos(fp);
4335
dBlockRead(fp, tx, 4*SizeOf(Char), n);
4336
//end;
4337
if (tx[0] <> 'D') OR (tx[1] <> 'I') OR (tx[2] <> 'C') OR (tx[3] <> 'M') then begin
4338
dseek(fp, 0);
4339
group := read16(fp,lrOK);
4340
4341
if not lrOK then goto 666;
4342
4343
if group > $0008 then begin
4344
group := swap(group);
4345
lBig := true;
4346
end;
4347
if NOT (group in [$0000, $0001, $0002,$0003, $0004, $0008]) then // one more group added
4348
begin
4349
4350
goto 666;
4351
end;
4352
dseek(fp, 0);
4353
//Msg('DICM not at 0 or 128: ' +lFilename);
4354
end;
4355
end; //else Msg('DICM at 128{0}');;
4356
time_to_quit := FALSE;
4357
lProprietaryImageThumbnail := false;
4358
explicitVR := false;
4359
tmpstr := '';
4360
4361
tmp := 0;
4362
4363
while NOT time_to_quit do begin
4364
t := unknown;
4365
where := dFilePos(fp);
4366
lFirstPass := true;
4367
777:
4368
group := read16(fp,lrOK);
4369
4370
if not lrOK then goto 666;
4371
4372
if (lFirstPass) and (group = 2048) then begin
4373
if lDicomData.little_endian = 1 then lDicomData.Little_endian := 0
4374
else lDicomData.little_endian := 1;
4375
dseek(fp,where);
4376
lFirstPass := false;
4377
goto 777;
4378
end;
4379
element := read16(fp,lrOK);
4380
if not lrOK then goto 666;
4381
e_len:= read32(fp,lrOK);
4382
if not lrOK then goto 666;
4383
lGrpStr := '';
4384
lt0 := e_len and 255;
4385
lt1 := (e_len shr 8) and 255;
4386
lt2 := (e_len shr 16) and 255;
4387
lt3 := (e_len shr 24) and 255;
4388
if (explicitVR) and (lT0=13) and (lT1=0) and (lT2=0) and (lT3=0) then
4389
e_len := 10; //hack for some GE Dicom images
4390
4391
4392
if explicitVR or first_one then begin
4393
if group = $FFFE then else //1384 - ACUSON images switch off ExplicitVR for file image fragments
4394
if ((lT0=kO) and (lT1=kB)) or ((lT0=kU) and (lT1=kN)){<-UN added} or ((lT0=kO) and (lT1=kW)) or ((lT0=kS) and (lT1=kQ)) then begin
4395
lGrpStr := chr(lT0)+chr(lT1);
4396
e_len:= read32(fp,lrOK);
4397
if not lrOK then goto 666;
4398
if first_one then explicitVR := true;
4399
end else if ((lT3=kO) and (lT2=kB)) or ((lT3=kU) and (lT2=kN)){<-UN added} or((lT3=kO) and (lT2=kW)) or ((lT3=kS) and (lT2=kQ)) then begin
4400
e_len:= read32(fp,lrOK);
4401
if not lrOK then goto 666;
4402
if first_one then explicitVR := true;
4403
end else
4404
if ( ((lT0=kA) and (lT1=kE)) or ((lT0=kA) and (lT1=kS))
4405
or ((lT0=kA) and (lT1=kT)) or ((lT0=kC) and (lT1=kS)) or ((lT0=kD) and (lT1=kA))
4406
or ((lT0=kD) and (lT1=kS))
4407
or ((lT0=kD) and (lT1=kT)) or ((lT0=kF) and (lT1=kL)) or ((lT0=kF) and (lT1=kD))
4408
or ((lT0=kI) and (lT1=kS)) or ((lT0=kL) and (lT1=kO))or ((lT0=kL) and (lT1=kT))
4409
or ((lT0=kP) and (lT1=kN)) or ((lT0=kS) and (lT1=kH)) or ((lT0=kS) and (lT1=kL))
4410
or ((lT0=kS) and (lT1=kS)) or ((lT0=kS) and (lT1=kT)) or ((lT0=kT) and (lT1=kM))
4411
or ((lT0=kU) and (lT1=kI)) or ((lT0=kU) and (lT1=kL)) or ((lT0=kU) and (lT1=kS))
4412
or ((lT0=kA) and (lT1=kE)) or ((lT0=kA) and (lT1=kS)) )
4413
then begin
4414
lGrpStr := chr(lT0) + chr(lT1);
4415
if lDicomData.little_endian = 1 then
4416
e_len := (e_len and $ffff0000) shr 16
4417
else
4418
e_len := swap((e_len and $ffff0000) shr 16);
4419
if first_one then begin
4420
explicitVR := true;
4421
end;
4422
end else if (
4423
((lT3=kA) and (lT2=kT)) or ((lT3=kC) and (lT2=kS)) or ((lT3=kD) and (lT2=kA))
4424
or ((lT3=kD) and (lT2=kS))
4425
or ((lT3=kD) and (lT2=kT)) or ((lT3=kF) and (lT2=kL)) or ((lT3=kF) and (lT2=kD))
4426
or ((lT3=kI) and (lT2=kS)) or ((lT3=kL) and (lT2=kO))or ((lT3=kL) and (lT2=kT))
4427
or ((lT3=kP) and (lT2=kN)) or ((lT3=kS) and (lT2=kH)) or ((lT3=kS) and (lT2=kL))
4428
or ((lT3=kS) and (lT2=kS)) or ((lT3=kS) and (lT2=kT)) or ((lT3=kT) and (lT2=kM))
4429
or ((lT3=kU) and (lT2=kI)) or ((lT3=kU) and (lT2=kL)) or ((lT3=kU) and (lT2=kS)))
4430
then begin
4431
if lDicomData.little_endian = 1 then
4432
e_len := (256 * lT0) + lT1
4433
else
4434
e_len := (lT0) + (256*lT1);
4435
if first_one then begin
4436
explicitVR := true;
4437
end;
4438
end;
4439
end; //not first_one or explicit
4440
4441
if (first_one) and (lDicomdata.little_endian =0) and (e_len = $04000000) then begin
4442
Msg('Switching to little endian');
4443
lDicomData.little_endian := 1;
4444
dseek(fp, where);
4445
first_one := false;
4446
goto 777;
4447
end else if (first_one) and (lDicomData.little_endian =1) and (e_len = $04000000) then begin
4448
Msg('Switching to little endian');
4449
lDicomData.little_endian := 0;
4450
dseek(fp, where);
4451
first_one := false;
4452
goto 777;
4453
end;
4454
4455
if e_len = ($FFFFFFFF) then begin
4456
e_len := 0;
4457
end;
4458
if lGELX then begin
4459
e_len := e_len and $FFFF;
4460
end;
4461
first_one := false;
4462
remaining := e_len;
4463
info := '?';
4464
tmpstr := '';
4465
case group of
4466
$0001 : // group for normal reading elscint DICOM
4467
case element of
4468
$0010 : info := 'Name';
4469
$1001 : info := 'Elscint info';
4470
end;
4471
$0002 :
4472
case element of
4473
$00 : info := 'File Meta Elements Group Len';
4474
$01 : info := 'File Meta Info Version';
4475
$02 : info := 'Media Storage SOP Class UID';
4476
$03 : info := 'Media Storage SOP Inst UID';
4477
$10 : begin
4478
//lTransferSyntaxReported := true;
4479
info := 'Transfer Syntax UID';
4480
TmpStr := '';
4481
if dFilePos(fp) > (filesz-e_len) then goto 666;
4482
4483
GetMem( buff, e_len);
4484
dBlockRead(fp, buff{^}, e_len, n);
4485
for i := 0 to e_len-1 do
4486
if Char(buff[i]) in ['+','-',' ', '0'..'9','a'..'z','A'..'Z']
4487
then TmpStr := TmpStr +(Char(buff[i]))
4488
else TmpStr := TmpStr +('.');
4489
FreeMem( buff);
4490
lStr := '';
4491
if TmpStr = '1.2.840.113619.5.2' then begin
4492
lGELX := true;
4493
LBigSet := true;
4494
lBig := true;
4495
end;
4496
if length(TmpStr) >= 19 then begin
4497
4498
if TmpStr[19] = '1' then begin
4499
lBigSet:= true;
4500
explicitVR := true; //duran
4501
lBig := false;
4502
end else if TmpStr[19] = '2' then begin
4503
lBigSet:= true;
4504
explicitVR := true; //duran
4505
lBig := true;
4506
end else if TmpStr[19] = '4' then begin
4507
if length(TmpStr) >= 21 then begin
4508
//lDicomData.JPEGCpt := true;
4509
if not lReadJPEGtables then begin
4510
lImageFormatOK := false;
4511
end else begin
4512
4513
i := strtoint(TmpStr[21]+TmpStr[22]);
4514
//if (TmpStr[22] <> '0') or ((TmpStr[21] <> '7') or (TmpStr[21] <> '0'))
4515
4516
4517
if (i <> 57) and (i <> 70) then begin
4518
lImageFormatOK := false;
4519
//lDicomData.JPEGLossyCpt := true
4520
end else begin
4521
//lImageFormatOK := false;//x
4522
lDicomData.JPEGLosslessCpt := true;
4523
end;
4524
end;
4525
end else begin
4526
lImageFormatOK := false;
4527
end;
4528
end else if TmpStr[19] = '5' then begin
4529
lImageFormatOK := false;//xlDicomData.RunLengthEncoding := true;
4530
end else begin
4531
lImageFormatOK := false;
4532
end;
4533
if not lImageFormatOK then
4534
Msg('Unsupported Transfer Syntax '+(TmpStr)+' Solution: use MRIcro');
4535
4536
end; {length}
4537
remaining := 0;
4538
e_len := 0; {use tempstr}
4539
end;
4540
$12 : begin
4541
info := 'Implementation Class UID';
4542
end;
4543
$13 : begin
4544
info := 'Implementation Version Name';
4545
if e_len > 4 then begin
4546
TmpStr := '';
4547
DICOMHeaderString(TmpStr);
4548
lDicomData.ImplementationVersion := Str2Int(TmpStr);
4549
if TmpStr = 'MEDIFACE 1 5' then
4550
lMediface0002_0013 := true; //detect MEDIFACE 1.5 error: error in length of two elements 0008:1111 and 0008:1140
4551
end; //length > 4
4552
end; //element 13
4553
$16 : info := 'Source App Entity Title';
4554
$100: info := 'Private Info Creator UID';
4555
$102: info := 'Private Info';
4556
end;
4557
$0008 :
4558
case element of
4559
$00 : begin
4560
info := 'Identifying Group Length';
4561
end;
4562
$01 : info := 'Length to End';
4563
$05 : info := 'Specific Character Set';
4564
$08 : begin
4565
info := 'Image Type';
4566
//Only read last word, e.g. 'TYPE\MOSAIC' will be read as 'MOSAIC'
4567
TmpStr := '';
4568
if dFilePos(fp) > (filesz-e_len) then goto 666;
4569
GetMem( buff, e_len);
4570
dBlockRead(fp, buff{^}, e_len, n);
4571
i := e_len -1;
4572
while (i>-1) and (Char(buff[i]) in ['a'..'z','A'..'Z',' ']) do begin
4573
if (Char(buff[i])) <> ' ' then //strip filler characters: DICOM elements must be padded for even length
4574
TmpStr := upcase(Char(buff[i]))+TmpStr;
4575
dec(i);
4576
end;
4577
FreeMem( buff);
4578
remaining := 0;
4579
e_len := 0; {use tempstr}
4580
if TmpStr = 'MOSAIC' then begin
4581
lSiemensMosaic0008_0008:= true;
4582
//if lMatrixSz < 1 then lMatrixSz := 64;//B13
4583
end;
4584
end;
4585
$10 : info := 'Recognition Code';
4586
$12 : info := 'Instance Creation Date';
4587
$13 : info := 'Instance Creation Time';
4588
$14 : info := 'Instance Creator UID';
4589
$16 : info := 'SOP Class UID';
4590
$18 : info := 'SOP Instance UID';
4591
$20 : begin
4592
info := 'Study Date';
4593
//lDicomData.StudyDatePos := dFilePos(fp);
4594
DICOMHeaderString(lDicomData.StudyDate);
4595
end;
4596
$21 : info := 'Series Date';
4597
$22 : info := 'Acquisition Date';
4598
$23 : info := 'Image Date';
4599
$30 : begin info := 'Study Time';
4600
DICOMHeaderStringTime(lDicomData.StudyTime);
4601
end;
4602
$31 : info := 'Series Time';
4603
$32 : begin info := 'Acquisition Time';
4604
//xxDICOMHeaderStringTime(lDicomData.AcqTime);
4605
end;
4606
$33 : begin info := 'Image Time';
4607
//xxDICOMHeaderStringTime(lDicomData.ImgTime);
4608
end;
4609
$40 : info := 'Data Set Type';
4610
$41 : info := 'Data Set Subtype';
4611
$50 : begin
4612
//xDICOMHeaderStringtoInt(lDicomData.accession);
4613
info := 'Accession Number';
4614
end;
4615
4616
$60 : begin info := 'Modality'; t := _string; end;
4617
$64 : begin info := 'Conversion Type'; t := _string; end;
4618
$70 : begin
4619
info := 'Manufacturer';
4620
//Only read last word, e.g. 'TYPE\MOSAIC' will be read as 'MOSAIC'
4621
TmpStr := '';
4622
4623
if dFilePos(fp) > (filesz-e_len) then goto 666;
4624
GetMem( buff, e_len);
4625
dBlockRead(fp, buff{^}, e_len, n);
4626
i := e_len -1;
4627
while (i>-1) and (Char(buff[i]) in ['a'..'z','A'..'Z',' ']) do begin
4628
if (Char(buff[i])) <> ' ' then //strip filler characters: DICOM elements must be padded for even length
4629
TmpStr := upcase(Char(buff[i]))+TmpStr;
4630
dec(i);
4631
end;
4632
FreeMem( buff);
4633
remaining := 0;
4634
e_len := 0; {use tempstr}
4635
if (length(TmpStr) > 3) and (TmpStr[1]='P') and (TmpStr[2]='H') and (TmpStr[3]='I') then
4636
lManufacturerIsPhilips := true;
4637
if (length(TmpStr) > 3) and (TmpStr[1]='B') and (TmpStr[2]='R') and (TmpStr[3]='U') then
4638
lManufacturerIsBruker := true;
4639
4640
if lManufacturerIsPhilips then
4641
lDicomData.ManufacturerID := kPhilipsID;
4642
if (length(TmpStr) > 3) and (TmpStr[1]='G') and (TmpStr[2]='E') then
4643
lDicomData.ManufacturerID := kGEID;
4644
if (length(TmpStr) > 3) and (TmpStr[1]='S') and (TmpStr[2]='I') and (TmpStr[3]='E') then
4645
lDicomData.ManufacturerID := kSiemensID;
4646
4647
end;
4648
$80 : info := 'Institution Name';
4649
$81 : info := 'City Name';
4650
$90 : info := 'Referring Physician''s Name';
4651
$100: info := 'Code Value';
4652
$102 : begin
4653
info := 'Coding Schema Designator';
4654
t := _string;
4655
end;
4656
$104: info := 'Code Meaning';
4657
$1010: info := 'Station Name';
4658
$1030: begin info := 'Study Description'; t := _string; end;
4659
$103e: begin info := 'Series Description'; t := _string; end;
4660
$1040: info := 'Institutional Dept. Name';
4661
$1050: info := 'Performing Physician''s Name';
4662
$1060: info := 'Name Phys(s) Read Study';
4663
$1070: begin info := 'Operator''s Name'; t := _string; end;
4664
$1080: info := 'Admitting Diagnosis Description';
4665
$1090: begin info := 'Manufacturer''s Model Name';t := _string; end;
4666
$1111: begin
4667
if lMediface0002_0013 then E_LEN := 8;//+e_len;
4668
end; //ABBA: patches error in DICOM images seen from Sheffield 0002,0013=MEDIFACE.1.5; 0002,0016=PICKER.MR.SCU
4669
$1140: begin
4670
if (lMediface0002_0013) and (E_LEN > 255) then E_LEN := 8;
4671
end; //ABBA: patches error in DICOM images seen from Sheffield 0002,0013=MEDIFACE.1.5; 0002,0016=PICKER.MR.SCU
4672
$2111: info := 'Derivation Description';
4673
$2120: info := 'Stage Name';
4674
$2122: begin info := 'Stage Number';t := _string; end;
4675
$2124: begin info := 'Number of Stages';t := _string; end;
4676
$2128: begin info := 'View Number';t := _string; end;
4677
$212A: begin info := 'Number of Views in stage';t := _string; end;
4678
$2204: info := 'Transducer Orientation';
4679
$9208: begin
4680
info := 'ComplexImageComponent';
4681
TmpStr := '';
4682
DICOMHeaderString(TmpStr);
4683
i := 0;
4684
4685
if length(TmpStr) >= 2 then begin
4686
if (TmpStr[1] = 'M') and (TmpStr[2] = 'A') then
4687
i := 1; //magnitude
4688
if (TmpStr[1] = 'P') and (TmpStr[2] = 'H') then
4689
i := 2; //phase
4690
if (TmpStr[1] = 'R') and (TmpStr[2] = 'E') then
4691
i := 3; //real
4692
if (TmpStr[1] = 'I') and (TmpStr[2] = 'M') then
4693
i := 4; //imaginary
4694
end;
4695
//mixed will be followed by subsequent settings, so do not use it here....
4696
if (i > 0) and (lDICOMdata.nOrder < kMaxOrderVal) then begin
4697
inc(lDICOMdata.nOrder);
4698
//msg(TmpStr);
4699
lDICOMdata.order[lDICOMdata.nOrder] := i;
4700
end;
4701
(*[ magnitude * MAGNITUDE
4702
[ phase * PHASE
4703
[ real * REAL
4704
[ imaginary * IMAGINARY
4705
[ mixed * MIXED*)
4706
///xxx xxx
4707
end;
4708
4709
end;
4710
$0009: if element = $0010 then begin
4711
4712
if e_len > 4 then begin
4713
TmpStr := '';
4714
if dFilePos(fp) > (filesz-e_len) then goto 666;
4715
GetMem( buff, e_len);
4716
dBlockRead(fp, buff{^}, e_len, n);
4717
i := e_len -1;
4718
4719
while (i>-1) {and (Char(buff[i]) in ['a'..'z','A'..'Z',' '])} do begin
4720
if (Char(buff[i])) in ['a'..'z','A'..'Z'] then //strip filler characters: DICOM elements must be padded for even length
4721
TmpStr := upcase(Char(buff[i]))+TmpStr;
4722
dec(i);
4723
end;
4724
FreeMem( buff);
4725
remaining := 0;
4726
if (Length(TmpStr)>4) and (TmpStr[1]='M') and (TmpStr[2]='E') and (TmpStr[3]='R') and (TmpStr[4]='G') then
4727
lOldSiemens_IncorrectMosaicMM := true; //detect MERGE technologies mosaics
4728
e_len := 0; {use tempstr}
4729
end;
4730
4731
4732
end;
4733
$0010 :
4734
case element of
4735
$00 : info := 'Patient Group Length';
4736
$10 : begin info := 'Patient''s Name'; t := _string;
4737
//xlDicomData.NamePos := dFilePos(fp);
4738
DICOMHeaderString(lDicomData.PatientName);
4739
end;
4740
$20 : begin info := 'Patient ID';
4741
//xDICOMHeaderString(lDicomData.PatientID);
4742
//xlDicomData.PatientIDInt := safestrtoint(lDicomData.PatientID);
4743
end;
4744
30: info := 'Date of Birth'; //"Age String" type: e.g 067y for 67 years old, 067d for 67 days
4745
//$30 : info := 'Patient Date of Birth';
4746
$32 : info := 'Patient Birth Time';
4747
$40 : begin info := 'Patient Sex'; t := _string; end;
4748
$1000: info := 'Other Patient IDs';
4749
$1001: info := 'Other Patient Names';
4750
$1005: info := 'Patient''s Birth Name';
4751
$1010: begin info := 'Patient Age'; t := _string; end;
4752
$1030: info := 'Patient Weight';
4753
$21b0: info := 'Additional Patient History';
4754
$4000: info := 'Patient Comments';
4755
4756
end;
4757
$0018 :
4758
case element of
4759
$00 : info := 'Acquisition Group Length';
4760
$10 : begin info := 'Contrast/Bolus Agent'; t := _string; end;
4761
$15: info := 'Body Part Examined';
4762
$20 : begin
4763
info := 'Scanning Sequence';t := _string;
4764
TmpStr := '';
4765
DICOMHeaderString(TmpStr);
4766
if TmpStr = 'RM' then lResearchMode := true;
4767
end;
4768
$21 : begin info := 'Sequence Variant';t := _string; end;
4769
$22 : info := 'Scan Options';
4770
$23 : begin info := 'MR Acquisition Type'; t := _string; end;
4771
$24 : info := 'Sequence Name';
4772
$25 : begin info := 'Angio Flag';t := _string; end;
4773
$30 : info := 'Radionuclide';
4774
$50 : begin info := 'Slice Thickness';
4775
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
4776
if not lrOK then goto 666;
4777
e_len := 0; remaining := 0;
4778
lDICOMdata.XYZmm[3] := lfloat1;
4779
4780
lThickness := lfloat1;//lDICOMdata.Thickness := lfloat1; //1391b
4781
end;
4782
//$60: begin info := 'KVP [Peak Output, KV]'; t := _string; end; //aqw
4783
$60: begin
4784
info := 'KVP [Peak KV]';
4785
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
4786
if not lrOK then goto 666;
4787
e_len := 0; remaining := 0;
4788
//lDicomData.kV := lFloat1;
4789
end;
4790
4791
$70: begin t := _string; info := 'Counts Accumulated'; end;
4792
$71: begin t := _string; info := 'Acquisition Condition'; end;
4793
//$80 : begin info := 'Repetition Time'; t := _string; end; //aqw
4794
//$81 : begin info := 'Echo Time'; t := _string; end; //aqw
4795
$80 : begin info := 'Repetition Time [TR, ms]';
4796
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
4797
if not lrOK then goto 666;
4798
e_len := 0; remaining := 0;
4799
lDicomData.TR := lFloat1;
4800
end;
4801
4802
$81 : begin
4803
info := 'Echo Time [TE, ms]';
4804
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
4805
if not lrOK then goto 666;
4806
e_len := 0; remaining := 0;
4807
lDicomData.TE := lFloat1;
4808
end;
4809
$82 : begin t := _string; info := 'Inversion Time';end;
4810
$83 : begin t := _string; info := 'Number of Averages'; end;
4811
$84 : info := 'Imaging Frequency';
4812
$85 : begin info := 'Imaged Nucleus'; t := _string; end;
4813
$86 : begin info := 'Echo Number';t := _string;
4814
4815
DICOMHeaderStringToInt(lEchoNum);
4816
//lDICOMdata.Echo := lEchoNum;
4817
4818
end;
4819
//qq
4820
$87 : info := 'Magnetic Field Strength';
4821
$88 : begin
4822
info := 'Spacing Between Slices';
4823
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
4824
if not lrOK then goto 666;
4825
e_len := 0; remaining := 0; //1362 some use this for gap size, others for sum of gap and slicethickness!
4826
//3333 if (lfloat1 > lDICOMdata.XYZmm[3]) or (lDICOMdata.XYZmm[3]=1) then
4827
//lDICOMdata.XYZmm[3] := lfloat1;
4828
//fx(lDICOMdata.XYZmm[3],lThickness,lfloat1);
4829
if lfloat1 < 0 then
4830
lDICOMdata.XYZmm[3] := lFloat1//does not make sense - found in some eFilm images from Marconi P3000
4831
else if ( (lThickness/2) > lfloat1 ) then
4832
lDICOMdata.XYZmm[3] := lfloat1+lThickness
4833
else
4834
lDICOMdata.XYZmm[3] := lfloat1;//1392
4835
//xldicomdata.spacing:=lfloat1;
4836
end;
4837
$89 : begin
4838
// t := _string;
4839
info := 'Number of Phase Encoding Steps';
4840
//1499c This is a indirect method for detecting SIemens Mosaics: check if image height is evenly divisible by encoding steps
4841
// A real kludge due to Siemens not documenting mosaics explicitly: this workaround may incorrectly think rescaled images are mosaics!
4842
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
4843
lPhaseEncodingSteps := round(lfloat1);
4844
//xxxMsg(floattostr(lFloat1));
4845
if not lrOK then goto 666;
4846
e_len := 0; remaining := 0; //1362 some use this for gap size, others for sum of gap and slicethickness!
4847
//if (lfloat1 > lDICOMdata.XYZmm[3]) or (lDICOMdata.XYZmm[3]=1) then
4848
//lDICOMdata.XYZmm[3] := lfloat1;
4849
//ldicomdata.spacing:=lfloat1;
4850
4851
4852
end;
4853
$90 : info := 'Data collection diameter';
4854
$91 : begin info := 'Echo Train Length';t := _string; end;
4855
$93: begin info := 'Percent Sampling'; t := _string; end;
4856
$94: begin info := 'Percent Phase Field View'; t := _string; end;
4857
$95 : begin info := 'Pixel Bandwidth'; t := _string; end;
4858
$1000: begin t := _string; info := 'Device Serial Number'; end;
4859
$1004: info := 'Plate ID';
4860
$1020: begin info := 'Software Version';t := _string; end;
4861
$1030: begin
4862
info := 'Protocol Name';t := _string;
4863
TmpStr := '';
4864
DICOMHeaderString(TmpStr);
4865
lDicomData.ProtocolName := TmpStr;
4866
AplhaNumericStrDICOM (lDicomData.ProtocolName);
4867
end;
4868
$1040: info := 'Contrast/Bolus Route';
4869
$1050 : begin
4870
t := _string; info := 'Spatial Resolution'; end;
4871
$1060: info := 'Trigger Time';
4872
$1062: info := 'Nominal Interval';
4873
$1063: info := 'Frame Time';
4874
$1081: info := 'Low R-R Value';
4875
$1082: info := 'High R-R Value';
4876
$1083: info := 'Intervals Acquired';
4877
$1084: info := 'Intervals Rejected';
4878
$1088: begin info := 'Heart Rate'; t := _string; end;
4879
$1090: begin info := 'Cardiac Number of Images'; t := _string; end;
4880
$1094: begin info := 'Trigger Window';t := _string; end;
4881
$1100: info := 'Reconstruction Diameter';
4882
$1110: info := 'Distance Source to Detector [mm]';
4883
$1111: info := 'Distance Source to Patient [mm]';
4884
$1120: info := 'Gantry/Detector Tilt';
4885
$1130: info := 'Table Height';
4886
$1140: info := 'Rotation Direction';
4887
$1147: info := 'Field of View Shape';
4888
$1149: begin
4889
t := _string; info := 'Field of View Dimension[s]'; end;
4890
$1150: begin
4891
info := 'Exposure Time [ms]';
4892
t := _string;
4893
end;
4894
$1151: begin
4895
info := 'X-ray Tube Current [mA]';
4896
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
4897
if not lrOK then goto 666;
4898
e_len := 0; remaining := 0;
4899
//xlDicomData.mA := lFloat1;
4900
end;
4901
4902
$1152 : info := 'Acquisition Device Processing Description';
4903
$1155: info := 'Radiation Setting';
4904
$1160: info := 'Filter Type';
4905
$1164: info :='Imager Pixel Spacing';
4906
$1166: info := 'Grid';
4907
$1170 : info := 'Generator Power';
4908
$1180 : info := 'Collimator/grid Name';
4909
$1190 : begin
4910
info := 'Focal Spot[s]';
4911
t := _string;
4912
end;
4913
$11A0 : begin
4914
info := 'Body Part Thickness';
4915
t := _string;
4916
end;
4917
$11A2 : info := 'Compression Force';
4918
$1200 : info := 'Date of Last Calibration';
4919
$1201 : info := 'Time of Last Calibration';
4920
$1210: info := 'Convolution Kernel';
4921
$1250: begin t := _string; info := 'Receiving Coil'; end;
4922
$1251: begin t := _string; info := 'Transmitting Coil'; end;
4923
$1260 : begin
4924
t := _string; info := 'Plate Type'; end;
4925
$1261 : begin
4926
t := _string; info := 'Phosphor Type'; end;
4927
$1310: begin info := 'Acquisition Matrix'; //Siemens Mosaics converted by Merge can report the incorrect mm
4928
4929
//nji2
4930
//NOTE: Matrix Information for MERGE converted images. Used Innocently for other uses by Siemens
4931
4932
if (lOldSiemens_IncorrectMosaicMM) or ((lSiemensMosaic0008_0008) and (lMatrixSz < 1){B13}) then begin
4933
4934
//TmpStr := ReadStrABC(fp, remaining,lrOK,lA,lB,lC);
4935
4936
TmpStr := ReadStr(fp, remaining,lrOK,lMatrixSz);
4937
//ss//1362
4938
//fx(remaining);
4939
(*kEr := true;
4940
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
4941
if not lrOK then goto 666;
4942
e_len := 0; remaining := 0;
4943
kEr := false;
4944
4945
lMatrixSz := round(lFloat1);
4946
msg(TmpStr);
4947
fx(lMatrixSz,lFLoat1,lFloat2,4321);*)
4948
{fx(lA,lB,lC);
4949
lMatrixSz := lB;
4950
lMatrixSzY := lC; }
4951
end else
4952
TmpStr := ReadStr(fp, remaining,lrOK,lJunk);//1362
4953
4954
if not lrOK then goto 666;
4955
e_len := 0; remaining := 0;
4956
end;
4957
$1312: begin
4958
t := _string; info := 'Phase Encoding Direction';
4959
TmpStr := '';
4960
DICOMHeaderString(TmpStr);
4961
lDicomData.PhaseEncoding := TmpStr;
4962
AplhaNumericStrDICOM (lDicomData.PhaseEncoding);
4963
end;
4964
$1314: begin
4965
t := _string; info := 'Flip Angle'; end;
4966
$1315: begin
4967
t := _string;info := 'Variable Flip Angle Flag'; end;
4968
$1316: begin
4969
t := _string;info := 'SAR'; end;
4970
$1400: info := 'Acquisition Device Processing Description';
4971
$1401: begin info := 'Acquisition Device Processing Code';t := _string; end;
4972
$1402: info := 'Cassette Orientation';
4973
$1403: info := 'Cassette Size';
4974
$1404: info := 'Exposures on Plate';
4975
$1405: begin
4976
info := 'Relative X-Ray Exposure';
4977
t := _string;
4978
end;
4979
$1500: info := 'Positioner Motion';
4980
$1508: info := 'Positioner Type';
4981
$1510: begin
4982
info := 'Positioner Primary Angle';
4983
t := _string;
4984
end;
4985
$1511: info := 'Positioner Secondary Angle';
4986
$5020: info := 'Processing Function';
4987
$5100: begin
4988
t := _string; info := 'Patient Position';
4989
TmpStr := '';
4990
DICOMHeaderString(TmpStr);
4991
lDicomData.PatientPos := TmpStr;
4992
AplhaNumericStrDICOM (lDicomData.PatientPos);
4993
end;
4994
$5101: begin info := 'View Position';t := _string; end;
4995
$6000: begin info := 'Sensitivity'; t := _string; end;
4996
$7004: info := 'Detector Type';
4997
$7005: begin
4998
info := 'Detector Configuration';
4999
t := _string;
5000
end;
5001
$7006: info := 'Detector Description';
5002
$700A: info := 'Detector ID';
5003
$700C: info := 'Date of Last Detector Calibration';
5004
$700E: info := 'Date of Last Detector Calibration';
5005
$7048: info := 'Grid Period';
5006
$7050: info := 'Filter Material LT';
5007
$7060: info := 'Exposure Control Mode';
5008
end;
5009
$0019: begin
5010
(*case element of //1362
5011
//3/3/2008 this old method for detecting mosaics has a problem - if image is interpolated x2, you will assume a 2x2 mosaic
5012
$1220: begin
5013
info := 'Matrix';t := _string;
5014
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5015
if not lrOK then goto 666;
5016
e_len := 0;
5017
if lfloat2 > lfloat1 then lfloat1 := lfloat2;
5018
lMatrixSz := round(lfloat1);
5019
//if >32767 then there will be wrap around if read as signed value!
5020
remaining := 0;
5021
end;
5022
$14D4: begin
5023
info := 'Matrix';t := _string;
5024
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5025
if not lrOK then goto 666;
5026
e_len := 0;
5027
if lfloat2 > lfloat1 then lfloat1 := lfloat2;
5028
lMatrixSz := round(lfloat1);
5029
//if >32767 then there will be wrap around if read as signed value!
5030
remaining := 0;
5031
end;
5032
end; *) //case element
5033
5034
if lDicomData.ManufacturerID = kSiemensID then begin
5035
case element of //1362
5036
$000C,$100C: begin
5037
info := 'Siemens b-value';
5038
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5039
if not lrOK then goto 666;
5040
e_len := 0; remaining := 0;
5041
tmpstr := floattostr(lFloat1);
5042
lDICOMdata.DTI[1].bval := round(lFloat1);
5043
lDICOMdata.SiemensDICOMDTI := true ;
5044
//msgfx( 777,lDICOMdata.DTI[1].bval,lDICOMdata.DTI[1].bval,lDICOMdata.DTI[1].bval);
5045
end; // b-values
5046
$000E,$100E: begin
5047
info := 'Siemens Gradient vector [x,y,z]';
5048
//readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5049
lDICOMdata.DTI[1].v1 := read64 (fp,lrOK);
5050
if not lrOK then goto 666;
5051
lDICOMdata.DTI[1].v2 := read64 (fp,lrOK);
5052
if not lrOK then goto 666;
5053
lDICOMdata.DTI[1].v3 := read64 (fp,lrOK);
5054
if not lrOK then goto 666;
5055
//msgfx( 666,lDICOMdata.DTI[1].v1,lDICOMdata.DTI[1].v2,lDICOMdata.DTI[1].v3);
5056
//readfloats3 (fp, remaining, lDummyStr, lDICOMdata.DTI[1].v1,lDICOMdata.DTI[1].v2,lDICOMdata.DTI[1].v3, lROK);
5057
//ShowMsg(lDummyStr);
5058
//fx(e_len,lDICOMdata.DTI[1].v1,lDICOMdata.DTI[1].v2,lDICOMdata.DTI[1].v3);
5059
5060
e_len := 0; remaining := 0;
5061
//lDICOMdata.DTI[1].v1 := lFloat1;
5062
end; // X diffusion direction
5063
5064
5065
end;//Case element
5066
end;//if Siemens
5067
5068
if lDicomData.ManufacturerID = kGEID then begin
5069
case element of //1362
5070
$10BB,$a0bb: begin
5071
info := 'GE Gradient vector [x]';
5072
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5073
if not lrOK then goto 666;
5074
e_len := 0; remaining := 0;
5075
lDICOMdata.DTI[1].v1 := lFloat1;
5076
end; // X diffusion direction
5077
$10BC,$A0BC: begin
5078
info := 'GE Gradient vector [y]';
5079
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5080
if not lrOK then goto 666;
5081
e_len := 0; remaining := 0;
5082
lDICOMdata.DTI[1].v2 := lFloat1;
5083
end;//Y diffusion direction
5084
$10BD,$A0BD: begin
5085
info := 'GE Gradient vector [z]';
5086
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5087
if not lrOK then goto 666;
5088
e_len := 0; remaining := 0;
5089
lDICOMdata.DTI[1].v3 := lFloat1;
5090
end;// Z diffusion direction
5091
end;//Case element
5092
//
5093
5094
end;//if GE
5095
end;//$0019
5096
5097
5098
$0020 :
5099
case element of
5100
$00 : info := 'Relationship Group Length';
5101
$0d : info := 'Study Instance UID';
5102
$0e : info := 'Series Instance UID';
5103
$10 : begin
5104
info := 'Study ID';
5105
t := _string;
5106
end;
5107
$11 : begin info := 'Series Number';
5108
DICOMHeaderStringToInt(lDicomData.SeriesNum);
5109
end;
5110
$12 : // begin info := 'Acquisition Number'; t := _string; end;
5111
begin info := 'Acquisition Number';
5112
DICOMHeaderStringToInt(lDicomData.AcquNum);
5113
end;
5114
5115
$13 : begin info := 'Image Number';
5116
DICOMHeaderStringToInt(lTempInt);
5117
if (lDicomData.ImageNum < 2) and (lTempInt >= 0) then
5118
lDicomData.ImageNum := lTempInt;
5119
//March2008 - some Philips data has multiple image numbers...
5120
// 0018,1020,Software Version=1.5.4\1.5.4.3\Gyroscan PMS/DICOM 2.0 MR .Id. datadefs.v 5.27 2004/10/18 06.50
5121
//msg(inttostr(lDicomData.ImageNum)+lDicomData.Filename);
5122
end;
5123
$20 : begin info := 'Patient Orientation';
5124
t := _string;
5125
end;
5126
$30 : info := 'Image Position';
5127
$32 : begin
5128
info := 'Image Position Patient';
5129
//June 2009 - for Philips new 4D format we want value from the first slice...
5130
if not lImagePositionPatientRead then begin
5131
readfloats3 (fp, remaining, lDummyStr, lDicomData.PatientPosX, lDicomData.PatientPosY,lDicomData.PatientPosZ, lROK);
5132
if not lrOK then goto 666;
5133
e_len := 0;
5134
remaining := 0;
5135
lImagePositionPatientRead := true;
5136
//we assume Philips reports the slice thickness correctly....
5137
//an alternative would be to read both 1st and 2nd ImagePositionPatient and
5138
//compute the function DICOMinterslicedistance
5139
end else begin
5140
CheckIntersliceDistance(l4DDistanceBetweenSliceCenters);
5141
end;
5142
5143
end;
5144
$35 : info := 'Image Orientation';
5145
$37 : begin //nifti
5146
info := 'Image Orientation (Patient)';
5147
readfloats6 (fp, remaining, lDummyStr, lDicomData.Orient[1], lDicomData.Orient[2],lDicomData.Orient[3],lDicomData.Orient[4], lDicomData.Orient[5],lDicomData.Orient[6], lROK);
5148
if not lrOK then goto 666;
5149
e_len := 0;
5150
remaining := 0;
5151
5152
end;
5153
$50 : info := 'Location';
5154
$52 : info := 'Frame of Reference UID';
5155
$91 : info := 'Echo Train Length';
5156
$70 : info := 'Image Geometry Type';
5157
$60 : info := 'Laterality';
5158
$0105 : begin
5159
//Apr2007
5160
5161
DICOMHeaderStringToInt(lnVol);
5162
5163
//Number of temporal positions=105
5164
end;
5165
$1001: info := 'Acquisitions in Series';
5166
$1002: info := 'Images in Acquisition';
5167
$1020: info := 'Reference';
5168
$1040: begin info := 'Position Reference'; t := _string; end;
5169
$1041: begin info := 'Slice Location';
5170
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5171
if not lrOK then goto 666;
5172
e_len := 0; remaining := 0;
5173
ldicomdata.location:=lfloat1;
5174
end;
5175
$1070: begin
5176
info := 'Other Study Numbers';
5177
t := _string;
5178
end;
5179
$3401: info := 'Modifying Device ID';
5180
$3402: info := 'Modified Image ID';
5181
$3403: info := 'Modified Image Date';
5182
$3404: info := 'Modifying Device Mfg.';
5183
$3405: info := 'Modified Image Time';
5184
$3406: info := 'Modified Image Desc.';
5185
$4000: info := 'Image Comments';
5186
$5000: info := 'Original Image ID';
5187
$5002: info := 'Original Image... Nomenclature';
5188
end;
5189
$0021:case element of
5190
$104F: begin
5191
info :='GE Locations in acquisition';
5192
5193
if lPrefs.UseGE_0021_104F then begin
5194
//June 2009 - Thomas Stephan sent me a GE image where this was set to 2, but should have been 1
5195
//I hope removing this does not cause problems with other GE images...
5196
if e_len = 2 then begin
5197
lDicomData.SlicesPer3DVol := read16(fp,lrOK);
5198
e_len := 0; remaining := 0;
5199
/// fx(9999, lDicomData.SlicesPer3DVol);
5200
end;
5201
end; //use 0021_104F
5202
end;
5203
5204
$1341: begin
5205
info :='Siemens Mosaic Slice Count';
5206
DICOMHeaderStringToInt(lDicomData.SiemensSlices);
5207
5208
end;
5209
$134F: begin //1366
5210
info :='Siemens Order of Slices';
5211
t := _string;
5212
lDICOMdata.SiemensInterleaved := 0; //0=no,1=yes,2=undefined
5213
//look for "INTERLEAVED"
5214
lStr := '';
5215
if dFilePos(fp) > (filesz-e_len) then goto 666;
5216
GetMem( buff, e_len);
5217
dBlockRead(fp, buff{^}, e_len, n);
5218
for i := 0 to e_len-1 do
5219
if Char(buff[i]) in ['?','A'..'Z','a'..'z']
5220
then lStr := lStr +upcase(Char(buff[i]));
5221
FreeMem( buff);
5222
if(lStr[1]= 'I') then lDICOMdata.SiemensInterleaved := 1; //0=no,1=yes,2=undefined
5223
e_len := 0;
5224
end;
5225
end;
5226
$0028 : begin
5227
case element of
5228
$00 : info := 'Image Presentation Group Length';
5229
$02 : begin
5230
info := 'Samples Per Pixel';
5231
tmp := read16(fp,lrOK);
5232
if not lrOK then goto 666;
5233
lDicomData.SamplesPerPixel :=tmp;
5234
if e_len > 255 then begin
5235
explicitVR := true; //kludge: switch between implicit and explicitVR
5236
end;
5237
tmpstr := inttostr(tmp);
5238
e_len := 0;
5239
remaining := 0;
5240
end;
5241
$04 : begin
5242
info := 'Photometric Interpretation';
5243
TmpStr := '';
5244
if dFilePos(fp) > (filesz-e_len) then goto 666;
5245
GetMem( buff, e_len);
5246
dBlockRead(fp, buff{^}, e_len, n);
5247
for i := 0 to e_len-1 do
5248
if Char(buff[i]) in [{'+','-',' ', }'0'..'9','a'..'z','A'..'Z']
5249
then TmpStr := TmpStr +(Char(buff[i]));
5250
FreeMem( buff);
5251
(*xif TmpStr = 'MONOCHROME1' then lDicomdata.monochrome := 1
5252
else if TmpStr = 'MONOCHROME2' then lDicomdata.monochrome := 2
5253
else if (length(TMpStr)> 0) and (TmpStr[1] = 'Y') then lDICOMdata.monochrome := 4
5254
else lDICOMdata.monochrome := 3; *)
5255
remaining := 0;
5256
e_len := 0; {use tempstr}
5257
5258
end;
5259
$05 : info := 'Image Dimensions (ret)';
5260
$06 : begin
5261
info := 'Planar Configuration';
5262
tmp := read16(fp,lrOK);
5263
if not lrOK then goto 666;
5264
lDicomData.PlanarConfig :=tmp;
5265
remaining := 0;
5266
end;
5267
5268
$08 : begin
5269
//if lPapyrusnSlices < 1 then
5270
// if remaining = 2 then begin
5271
// tmp := read16(fp,lrOK);
5272
//
5273
// end else xx
5274
DICOMHeaderStringToInt(lDicomData.XYZdim[3]);
5275
if lDicomData.XYZdim[3] < 1 then lDicomData.XYZdim[3] := 1;
5276
info := 'Number of Frames';
5277
end;
5278
$09: begin info := 'Frame Increment Pointer'; TmpStr := ReadStrHex(fp, remaining,lrOK); if not lrOK then goto 666;
5279
e_len := 0; remaining := 0; end;
5280
$10 : begin info := 'Rows';
5281
lDicomData.XYZdim[2] := read16(fp,lrOK);
5282
if not lrOK then goto 666;
5283
tmp := lDicomData.XYZdim[2];
5284
remaining := 0;
5285
end;
5286
$11 : begin info := 'Columns';
5287
lDicomData.XYZdim[1] := read16(fp,lrOK);
5288
if not lrOK then goto 666;
5289
tmp := lDicomData.XYZdim[1];
5290
remaining := 0;
5291
end;
5292
$30 : begin info := 'Pixel Spacing';
5293
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5294
if not lrOK then goto 666;
5295
//qq
5296
//row spacing [y], then column spacing [x]: see part 3 of DICOM
5297
e_len := 0; remaining := 0;
5298
lDICOMdata.XYZmm[2] := lfloat1;
5299
lDICOMdata.XYZmm[1] := lfloat2;
5300
end;
5301
$31: info := 'Zoom Factor';
5302
$32: info := 'Zoom Center';
5303
$34: begin info :='Pixel Aspect Ratio';t := _string; end;
5304
$40: info := 'Image Format [ret]';
5305
$50 : info := 'Manipulated Image [ret]';
5306
$51: info := 'Corrected Image';
5307
$60: begin info := 'Compression Code [ret]';t := _string; end;
5308
$100: begin info := 'Bits Allocated';
5309
if remaining = 4 then
5310
tmp := read32(fp,lrOK)
5311
else
5312
tmp := read16(fp,lrOK);
5313
//lWord := read16(fp,lrOK);
5314
//lWord := read16(fp,lrOK);
5315
5316
if not lrOK then goto 666;
5317
if tmp = 8 then lDicomData.Allocbits_per_pixel := 8
5318
else if tmp = 12 then lDicomData.Allocbits_per_pixel := 12
5319
else if tmp = 16 then lDicomData.Allocbits_per_pixel := 16
5320
else if tmp = 24 then begin
5321
//xlDicomData.SamplesPerPixel := 3;
5322
lDicomData.Allocbits_per_pixel := 8
5323
end else begin
5324
lWord := tmp;
5325
lWord := swap(lWord);
5326
if lWord in [8,12,16,24] then begin
5327
lDicomData.Allocbits_per_pixel := tmp;
5328
lByteSwap := true;
5329
end else begin
5330
if lImageFormatOK then
5331
Msg('This software only reads 8, 12 and 16 bit DICOM files. This file allocates '+inttostr(tmp)+' bits per voxel.');
5332
lImageFormatOK := false;
5333
end;
5334
end;
5335
//remaining := 2;//remaining; //1371->
5336
remaining := 0
5337
end;
5338
$0101: begin info := 'Bits Stored';
5339
if remaining = 4 then
5340
tmp := read32(fp,lrOK)
5341
else
5342
tmp := read16(fp,lrOK);
5343
5344
if not lrOK then goto 666;
5345
5346
(*if tmp <= 8 then lDicomData.Storedbits_per_pixel := 8
5347
else if tmp <= 16 then lDicomData.Storedbits_per_pixel := 16
5348
else if tmp <= 24 then begin
5349
lDicomData.Storedbits_per_pixel := 24;
5350
lDicomData.SamplesPerPixel := 3;
5351
end else begin
5352
lWord := tmp;
5353
lWord := swap(lWord);
5354
if lWord in [8,12,16] then begin
5355
lDicomData.Storedbits_per_pixel := tmp;
5356
lByteSwap := true;
5357
end else begin
5358
if lImageFormatOK then
5359
Msg('This software can only read 8, 12 and 16 bit DICOM files. This file stores '+inttostr(tmp)+' bits per voxel.');
5360
lDicomData.Storedbits_per_pixel := tmp;
5361
lImageFormatOK := false;{ }
5362
end;
5363
end;*)
5364
remaining := 0;
5365
end;
5366
$0102: begin info := 'High Bit';
5367
if remaining = 4 then
5368
tmp := read32(fp,lrOK)
5369
else
5370
tmp := read16(fp,lrOK);
5371
if not lrOK then
5372
goto 666;
5373
remaining := 0;
5374
end;
5375
$0103: begin
5376
info := 'Pixel Representation';
5377
end;
5378
$0104: info := 'Smallest Valid Pixel Value';
5379
$0105: info := 'Largest Valid Pixel Value';
5380
$0106: begin
5381
//xlDicomData.MinIntensitySet:= true;
5382
info := 'Smallest Image Pixel Value';
5383
tmp := read16(fp,lrOK);
5384
if not lrOK then goto 666;
5385
//xlDicomData.Minintensity := tmp;
5386
//if >32767 then there will be wrap around if read as signed value!
5387
remaining := 0;
5388
end;
5389
$0107: begin
5390
info := 'Largest Image Pixel Value';
5391
if remaining = 4 then
5392
tmp := read32(fp,lrOK)
5393
else
5394
tmp := read16(fp,lrOK);
5395
if not lrOK then goto 666;
5396
//xlDicomData.Maxintensity := tmp;
5397
//if >32767 then there will be wrap around if read as signed value!
5398
remaining := 0;
5399
end;
5400
$120: info := 'Pixel Padding Value';
5401
$200: info := 'Image Location [ret]';
5402
$1040: begin t := _string; info := 'Pixel Intensity Relationship'; end;
5403
$1050: begin
5404
info := 'Window Center';
5405
if e_len > 0 then begin
5406
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5407
if not lrOK then goto 666;
5408
e_len := 0; remaining := 0;
5409
//xlDICOMdata.WindowCenter := round(lfloat1);
5410
end;
5411
end;{float}
5412
$1051: begin info := 'Window Width';
5413
if e_len > 0 then begin
5414
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5415
if not lrOK then goto 666;
5416
e_len := 0;
5417
remaining := 0;
5418
//xlDICOMdata.WindowWidth := round(lfloat1);
5419
end; //ignore empty elements, e.g. LeadTech's image6.dic
5420
end;
5421
$1052: begin t := _string;info :='Rescale Intercept';
5422
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5423
if not lrOK then goto 666;
5424
e_len := 0; remaining := 0;
5425
lDICOMdata.intenIntercept := lfloat1;
5426
//if (lDICOMdata.nOrder > 0) and (lDICOMdata.nOrder < kMaxOrderVal) then
5427
// lDICOMdata.OrderIntercept[lDICOMdata.nOrder] := lfloat1;
5428
end; {float}
5429
5430
$1053:begin
5431
t := _string; info := 'Rescale Slope';
5432
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5433
if not lrOK then goto 666;
5434
e_len := 0; remaining := 0;
5435
if lFloat1 < 0.000000001 then begin
5436
lFLoat1 := 1; //misused in some images, see IMG000025
5437
end;
5438
lDICOMdata.intenScale := lfloat1;
5439
//if (lDICOMdata.nOrder > 0) and (lDICOMdata.nOrder < kMaxOrderVal) then
5440
// lDICOMdata.OrderSlope[lDICOMdata.nOrder] := lfloat1;
5441
end; {float}
5442
$1054:begin t := _string; info := 'Rescale Type';end;
5443
$1100: info := 'Gray Lookup Table [ret]';
5444
$1101: begin info := 'Red Palette Descriptor'; TmpStr := ReadStr(fp, remaining,lrOK,lJunk);
5445
if not lrOK then goto 666;
5446
e_len := 0; remaining := 0; end;
5447
$1102: begin info := 'Green Palette Descriptor'; TmpStr := ReadStr(fp, remaining,lrOK,lJunk);
5448
if not lrOK then goto 666;
5449
e_len := 0; remaining := 0; end;
5450
$1103: begin info := 'Blue Palette Descriptor'; TmpStr := ReadStr(fp, remaining,lrOK,lJunk);
5451
if not lrOK then goto 666;
5452
e_len := 0; remaining := 0; end;
5453
$1199: begin
5454
info := 'Palette Color Lookup Table UID';
5455
end;
5456
$1200: info := 'Gray Lookup Data [ret]';
5457
$1201, $1202,$1203: begin
5458
case element of
5459
$1201: info := 'Red Table'; {future}
5460
$1202: info := 'Green Table'; {future}
5461
$1203: info := 'Blue Table'; {future}
5462
end;
5463
5464
if dFilePos(fp) > (filesz-remaining) then
5465
goto 666;
5466
if not lReadColorTables then begin
5467
dSeek(fp, dFilePos(fp) + remaining);
5468
end else begin {load color}
5469
width := remaining div 2;
5470
5471
if width > 0 then begin
5472
getmem(lWordRA,width*2);
5473
for i := (width) downto 1 do
5474
lWordRA^[i] := read16(fp,lrOK);
5475
//value := 159;
5476
value := lWordRA^[1];
5477
max16 := value;
5478
min16 := value;
5479
for i := (width) downto 1 do begin
5480
value := lWordRA^[i];
5481
if value < min16 then min16 := value;
5482
if value > max16 then max16 := value;
5483
end; //width..1
5484
if max16 - min16 = 0 then
5485
max16 := min16+1; {avoid divide by 0}
5486
if (lDicomData.Allocbits_per_pixel <= 8) and (width > 256) then width := 256; //currently only accepts palettes up to 8-bits
5487
GetMem( lColorRA, width );(**)
5488
for i := width downto 1 do
5489
lColorRA^[i] := (lWordRA^[i] shr 8) {and 255};
5490
FreeMem( lWordRA );
5491
case element of
5492
$1201: begin
5493
red_table_size := width;
5494
red_table :=lColorRA;;
5495
end;
5496
$1202: begin
5497
green_table_size := width;
5498
green_table :=lColorRA;;
5499
end;
5500
else {x$1203:} begin
5501
blue_table_size := width;
5502
blue_table :=lColorRA;;
5503
end; {else}
5504
end; {case}
5505
end; //width > 0;
5506
if odd(remaining) then
5507
dSeek(fp, dFilePos(fp) + 1{remaining});
5508
end; {load color}
5509
tmpstr := 'Custom';
5510
remaining := 0;
5511
e_len := 0; {show tempstr}
5512
end;
5513
$1221, $1222,$1223: begin
5514
info := 'Color Palette ['+inttostr(dFilePos(fp))+']';
5515
(*xcase element of
5516
$1221: begin
5517
lDicomData.RLEredOffset:= dFilePos(fp);
5518
lDicomData.RLEredSz:= e_len;
5519
end;
5520
$1222: begin
5521
lDicomData.RLEgreenOffset:= dFilePos(fp);
5522
lDicomData.RLEgreenSz:= e_len;
5523
end;
5524
$1223: begin
5525
lDicomData.RLEblueOffset:= dFilePos(fp);
5526
lDicomData.RLEblueSz:= e_len;
5527
end;
5528
end;*)//Case set offset and length
5529
5530
tmpstr := inttostr(e_len);
5531
dSeek(fp, dFilePos(fp)+ e_LEN);
5532
e_len := 0;
5533
end;
5534
5535
$3002: info := 'LUT Descriptor';
5536
$3003: info := 'LUT Explanation';
5537
$3006: info := 'LUT Data';
5538
$3010: begin
5539
info := 'VOI LUT Sequence';
5540
if (explicitVR) and (lT0=kS) and (lT1=kQ) then
5541
e_len := 8;
5542
end;
5543
end; //case
5544
end; //$0028
5545
$41: case element of //Papyrus Private Group
5546
$1010: begin
5547
info := 'Papyrus Icon [bytes skipped]';
5548
dSeek(fp, dFilePos(fp) + e_len);
5549
tmpstr := inttostr(e_len);
5550
remaining := 0;
5551
e_len := 0;
5552
end; //element $0041:$1010
5553
$1015: begin
5554
5555
info := 'Papyrus Slices';
5556
(*Papyrus format is buggy - see lsjpeg.pas for details, therefore, I have removed extensive support
5557
if e_len = 2 then begin
5558
lDicomData.XYZdim[3] := read16(fp,lrOK);
5559
if not lrOK then goto 666;
5560
end;
5561
if lDicomData.XYZdim[3] < 1 then lDicomData.XYZdim[3] := 1;
5562
if {(false) and }(lDicomData.XYZdim[3] > 1) and (lReadJPEGtables) and (gECATJPEG_table_entries = 0) then begin
5563
//Papyrus multislice files keep separate DICOM headers for each slice within a DICOM file
5564
lPapyrusnSlices := lDicomData.XYZdim[3];
5565
lPapyrusSlice := 0;
5566
//lPapyrusData := lDicomData;
5567
gECATJPEG_table_entries := lDICOMdata.XYZDim[3];
5568
getmem (gECATJPEG_pos_table, gECATJPEG_table_entries*sizeof(longint));
5569
getmem (gECATJPEG_size_table, gECATJPEG_table_entries*sizeof(longint));
5570
end else
5571
lDicomData.XYZdim[3] := 1;
5572
tmpstr := inttostr(lDicomData.XYZdim[3]);
5573
remaining := 0;
5574
e_len := 0;*)
5575
end; //element $0041:$1015
5576
$1050: begin
5577
info := 'Papyrus Bizarre Element'; //bizarre osiris problem
5578
if (dfilepos(fp)+e_len)= (filesz) then
5579
e_len := 8;
5580
end; //element $0041:$1050
5581
end; //group $0041: Papyrus
5582
5583
$43: begin
5584
5585
if lDicomData.ManufacturerID = kGEID then begin
5586
case element of
5587
$1039,$A039: begin
5588
// 0043,1039 (or 0043,a039). b value (as the first number in the string).
5589
5590
info := 'GE Bvalue';
5591
if e_len > 0 then begin
5592
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5593
if not lrOK then goto 666;
5594
e_len := 0; remaining := 0;
5595
lDICOMdata.DTI[1].bval := round(lfloat1);
5596
lDICOMdata.nDTIdir := 1;
5597
end; //e_len>0
5598
end;//1039 or Ao39
5599
end;//Case
5600
end; //Manufacturer = GE
5601
end;//$0043 - GE bvalues
5602
5603
$54: case element of
5604
$0: info := 'Nuclear Acquisition Group Length';
5605
$11: info := 'Number of Energy Windows';
5606
$21: info := 'Number of Detectors';
5607
$51: info := 'Number of Rotations';
5608
$80: begin info := 'Slice Vector'; TmpStr := ReadStr(fp, remaining,lrOK,lJunk); if not lrOK then goto 666;
5609
e_len := 0; remaining := 0; end;
5610
$81: info := 'Number of Slices';
5611
$202: info := 'Type of Detector Motion';
5612
$400: info := 'Image ID';
5613
5614
end;
5615
$2010 :
5616
case element of
5617
$0: info := 'Film Box Group Length';
5618
$100: info := 'Border Density';
5619
end;
5620
$4000 : info := 'Text';
5621
$0029 : begin
5622
case element of
5623
$1010: begin
5624
//lSiemensMosaic0029_1010:= true;
5625
lDicomData.CSAImageHeaderInfoPos := (dFilePos(fp));
5626
lDicomData.CSAImageHeaderInfoSz := e_len;
5627
info := 'Private Sequence Delimiter ['+inttostr(dFilePos(fp))+']';
5628
if not lImageFormatOK
5629
//x(lDicomData.RunLengthEncoding) or ( ((lDicomData.JPEGLossycpt) or (lDicomData.JPEGLosslesscpt)) and (gECATJPEG_table_entries >= lDICOMdata.XYZdim[3]))}
5630
then time_to_quit := TRUE;
5631
dSeek(fp, dFilePos(fp) + e_len);
5632
tmpstr := inttostr(e_len);
5633
remaining := 0;
5634
e_len := 0; {show tempstr}
5635
end;
5636
$1053: begin
5637
info :='Philips Scale Slope';
5638
readfloats (fp, remaining, lDummyStr, lfloat1, lfloat2, lROK);
5639
if not lrOK then goto 666;
5640
e_len := 0; remaining := 0;
5641
lPhilipsScaleSlope := lfloat1;
5642
{if e_len = 4 then begin
5643
lPhilipsScaleSlope := read32r(fp,lrOK);
5644
TmpStr := floattostr(lPhilipsScaleSlope);
5645
t := _string;
5646
5647
if not lrOK then goto 666;
5648
e_len := 0;
5649
remaining := 0;
5650
end; }
5651
end;
5652
5653
5654
else begin
5655
end;
5656
END;
5657
END; //gROUP 0029
5658
5659
(* $0045 : begin
5660
case element of
5661
$103B: begin
5662
msg('0045:103B');
5663
end; //element $1010
5664
5665
end; //CASE...element
5666
end; //group 0045
5667
*)
5668
$0089 : begin
5669
case element of
5670
$1010: begin
5671
e_len := 0;
5672
lProprietaryImageThumbnail := true;
5673
//lImageFormatOK := false;
5674
end; //element $1010
5675
$1020: begin
5676
//thoravision files
5677
5678
if e_len > 12 then
5679
e_len := 0;
5680
//lProprietaryImageThumbnail := true;
5681
//lImageFormatOK := false;
5682
end; //element $1010
5683
5684
end; //CASE...element
5685
end; //group 0089
5686
5687
$2001 : begin
5688
if lDicomData.ManufacturerID = kPhilipsID then begin
5689
case element of
5690
5691
$1003: begin //bvalue
5692
if e_len = 4 then begin
5693
if lDICOMdata.nDTIdir < kMaxDTIdir then
5694
inc(lDICOMdata.nDTIdir);
5695
lDICOMdata.DTI[lDICOMdata.nDTIdir].bval := round(read32r(fp,lrOK));
5696
TmpStr := inttostr(lDICOMdata.DTI[lDICOMdata.nDTIdir].bval);
5697
t := _string;
5698
info :='DTI b-val';
5699
if not lrOK then goto 666;
5700
e_len := 0; remaining := 0;
5701
end; //e_len = 4
5702
end; //element 1003
5703
$100B: begin
5704
info := 'philips: slice orientation';t := _string;
5705
TmpStr := '';
5706
DICOMHeaderString(TmpStr);
5707
lDicomData.PhilipsSliceOrient := TmpStr;
5708
AplhaNumericStrDICOM (lDicomData.PhilipsSliceOrient);
5709
end;//PhilipsSliceOrient
5710
$1018: begin
5711
if e_len = 4 then begin
5712
info :='number of slices';
5713
lDicomData.SlicesPer3DVol := read32(fp,lrOK);
5714
//uninterleave data
5715
e_len := 0; remaining := 0;
5716
if lResearchMode then
5717
lDicomData.SeriesNum := lDicomData.SeriesNum + 50; //do not jumble research recons and normal images
5718
end; //e_len = 4
5719
TmpStr := floattostr(lDicomData.SlicesPer3DVol);
5720
end; //1018
5721
5722
$102D: begin
5723
///Apr2007
5724
5725
if e_len = 2 then begin
5726
lnSlicePerVol := read16(fp,lrOK);
5727
e_len := 0; remaining := 0;
5728
end;
5729
//fx(213,lnSlicePerVol);
5730
end; //102D
5731
5732
$105F: begin //Philips Stack Sequence
5733
5734
if e_len > 8 then e_len := 8;
5735
end; //105F
5736
end;
5737
end; //if manufacturer = Philips
5738
end;
5739
5740
//2001,1004)
5741
5742
$2005 : begin
5743
//if lDicomData.ManufacturerID = kPhilipsID then Msg(inttohex(element,4));
5744
if lDicomData.ManufacturerID = kPhilipsID then begin
5745
case element of
5746
$100E: begin
5747
if e_len = 4 then begin
5748
lPhilipsScaleSlope := read32r(fp,lrOK);
5749
TmpStr := floattostr(lPhilipsScaleSlope);
5750
t := _string;
5751
info :='Philips Scale Slope';
5752
if not lrOK then goto 666;
5753
e_len := 0; remaining := 0;
5754
end;
5755
end; //element $1010
5756
5757
$1071: begin
5758
5759
if e_len = 4 then begin
5760
lDicomData.AngulationAP := read32r(fp,lrOK);
5761
TmpStr := floattostr(lDicomData.AngulationAP);
5762
t := _string;
5763
info :='angulation midslice, AP (degrees)';
5764
if not lrOK then goto 666;
5765
e_len := 0; remaining := 0;
5766
end;
5767
end; // Philips AP angulation : -8.74086
5768
$1072: begin
5769
if e_len = 4 then begin
5770
lDicomData.AngulationFH := read32r(fp,lrOK);
5771
TmpStr := floattostr(lDicomData.AngulationFH);
5772
t := _string;
5773
info :='angulation midslice, FH (degrees)';
5774
if not lrOK then goto 666;
5775
e_len := 0; remaining := 0;
5776
end;
5777
end; // Philips Philips FH angulation : -3.53147
5778
$1073: begin
5779
if e_len = 4 then begin
5780
lDicomData.AngulationRL := read32r(fp,lrOK);
5781
TmpStr := floattostr(lDicomData.AngulationRL);
5782
t := _string;
5783
info :='angulation midslice, RL (degrees)';
5784
if not lrOK then goto 666;
5785
e_len := 0; remaining := 0;
5786
end;
5787
end; // Philips RL angulation
5788
$10b0: begin
5789
if e_len = 4 then begin
5790
lDICOMdata.DTI[lDICOMdata.nDTIdir].v1 := read32r(fp,lrOK);
5791
TmpStr := floattostr(lDICOMdata.DTI[lDICOMdata.nDTIdir].v1);
5792
t := _string;
5793
info :='Gradient vector [x]';
5794
if not lrOK then goto 666;
5795
e_len := 0; remaining := 0;
5796
end; //e_len = 4
5797
end; //element 10b0
5798
$10b1: begin
5799
if e_len = 4 then begin
5800
lDICOMdata.DTI[lDICOMdata.nDTIdir].v2 := read32r(fp,lrOK);
5801
TmpStr := floattostr(lDICOMdata.DTI[lDICOMdata.nDTIdir].v2);
5802
t := _string;
5803
info :='Gradient vector [y]';
5804
if not lrOK then goto 666;
5805
e_len := 0; remaining := 0;
5806
end; //e_len = 4
5807
end; //element 10b1
5808
$10b2: begin
5809
if e_len = 4 then begin
5810
lDICOMdata.DTI[lDICOMdata.nDTIdir].v3 := read32r(fp,lrOK);
5811
TmpStr := floattostr(lDICOMdata.DTI[lDICOMdata.nDTIdir].v3);
5812
t := _string;
5813
info :='Gradient vector [z]';
5814
//fx(lDICOMdata.DTI[lDICOMdata.nDTIdir].v1,lDICOMdata.DTI[lDICOMdata.nDTIdir].v2,lDICOMdata.DTI[lDICOMdata.nDTIdir].v3);
5815
if not lrOK then goto 666;
5816
e_len := 0; remaining := 0;
5817
end; //e_len = 4
5818
end; //element 10b2
5819
end; //CASE...element
5820
end; //if Manufacturer = Philips
5821
end; //group 2005
5822
$5200 : begin
5823
case element of
5824
$9230: begin
5825
if (lDicomData.ManufacturerID = kPhilipsID) and (orientation_not_visible( lDICOMdata))then
5826
read_philips_hidden(lFilename, dFilePos(fp),e_len,lDICOMdata);
5827
end //element 9230
5828
end; //case element
5829
end; //group 5200
5830
$DDFF : begin
5831
case element of
5832
$00E0: begin
5833
//For papyrus multislice format: if (lPapyrusSlice >= lPapyrusnSlices) then
5834
time_to_quit := TRUE;
5835
end;
5836
end;
5837
end;
5838
$FFFE : begin
5839
case element of
5840
$E000 : begin
5841
(*iif lJPEGEntries > 17 then
5842
lTestError := true;
5843
5844
5845
if not lProprietaryImageThumbnail then begin
5846
f (lReadJPEGtables) and ((lDICOMdata.RunLengthEncoding) or (lDICOMdata.JPEGLossyCpt) or (lDICOMdata.JPEGLosslessCpt)) and (not lFirstFragment) and (e_len > 1024) {1384} and ( (e_len+dFilePos(fp)) <= FileSz) then begin
5847
//first fragment is the index table, so the previous line skips the first fragment
5848
if (gECATJPEG_table_entries = 0) then begin
5849
gECATJPEG_table_entries := lDICOMdata.XYZDim[3];
5850
getmem (gECATJPEG_pos_table, gECATJPEG_table_entries*sizeof(longint));
5851
getmem (gECATJPEG_size_table, gECATJPEG_table_entries*sizeof(longint));
5852
end;
5853
if lJPEGentries < gECATJPEG_table_entries then begin
5854
inc(lJPEGentries);
5855
gECATJPEG_pos_table^[lJPEGEntries] := dFilePos(fp);
5856
gECATJPEG_size_table^[lJPEGEntries] := e_len;
5857
end;
5858
end;
5859
5860
if (lDICOMdata.CompressOffset =0) and ( (e_len+dFilePos(fp)) <= FileSz) and (e_len > 1024){ALOKA} then begin
5861
lDICOMdata.CompressOffset := dFilePos(fp);
5862
lDICOMdata.CompressSz := e_len;
5863
end;
5864
//if e_len > lDICOMdata.CompressSz then lDICOMdata.CompressSz := e_len;
5865
if (e_len > 1024) and (lDICOMdata.CompressSz=0) then begin //ABBA RLE ALOKA
5866
//Time_To_Quit := true;//ABBA
5867
lDICOMdata.CompressSz := e_len;
5868
lDICOMdata.CompressOffset := dFilePos(fp);
5869
end;
5870
if (lFirstFragment) or ((e_len > lDICOMdata.CompressSz) and not (lDicomData.RunLengthEncoding)) then
5871
lDICOMdata.CompressOffset := dFilePos(fp);
5872
if (e_len > lDICOMdata.CompressSz) and (e_len > 1024){ALOKA} then
5873
lDICOMdata.CompressSz := e_len;
5874
lFirstFragment := false;
5875
lDICOMdataBackUp := lDICOMData;
5876
5877
if (gECATJPEG_table_entries = 1) then begin //updatex
5878
gECATJPEG_size_table^[1] := lDICOMdata.CompressSz;
5879
gECATJPEG_pos_table^[1] := lDICOMdata.CompressOffset;
5880
end; //updatex
5881
5882
end; //not proprietaryThumbnail
5883
lProprietaryImageThumbnail := false; //1496
5884
*)
5885
lFirstFragment := false;//Dec09
5886
lDICOMdataBackUp := lDICOMData;//Dec09
5887
//fx(999,e_len,dFilePos(fp));
5888
if (e_len > 108) and (lDicomData.XYZdim[1]> 1) then begin
5889
lDICOMdata.CompressOffset := dFilePos(fp);
5890
lDICOMdata.CompressSz := e_len;
5891
Time_To_Quit := true;
5892
//msg('abba'+inttostr(lDICOMdata.CompressOffset)+' '+inttostr(lDICOMdata.CompressSz));
5893
end;
5894
info := 'Image Fragment ['+inttostr(dFilePos(fp))+']';
5895
5896
if (dFilePos(fp) + e_len) >= filesz then
5897
Time_To_Quit := true;
5898
dSeek(fp, dFilePos(fp) + e_len);
5899
tmpstr := inttostr(e_len);
5900
remaining := 0;
5901
e_len := 0;
5902
end;
5903
$E0DD : begin
5904
info := 'Sequence Delimiter';
5905
if (lDICOMdata.XYZdim[1]<lDICOMdataBackUp.XYZdim[1]) then begin
5906
lDICOMData := lDICOMdataBackUp;
5907
dSeek(fp, dFilePos(fp) + e_len);
5908
//lDICOMData := lDICOMdataBackUp;
5909
end else if not lImageFormatOK then begin
5910
//x(lDicomData.RunLengthEncoding) or ( ((lDicomData.JPEGLossycpt) or (lDicomData.JPEGLosslesscpt)) and (gECATJPEG_table_entries >= lDICOMdata.XYZdim[3])) then
5911
5912
time_to_quit := TRUE;
5913
end;
5914
//RLE ABBA
5915
if (e_len = 0) then begin //ALOKA
5916
explicitVR := true;
5917
time_to_quit := FALSE;//RLE16=false
5918
end;
5919
//END
5920
5921
dSeek(fp, dFilePos(fp) + e_len);
5922
tmpstr := inttostr(e_len);
5923
remaining := 0;
5924
e_len := 0;
5925
end;
5926
end;
5927
end;
5928
$FFFC : begin
5929
dSeek(fp, dFilePos(fp) + e_len);
5930
tmpstr := inttostr(e_len);
5931
remaining := 0;
5932
e_len := 0;
5933
end;
5934
$72FF : case element of
5935
$1041: time_to_quit := TRUE;
5936
end; //case 72FF
5937
$7FE0 :
5938
case element of
5939
$00 : begin
5940
info := 'Pixel Data Group Length';
5941
if not lImageFormatOK then time_to_quit := TRUE;
5942
end;
5943
$10 : begin
5944
info := 'Pixel Data';
5945
TmpStr := inttostr(e_len);
5946
if (lDICOMdata.XYZdim[1]<lDICOMdataBackUp.XYZdim[1]) then begin
5947
lDICOMData := lDICOMdataBackUp;
5948
dSeek(fp, dFilePos(fp) + e_len);
5949
//lDICOMData := lDICOMdataBackUp;
5950
end else if {(not lDicomData.RunLengthEncoding) and} (not lDicomData.JPEGLossycpt) and (not lDicomData.JPEGLosslesscpt) then begin
5951
time_to_quit := TRUE;
5952
//xlDicomData.ImageSz := e_len;
5953
5954
end;
5955
e_len := 0;
5956
5957
end;
5958
5959
5960
end;
5961
else
5962
begin
5963
if (group >= $6000) AND (group <= $601e) AND ((group AND 1) = 0)
5964
then begin
5965
info := 'Overlay'+inttostr(dfilepos(fp))+'x'+inttostr(e_len);
5966
end;
5967
if element = $0000 then info := 'Group Length';
5968
if element = $4000 then info := 'Comments';
5969
end;
5970
end;
5971
lStr := '';
5972
5973
5974
if (Time_TO_Quit) and (not lImageFormatOK) then begin
5975
lHdrOK := true;
5976
goto 666;
5977
end;
5978
5979
//Msg(inttohex(group,4) +':'+inttohex(element,4) +' '+inttostr(e_len)+'@'+ inttostr(dfilepos(fp)));
5980
5981
if (e_len + dfilepos(fp)) > FileSz then begin//patch for GE files that only fill top 16-bytes w Random data
5982
e_len := e_len and $FFFF;
5983
end;
5984
5985
if (e_len > 131072) then begin
5986
//goto 666;
5987
end;//zebra
5988
if (NOT time_to_quit) AND (e_len > 0) and (remaining > 0) then begin
5989
if (e_len + dfilepos(fp)) > FileSz then begin
5990
if not lImageFormatOK(*x(lDICOMdata.GenesisCpt) or (lDICOMdata.JPEGlosslessCpt) or (lDICOMdata.JPEGlossyCpt)*) then
5991
lHdrOK := true
5992
else begin
5993
Msg('dcm Error: not a DICOM image: '+lFilename);
5994
{Msg('Diagnostics saved as: c:\dcmcrash.txt');
5995
//diagnostics
5996
assignfile(lTextF,'c:\dcmcrash.txt');
5997
Filemode := 0;
5998
rewrite(lTextF);
5999
Write(lTextF,lDynStr);
6000
closefile(lTextF); }
6001
6002
//Msg(inttohex(group,4) +':'+inttohex(element,4) +' '+inttostr(e_len)+'@'+ inttostr(dfilepos(fp)));
6003
end;
6004
goto 666;
6005
end;
6006
6007
if e_len > 0 then begin
6008
GetMem( buff, e_len);
6009
dBlockRead(fp, buff, e_len, n);
6010
if lVerboseRead then
6011
case t of
6012
unknown :
6013
case e_len of
6014
1 : lStr := ( IntToStr(Integer(buff[0])));
6015
2 : Begin
6016
if lDicomData.little_endian <> 0
6017
then i := Integer(buff[0]) + 256*Integer(buff[1])
6018
else i := Integer(buff[0])*256 + Integer(buff[1]);
6019
lStr :=( IntToStr(i));
6020
end;
6021
4 : Begin
6022
if lDicomData.little_endian <> 0
6023
then i := Integer(buff[0])
6024
+ 256*Integer(buff[1])
6025
+ 256*256*Integer(buff[2])
6026
+ 256*256*256*Integer(buff[3])
6027
else i := Integer(buff[0])*256*256*256
6028
+ Integer(buff[1])*256*256
6029
+ Integer(buff[2])*256
6030
+ Integer(buff[3]);
6031
lStr := (IntToStr(i));
6032
end;
6033
else begin
6034
if e_len > 0 then begin
6035
for i := 0 to e_len-1 do begin
6036
if Char(buff[i]) in ['+','-','/','\',' ', '0'..'9','a'..'z','A'..'Z'] then
6037
lStr := lStr+(Char(buff[i]))
6038
else
6039
lStr := lStr+('.');
6040
end;
6041
end else
6042
lStr := '*NO DATA*';
6043
end;
6044
end;
6045
6046
i8, i16, i32, ui8, ui16, ui32,
6047
_string : for i := 0 to e_len-1 do
6048
if Char(buff[i]) in ['+','-','/','\',' ', '0'..'9','a'..'z','A'..'Z']
6049
then lStr := lStr +(Char(buff[i]))
6050
else lStr := lStr +('.');
6051
end;
6052
FreeMem(buff);
6053
6054
end;
6055
end
6056
else if e_len > 0 then lStr := (IntToStr(tmp))
6057
else begin
6058
lStr := TmpStr;
6059
end;
6060
(*if (lGrp) then if MessageDlg(lStr+'= '+info+' '+IntToHex(where,4)+': ('+IntToHex(group,4)+','+IntToHex(element,4)+')'+IntToStr(e_len)+'. Continue?',
6061
mtConfirmation, [mbYes, mbNo], 0) = mrNo then GOTO 666;
6062
*)
6063
//if (Group > $2005) then
6064
// msg(info+' '+IntToStr(where)+': ('+IntToHex(group,4)+','+IntToHex(element,4)+')'+IntToStr(e_len));
6065
{$IFDEF Troubleshoot}
6066
Msg( IntToHex(group,4)+','+IntToHex(element,4)+','+Info+'='+lStr);
6067
{$ENDIF Troubleshoot}
6068
6069
6070
if lverboseRead then begin
6071
if length(lDynStr) > kMaxTextBuf then begin
6072
if not lTextOverFlow then begin
6073
lDynStr := lDynStr + 'Only showing the first '+inttostr(kMaxTextBuf) +' characters of this LARGE header';
6074
lTextOverFlow := true;
6075
6076
end;
6077
//goto 666;
6078
end else
6079
lDynStr := lDynStr+IntToHex(group,4)+','+IntToHex(element,4)+','+Info+'='+lStr+kCR ;
6080
Msg( IntToHex(group,4)+','+IntToHex(element,4)+','+Info+'='+lStr);
6081
end; //not verbose read
6082
6083
end; // end for
6084
6085
lDicomData.ImageStart := dfilepos(fp);
6086
6087
if lBigSet then begin
6088
if lBig then lDicomData.little_endian := 0
6089
else lDicomData.little_endian := 1;
6090
end;
6091
lHdrOK := true;
6092
if lByteSwap then begin
6093
ByteSwap(lDicomdata.XYZdim[1]);
6094
ByteSwap(lDicomdata.XYZdim[2]);
6095
if lDicomdata.XYZdim[3] <> 1 then
6096
ByteSwap(lDicomdata.XYZdim[3]);
6097
//xByteSwap(lDicomdata.SamplesPerPixel);
6098
ByteSwap(lDicomData.Allocbits_per_pixel);
6099
//xByteSwap(lDicomData.Storedbits_per_pixel);
6100
end;
6101
6102
if (lDICOMdata.ManufacturerID = kPhilipsID) and (l4DDistanceBetweenSliceCenters <> MaxInt) then //some 3D and 4D Philips files do not correctly report interslice distance in 0018,0088 and 0018,0050...
6103
lDICOMdata.XYZmm[3] := (l4DDistanceBetweenSliceCenters);
6104
if (lPrefs.PhilipsPrecise) and (lManufacturerIsPhilips) and (lPhilipsScaleSlope <> 0) then begin
6105
PhilipsPrecise (lDicomData.IntenScale, lDICOMdata.intenIntercept,lPhilipsScaleSlope, lDicomData.IntenScale, lDICOMdata.intenIntercept,true);
6106
end; //if PARprecise
6107
if (lDICOMdata.ManufacturerID = kPhilipsID) and (lDICOMdata.nDTIdir > 1) then begin
6108
lGELX := true;
6109
for i := 1 to lDICOMdata.nDTIdir do
6110
if lDICOMdata.DTI[lDICOMdata.nDTIdir].bval <> lDICOMdata.DTI[1].bval then
6111
lGELX := false;//multiple B0 directions
6112
if lGELX then
6113
lDICOMdata.nDTIdir := 1;
6114
lGELX := false;
6115
end;
6116
if (lMatrixSz > 1) and (lDicomData.CSAImageHeaderInfoPos > 0) and (lDicomData.CSAImageHeaderInfoSz > 0) and
6117
not (((lDicomdata.XYZdim[1] mod lMatrixSz) = 0) and ((lDicomdata.XYZdim[2] mod lMatrixSz) = 0)) then begin
6118
//Slow method for non-square Siemens matrices - 0018:1310 based on phase/freq, so it is easier to read CSA to decode rows/columns
6119
6120
GetCSAImageHeaderInfo (lFilename, lDicomData.CSAImageHeaderInfoPos ,lDicomData.CSAImageHeaderInfoSz, lTempInt,lDICOMdata.SiemensMosaicX,lDICOMdata.SiemensMosaicY, lfloat1,lfloat2,lfloat3)
6121
end else
6122
if (lMatrixSz > 1) and ((lDicomdata.XYZdim[1] mod lMatrixSz) = 0) and ((lDicomdata.XYZdim[2] mod lMatrixSz) = 0) then begin
6123
6124
if ((lDicomData.XYZdim[1] mod lMatrixSz)=0) then
6125
lDicomData.SiemensMosaicX := lDicomData.XYZdim[1] div lMatrixSz;
6126
if ((lDicomData.XYZdim[2] mod lMatrixSz)=0) then
6127
lDicomData.SiemensMosaicY := lDicomData.XYZdim[2] div lMatrixSz;
6128
if lDicomData.SiemensMosaicX < 1 then lDicomData.SiemensMosaicX := 1; //1366
6129
if lDicomData.SiemensMosaicY < 1 then lDicomData.SiemensMosaicY := 1; //1366
6130
6131
if lOldSiemens_IncorrectMosaicMM then begin //old formats convert size in mm incorrectly - modern versions are correct and include transfer syntax
6132
lDicomdata.XYZmm[1] := lDicomdata.XYZmm[1] * (lDicomdata.XYZdim[1] div lMatrixSz);
6133
lDicomdata.XYZmm[2] := lDicomdata.XYZmm[2] * (lDicomdata.XYZdim[2] div lMatrixSz);
6134
end;
6135
end else if (lSiemensMosaic0008_0008) and (lPhaseEncodingSteps > 0) and (lPhaseEncodingSteps < lDicomdata.XYZdim[2]) and ((lDicomdata.XYZdim[2] mod lPhaseEncodingSteps) = 0) and ((lDicomdata.XYZdim[2] mod (lDicomdata.XYZdim[2] div lPhaseEncodingSteps)) = 0) then begin
6136
//1499c kludge for detecting new Siemens mosaics: WARNING may cause false positives - Siemens fault not mine!
6137
lDicomData.SiemensMosaicY :=lDicomdata.XYZdim[2] div lPhaseEncodingSteps;
6138
lDicomData.SiemensMosaicX := lDicomData.SiemensMosaicY; //We also need to assume as many mosaic rows as columns, as Siemens does not save the phase encoding lines in the header...
6139
end;
6140
// fx(lnSlicePerVol,lnVol, lDicomData.SlicesPer3DVol,lDicomdata.XYZdim[3] );
6141
//fx(lnVol,lnSlicePerVol,lDicomData.SlicesPer3DVol,lDicomdata.XYZdim[3]);
6142
//fx(lnSlicePerVol,lDicomData.ManufacturerID,kPhilipsID );
6143
if (lnSlicePerVol > 0) and (lDicomData.ManufacturerID = kPhilipsID) {and (lnVol > 1)} and (lDicomdata.XYZdim[3] > 1) and (lDicomData.SlicesPer3DVol > 0)and ((lDicomdata.XYZdim[3] mod lDicomData.SlicesPer3DVol) = 0) then begin
6144
lDICOMdata.File4D := true;
6145
lnVol := lDicomdata.XYZdim[3] div lDicomData.SlicesPer3DVol;
6146
end;
6147
if lManufacturerIsBruker then
6148
lDicomData.AcquNum := 1; //Bruker varies this for every image
6149
6150
if (lEchoNum > 0) and (lEchoNum < 16) then begin
6151
lDicomData.AcquNum := lDicomData.AcquNum + (1000*lEchoNum);
6152
end;
6153
if lVerboseRead then begin
6154
Msg ('DICOM data');
6155
Msg ('Image Series/Number: '+inttostr(lDicomData.AcquNum)+'/'+inttostr(lDicomData.ImageNum));
6156
Msg ('BPP: '+inttostr(lDicomData.Allocbits_per_pixel));
6157
Msg ('XYZ dim:' +inttostr(lDicomData.XYZdim[1])+'/'+inttostr(lDicomData.XYZdim[2])+'/'+inttostr(lDicomData.XYZdim[3]) );
6158
Msg ('XYZ mm:'+floattostrf(lDicomData.XYZmm[1],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[2],ffFixed,8,2)+'/'+floattostrf(lDicomData.XYZmm[3],ffFixed,8,2) );
6159
Msg ('DTI bvalue:'+ inttostr(lDICOMdata.DTI[1].bval));
6160
Msg ('DTI bvec:'+floattostrf(lDicomData.DTI[1].v1,ffFixed,8,2)+'/'+floattostrf(lDicomData.DTI[1].v2,ffFixed,8,2)+'/'+floattostrf(lDicomData.DTI[1].v3,ffFixed,8,2) );
6161
end;
6162
//msg('abba'+inttostr(lDICOMdata.CompressOffset)+' '+inttostr(lDICOMdata.CompressSz));
6163
666:
6164
//if not lHdrOk then Msg('zx'+lFilename);
6165
if lDiskCacheSz > 0 then
6166
freemem(lDiskCacheRA);
6167
if not lHdrOK then lImageFormatOK := false;
6168
CloseFile(fp);
6169
FileMode := 2; //set to read/write
6170
//if kUseDateTimeForID then
6171
lDicomData.DateTime := StudyDateTime(lDicomData.StudyDate,lDicomData.StudyTime);
6172
if (lDicomData.SiemensMosaicX > 1) then
6173
lDicomData.AcquNum := 1;
6174
end;
6175
6176
6177
end.
Loggerhead is a web-based interface for Breezy
Version: 2.0.1