diff --git a/.DS_Store b/.DS_Store new file mode 100644 index 0000000..0bd976c Binary files /dev/null and b/.DS_Store differ diff --git a/HighResolutionBitmaps/M1x64.png b/HighResolutionBitmaps/M1x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/M2x64.png b/HighResolutionBitmaps/M2x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/M3x64.png b/HighResolutionBitmaps/M3x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/M4x64.png b/HighResolutionBitmaps/M4x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/M5x64.png b/HighResolutionBitmaps/M5x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/M6x64.png b/HighResolutionBitmaps/M6x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/M7x64.png b/HighResolutionBitmaps/M7x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/Plotx64.png b/HighResolutionBitmaps/Plotx64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/Renderx64.png b/HighResolutionBitmaps/Renderx64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M1x48.afdesign b/HighResolutionBitmaps/affinity/M1x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M1x64.afdesign b/HighResolutionBitmaps/affinity/M1x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M2x48.afdesign b/HighResolutionBitmaps/affinity/M2x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M2x64.afdesign b/HighResolutionBitmaps/affinity/M2x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M3x48.afdesign b/HighResolutionBitmaps/affinity/M3x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M3x64.afdesign b/HighResolutionBitmaps/affinity/M3x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M4x48.afdesign b/HighResolutionBitmaps/affinity/M4x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M4x64.afdesign b/HighResolutionBitmaps/affinity/M4x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M5x48.afdesign b/HighResolutionBitmaps/affinity/M5x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M5x64.afdesign b/HighResolutionBitmaps/affinity/M5x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M6x48.afdesign b/HighResolutionBitmaps/affinity/M6x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M6x64.afdesign b/HighResolutionBitmaps/affinity/M6x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M7x48.afdesign b/HighResolutionBitmaps/affinity/M7x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/M7x64.afdesign b/HighResolutionBitmaps/affinity/M7x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/Plotx64.afdesign b/HighResolutionBitmaps/affinity/Plotx64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/M2.png b/HighResolutionBitmaps/affinity/ico48/M2.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/M3.png b/HighResolutionBitmaps/affinity/ico48/M3.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/M4.png b/HighResolutionBitmaps/affinity/ico48/M4.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/m1.png b/HighResolutionBitmaps/affinity/ico48/m1.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/m10.png b/HighResolutionBitmaps/affinity/ico48/m10.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/m5.png b/HighResolutionBitmaps/affinity/ico48/m5.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/m6.png b/HighResolutionBitmaps/affinity/ico48/m6.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/m7.png b/HighResolutionBitmaps/affinity/ico48/m7.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/m8.png b/HighResolutionBitmaps/affinity/ico48/m8.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/ico48/m9.png b/HighResolutionBitmaps/affinity/ico48/m9.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/m10x48.afdesign b/HighResolutionBitmaps/affinity/m10x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/m8x48.afdesign b/HighResolutionBitmaps/affinity/m8x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/m8x64.afdesign b/HighResolutionBitmaps/affinity/m8x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/m9x48.afdesign b/HighResolutionBitmaps/affinity/m9x48.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/m9x64.afdesign b/HighResolutionBitmaps/affinity/m9x64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/mricro.afdesign b/HighResolutionBitmaps/affinity/mricro.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/mricron.afdesign b/HighResolutionBitmaps/affinity/mricron.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/affinity/renderx64.afdesign b/HighResolutionBitmaps/affinity/renderx64.afdesign old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/ico128.png b/HighResolutionBitmaps/ico128.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/ico256.png b/HighResolutionBitmaps/ico256.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/ico48.png b/HighResolutionBitmaps/ico48.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/ico64.png b/HighResolutionBitmaps/ico64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/m10x48.png b/HighResolutionBitmaps/m10x48.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/m8x64.png b/HighResolutionBitmaps/m8x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/m9x64.png b/HighResolutionBitmaps/m9x64.png old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Info.plist b/HighResolutionBitmaps/mricron.app/Contents/Info.plist old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/PkgInfo b/HighResolutionBitmaps/mricron.app/Contents/PkgInfo old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/lut/random.lut b/HighResolutionBitmaps/mricron.app/Contents/Resources/lut/random.lut old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/mricron.icns b/HighResolutionBitmaps/mricron.app/Contents/Resources/mricron.icns old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/AICHAmc.nii.gz b/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/AICHAmc.nii.gz old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/AICHAmc.nii.lut b/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/AICHAmc.nii.lut old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/AICHAmc.nii.txt b/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/AICHAmc.nii.txt old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/HarvardOxford-cort-maxprob-thr0-1mm.nii.gz b/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/HarvardOxford-cort-maxprob-thr0-1mm.nii.gz old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/inia19-NeuroMaps.nii.gz b/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/inia19-NeuroMaps.nii.gz old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/inia19-t1-brain.nii.gz b/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/inia19-t1-brain.nii.gz old mode 100644 new mode 100755 diff --git a/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/natbrainlab.nii.gz b/HighResolutionBitmaps/mricron.app/Contents/Resources/templates/natbrainlab.nii.gz old mode 100644 new mode 100755 diff --git a/README.md b/README.md index 13100eb..8ba2c54 100755 --- a/README.md +++ b/README.md @@ -2,77 +2,37 @@ ##### About -MRIcron is a viewer for brain imaging data. NPM is a tool for non parametric analysis of neuroimaging lesion data. dcm2nii is designed for converting the complicated DICOM format used in medical imaging to the simple NIfTI format preferred by scientists. These tools are mature and hopefully robust but no longer in active development. - - MRIcron development has moved to [MRIcroGL](https://github.com/neurolabusc/MRIcroGL) - - NPM development has been moved to [NiiStat](https://github.com/neurolabusc/NiiStat) - - dcm2nii development has been moved to [dcm2niix](https://github.com/neurolabusc/dcm2niix) - -##### Downloading compiled software +MRIcron is a viewer for brain imaging data. - - The latest stable version is released at [NITRC](https://www.nitrc.org/projects/mricron) +##### Installing -##### Recent Versions +You can download the software from several locations: -20-December-2017 (v1.0.20171220) - - Now includes [dcm2niix](https://github.com/rordenlab/dcm2niix) (import menu). - - NPM and dcm2nii no longer included (as they were deprecated) - -2-May-2016 - - MRIcron : Improved ability to copy images to clipboard - - NPM : Permutation thresholds in previous versions were not completely random, while the influence of this was typically negligible when images were listed in random order, this could make the thresholds slightly more liberal or conservative if the images listed in a sorted manner (e.g. lesion size, behavioral deficit). This new version revamps the randomization process, including using the [random number generator described by Marsaglia Zaman](http://paulbourke.net/miscellaneous/random/). Permutation thresholds are now more robust, albeit slower. THe enhanced 64-bit version allows the user to select more threads, which can accelerate the software (assuming your computer has more CPUs). + - Download the latest version from [NITRC](https://www.nitrc.org/projects/mricron). + - Download the [Github](https://github.com/neurolabusc/MRIcroGL/releases). + - Run the following command to get the latest version for Linux, Macintosh or Windows: + * `curl -fLO https://github.com/rordenlab/MRIcroGL12/releases/latest/download/MRIcroGL_linux.zip` + * `curl -fLO https://github.com/rordenlab/MRIcroGL12/releases/latest/download/MRIcroGL_macOS.dmg` + * `curl -fLO https://github.com/rordenlab/MRIcroGL12/releases/latest/download/MRIcroGL_windows.zip` + +Once you have downloaded and extracted the software, you may want to visit the [wiki](https://www.nitrc.org/plugins/mwiki/index.php/mricron:MainPage) for usage advice. ##### License This software includes a [BSD license](https://opensource.org/licenses/BSD-2-Clause) -##### Compiling your own software +##### Future -This is a beta release of MRIcron. You can compile this using Lazarus. It has been compiled on Windows, Linux-x86, OSX-x86 and OSX-PPC. It requires builds of Lazarus and FreePascal created after October 7, 2007. - http://www.hu.freepascal.org/lazarus/ +MRIcron is robust and stable, but development efforts have moved to MRIcroGL. The latest releases of MRIcron only include the MRIcron viewer and the dcm2niix image converter. Once upon a time, the software was distributed with statistics (NPM) and legacy image converter (dcm2nii). One can still download old releases of MRIcron from [NITRC](https://www.nitrc.org/projects/mricron) or compile these legacy tools (see next section). -To compile for OSX [Carbon] - -1.) Launch Lazarus and open the project. -2.) Select Project/CompilerOptions - Paths tab: make sure the "LCL widget type" is set to "carbon" - Linking tab: make sure the "Pass options to linker" checkbox is selected and - set the text to "-framework carbon" (no quotes). -3.) Select Project/ProjectOptions and set "Use application bundle for running and debugging" -4.) If using OSX 10.5 or later, add to Project / Compiler options / Other / Custom options: - -k-macosx_version_min -k10.4 - -XR/Developer/SDKs/MacOSX10.4u.sdk/ - Alternative: Project/ProjectOptions/Linking/ Check 'pass options to linker' and add this line -macosx_version_min 10.4 -5.) For debugging, you will want to create an alias from the application folder to the compiled executable: - The exact value will depend on your paths, but it will be similar to this: - rm ~/Documents/mricron/mricron.app/mricron - ln -s ~/Documents/mricron/mricron ~/Documents/mricron/mricron.app/mricron - rm ~/Documents/mricron/npm/npm.app/npm - ln -s ~/Documents/mricron/npm/npm ~/Documents/mricron/npm/npm.app/npm - rm ~/Documents/mricron/dcm2nii/dcm2niigui.app/dcm2niigui - ln -s ~/Documents/mricron/dcm2nii/dcm2niigui ~/Documents/mricron/dcm2nii/dcm2niigui.app/dcm2niigui +NPM is a tool for non parametric analysis of neuroimaging lesion data. dcm2nii is designed for converting the complicated DICOM format used in medical imaging to the simple NIfTI format preferred by scientists. These tools are mature and hopefully robust but no longer in active development. -6.) Select Run/Run to build and execute your program -7.) For making an executable to distribute, control+click on the program's .app folder (e.g. the file named mricron that has a brain icon) and choose "show package contents" - move the executable generated with Lazarus into the folder, overwriting the symbolic link created in step 4. - -------------------------------------------- -To compile for Linux GTK1 - -1.) Launch Lazarus and open the project. -2.) Select Project/CompilerOptions - Paths tab: make sure the "LCL widget type" is set to "default [gtk]" - Linking tab: make sure the "Pass options to linker" checkbox is UNCHECKED. -3.) Choose Run/Run to build and execute the program + - MRIcron development has moved to [MRIcroGL](https://github.com/rordenlab/MRIcroGL12/releases) + - NPM development has been moved to [NiiStat](https://github.com/neurolabusc/NiiStat) + - dcm2nii development has been moved to [dcm2niix](https://github.com/neurolabusc/dcm2niix) -------------------------------------------- -To compile for Linux GTK2 - -1.) Launch Lazarus and open the project. -2.) Select Project/CompilerOptions - Paths tab: make sure the "LCL widget type" is set to "gtk2" - Linking tab: make sure the "Pass options to linker" checkbox is UNCHECKED. -3.) Choose Run/Run to build and execute the program +##### Compiling your own software -------------------------------------------- -To compile for Windows - -1.) Launch Lazarus and open the project. -2.) Select Project/CompilerOptions - Paths tab: make sure the "LCL widget type" is set to "default [Win API]" - Linking tab: make sure the "Pass options to linker" checkbox is UNCHECKED. -3.) Choose Run/Run to build and execute the program +You can build MRIcron using [Lazarus](https://www.lazarus-ide.org). + - Launch Lazarus and open the project. + - Choose Run/Run to build and execute the program diff --git a/_lazwin.bat b/_lazwin.bat index 72a73ee..629c5e6 100755 --- a/_lazwin.bat +++ b/_lazwin.bat @@ -15,11 +15,11 @@ copy /Y mricron.exe d:\neuro\mricron call _clean.bat del d:\neuro\MRIcron\mricron.ini REM compress MRIcron -c:\Progra~1\7-Zip\7z a -tzip d:\neuro\MRIcron_Windows.zip d:\neuro\MRIcron +c:\Progra~1\7-Zip\7z a -tzip d:\neuro\MRIcron_windows.zip d:\neuro\MRIcron REM copy /Y c:\pas\wincron.zip Y:\mcbi\MCBI\CRNL\sw\mricron\win.zip REM compress Source -# c:\Progra~1\7-Zip\7z a -tzip c:\pas\mricron_windows.zip c:\pas\mricron +# c:\Progra~1\7-Zip\7z a -tzip c:\pas\mricron_windows_src.zip c:\pas\mricron REM copy c:\pas\srccron.zip Y:\mcbi\MCBI\CRNL\sw\mricron\source.zip diff --git a/_osx.command b/_osx.command index 0a6bbd4..b9cc4fc 100755 --- a/_osx.command +++ b/_osx.command @@ -12,7 +12,10 @@ cp dcm2niix /Users/rorden/Documents/mricron/MRIcron/MRIcron.app/Contents/Resources/dcm2niix SKIPDCM2NIIX -cd /Users/rorden/Documents/pas/mricron +cp /usr/local/bin/dcm2niix /Users/chris/Neuro/MRIcron/MRIcron.app/Contents/Resources/dcm2niix + + +cd /Users/chris/src/MRIcron chmod 777 ./_xclean.bat ./_xclean.bat @@ -48,11 +51,11 @@ SKIPNPM #Current FPC 3.0.0 can not compile on OSX 10.11 El Capitan, so use 3.1.1 #/Users/rorden/lazarus/lazbuild ./mricron.lpr --cpu=x86_64 --ws=cocoa --compiler="/usr/local/lib/fpc/3.1.1/ppcx64" -/Users/rorden/lazarus/lazbuild ./mricron.lpr --cpu=x86_64 --ws=cocoa +/Users/chris/src/lazarus/lazbuild ./mricron.lpr --cpu=x86_64 --ws=cocoa strip ./mricron -cp ./mricron /Users/rorden/Documents/mricron/MRIcron/MRIcron.app/Contents/MacOS/MRIcron +cp ./mricron /Users/chris/Neuro/MRIcron/MRIcron.app/Contents/MacOS/MRIcron awk '{gsub(/Active="MacOS"/,"Active=\"Default\"");}1' mricron.lps > mricron.tmp && mv mricron.tmp mricron.lps @@ -61,11 +64,10 @@ awk '{gsub(/Active="MacOS"/,"Active=\"Default\"");}1' mricron.lps > mricron.tmp rm -rf lib rm -rf backup -cd /Users/rorden/Documents/pas/ -zip -r /Users/rorden/Documents/mricron_source.zip mricron - -cd /Users/rorden/Documents/ -zip -r /Users/rorden/Documents/mricron_osx.zip mricron - +cd /Users/chris/src +zip -r /Users/chris/src/mricron_source.zip mricron +cd /Users/chris/Neuro +hdiutil create -volname MRIcron -srcfolder /Users/chris/Neuro/MRIcron -ov -format UDZO -layout SPUD -fs HFS+J mricron_macOS.dmg +codesign -s "Developer ID Application: Christopher Rorden" mricron_macOS.dmg diff --git a/_xclean.bat b/_xclean.bat index 58d253e..c0972d5 100755 --- a/_xclean.bat +++ b/_xclean.bat @@ -1,6 +1,9 @@ #!/bin/sh find . -name \*.dcu -type f -delete +rm -rf lib +rm -rf backup +rm -r .DS_Store rm -r *.a rm -r *.o rm -r *.ppu @@ -27,6 +30,7 @@ rm -r *.o rm -r *.ppu rm -r *.bak cd .. +rm -rf ./common/backup cd ./dcm2nii diff --git a/_xclean.bat~ b/_xclean.bat~ deleted file mode 100755 index 0a9f434..0000000 --- a/_xclean.bat~ +++ /dev/null @@ -1,38 +0,0 @@ -rm -r *.a -rm -r *.o -rm -r *.ppu -rm -r *.bak -rm mricron - -cd ./rgb -rm -r *.a -rm -r *.o -rm -r *.ppu -rm -r *.bak -cd .. - -cd ./common -rm -r *.a -rm -r *.o -rm -r *.ppu -rm -r *.bak -cd .. - - -cd ./dcm2nii -rm ./dcm2niigui -rm ./dcm2nii -rm -r *.a -rm -r *.o -rm -r *.ppu -rm -r *.bak -rm -rf dcm2niigui.app -cd .. - -cd ./npm -rm ./npm -rm -r *.o -rm -r *.ppu -rm -r *.bak - - diff --git a/batch.pas b/batch.pas index c2d4f95..8202194 100755 --- a/batch.pas +++ b/batch.pas @@ -126,11 +126,11 @@ procedure BatchVOI; ImgForm.UpdateLayerMenu; lBGStrings := TStringList.Create; if (ssShift in KeyDataToShiftState(vk_Shift)) then begin - GetFilesInDir(ExtractFileDir(HdrForm.OpenHdrDlg.Filename),lBGStrings) + GetFilesInDir(ExtractFileDir(ImgForm.OpenHdrDlg.Filename),lBGStrings) end else begin - if not OpenDialogExecute(kImgFilter,'Select background images (stat maps)',true) then + if not ImgForm.OpenDialogExecute(kImgFilter,'Select background images (stat maps)',true) then exit; - lBGStrings.AddStrings(HdrForm.OpenHdrDlg.Files); + lBGStrings.AddStrings(ImgForm.OpenHdrDlg.Files); end; lNumberofP:= lBGStrings.Count; if lNumberofP < 1 then begin @@ -139,8 +139,8 @@ procedure BatchVOI; end; - if not OpenDialogExecute(kImgFilter,'Select overlay images (ROIs)',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select overlay images (ROIs)',true) then exit; + lNumberofFiles:= ImgForm.OpenHdrDlg.Files.Count; if lNumberofFiles < 1 then exit; TextForm.MemoT.Lines.Clear; @@ -165,11 +165,11 @@ procedure BatchVOI; lStr := 'max10pct' else lStr := 'mean'; - lStr := lStr +kTextSep+ (HdrForm.OpenHdrDlg.Files[lInc-1]); + lStr := lStr +kTextSep+ (ImgForm.OpenHdrDlg.Files[lInc-1]); for lP := 1 to lNumberofP do begin lFilename := lBGStrings.Strings[lP-1]; ImgForm.OpenAndDisplayImg(lFilename,True); - lFilename := HdrForm.OpenHdrDlg.Files[lInc-1]; + lFilename := ImgForm.OpenHdrDlg.Files[lInc-1]; ImgForm.OverlayOpenCore ( lFilename, 2); if lP = 1 then lStr := lStr + kTextSep+ inttostr(VOIVol(2) ); diff --git a/common/backup/define_types.pas.bak b/common/backup/define_types.pas.bak deleted file mode 100755 index 09167fe..0000000 --- a/common/backup/define_types.pas.bak +++ /dev/null @@ -1,1456 +0,0 @@ -unit define_types; -interface -{$H+} -{$mode delphi} -{$include isgui.inc} - - uses - {$IFNDEF FPC} - {$IFDEF GUI} FileCtrl, delphiselectfolder, {$ENDIF} - DiskSpaceKludge, Controls, - {$ELSE} - {$IFDEF GUI} lclintf,LResources,{$ENDIF} - {$ENDIF} - {$IFNDEF Unix} Windows, - {$ELSE} - BaseUnix,{$IFDEF GUI} LCLType, {$ENDIF}//lclintf, LMessages,LCLType,//gettickcount - {$ENDIF} - - SysUtils,classes,IniFiles, - {$IFDEF GUI} forms,userdir, dialogs{$ELSE}dialogsx{$ENDIF}; -const - //kMRIcronVersDate = '3MAY2016'; - kVers = 'v1.0.20181114'; - {$IFDEF LCLCocoa} - kMRIcronAPI = 'Cocoa'; - {$ELSE} - {$IFDEF LCLCarbon} - kMRIcronAPI = 'Carbon'; - {$ELSE} - kMRIcronAPI = ''; //windows, GTK, QT - {$ENDIF} - {$ENDIF} - {$ifdef CPU32} - kMRIcronCPU = '32'; - {$ELSE} - kMRIcronCPU = '64'; - {$ENDIF} - kMRIcronVers = kVers+' '+ kMRIcronCPU +'bit BSD License '+kMRIcronAPI; - NaN : double = 1/0; - kMagicDouble : double = -111666222; - kTxtFilter = 'Text (*.txt)|*.txt;*.csv|Comma Separated (*.csv)|*.csv'; - kAnyFilter = 'Anything (*)|*'; - kAnaHdrFilter = 'Analyze Header (*.hdr)|*.hdr'; - - //kNIIFilter = 'NIfTI (*.nii)|*.nii'; - //kImgPlusVOIFilter = 'NIfTI/Analyze/VOI|*.hdr;*.nii;*.nii.gz;*.voi|NIfTI/Analyze Header (*.hdr;*.nii)|*.hdr;*.nii;*.nii.gz|Volume of interest (*.voi)|*.voi'; - //kImgFilter = 'NIfTI/Analyze Header (*.hdr;*.nii)|*.hdr;*.nii;*.nii.gz|Volume of interest (*.voi)|*.voi'; - //kImgFilterPlusAny = 'NIfTI/Analyze Header (*.hdr;*.nii)|*.hdr;*.nii;*.nii.gz|Volume of interest (*.voi)|*.voi|Any file (*.*)|*.*'; - - kNIIFilter = 'Neuroimaging (*.nii)|*.nii;*.hdr;*.nii.gz;*.voi;*.HEAD;*.mgh;*.mgz;*.mha;*.mhd;*.nhdr;*.nrrd'; - kImgFilter = 'Neuroimaging|*.hdr;*.nii;*.nii.gz;*.HEAD;*.mgh;*.mgz;*.mha;*.mhd;*.nhdr;*.nrrd|Volume of interest (*.voi)|*.voi'; - kImgPlusVOIFilter = 'Neuroimaging/VOI|*.hdr;*.nii;*.nii.gz;*.voi;*.HEAD;*.mgh;*.mgz;*.mha;*.mhd;*.nhdr;*.nrrd|NIfTI/Analyze Header (*.hdr;*.nii)|*.hdr;*.nii;*.nii.gz|Volume of interest (*.voi)|*.voi'; - kImgFilterPlusAny = 'Neuroimaging/VOI|*.hdr;*.nii;*.nii.gz;*.voi;*.HEAD;*.mgh;*.mgz;*.mha;*.mhd;*.nhdr;*.nrrd|NIfTI/Analyze Header (*.hdr;*.nii)|*.hdr;*.nii;*.nii.gz|Volume of interest (*.voi)|*.voi|Anything (*.*)|*.*'; - kHistoBins = 256;//numbers of bins for histogram/image balance - PixelCountMax = 32768; - kTab = chr(9); - kEsc = chr(27); - kCR = chr (13); - kBS = #8 ; // Backspace - kDel = #127 ; // Delete - UNIXeoln = chr(10); - kTextSep = kTab;//','; //',' for CSV, kTab for Tab-delimited values - {$IFDEF Darwin} - kLUTalpha = 255; //255 - {$ELSE} - kLUTalpha = 0; //255 - {$ENDIF} - kVOI8bit = 1;//May07 100; -{$IFDEF unix} - PathDelim = '/'; -{$ELSE} - PathDelim = '\'; -{$ENDIF} - -type - TStrRA = Array of String; - TPSPlot = RECORD //peristimulus plot - TRSec,BinWidthSec: single; - nNegBins,nPosBins,SPMDefaultsStatsFmriT,SPMDefaultsStatsFmriT0: integer; - TextOutput,GraphOutput, - SliceTime,SavePSVol,BaselineCorrect,PctSignal,RemoveRegressorVariability,TemporalDeriv,PlotModel,Batch: boolean - end; - TRGBquad = PACKED RECORD - {$IFDEF ENDIAN_BIG} //OSX PPC - rgbreserved,rgbRed,rgbGreen,rgbBlue: byte; - //rgbBlue,rgbGreen,rgbRed,rgbreserved: byte; - {$ELSE} - {$IFDEF DARWIN} - rgbreserved,rgbRed,rgbGreen,rgbBlue: byte; - //rgbBlue,rgbreserved,rgbGreen,rgbRed: byte; - - //rgbBlue,rgbGreen,rgbRed,rgbreserved: byte; - {$ELSE} //not unix - windows - //rgbreserved,rgbRed,rgbGreen,rgbBlue: byte; - rgbBlue,rgbGreen,rgbRed,rgbreserved: byte; - {$ENDIF} -// rgbBlue,rgbGreen,rgbRed,rgbreserved: byte; - {$ENDIF} - end; - TStretchQuality = (sqLow, sqHigh); - - //TLUTrgb = array[0..255] of TRGBQuad; - //TLUTtype = DWORD; - TLUT = array[0..255] of TRGBQuad; - kStr20 = string[20]; - kStr50 = string[50]; - - kStr255 = string[255]; - - TCutout = RECORD - Lo : array [1..3] of integer; - Hi : array [1..3] of integer; - end; - int32 = LongInt; - uint32 = Cardinal; - int16 = SmallInt; - uint16 = Word; - int8 = ShortInt; - uint8 = Byte; - Int64RA = array [1..1] of int64; - Int64p = ^Int64RA; - - SingleRA0 = array [0..0] of Single; - Singlep0 = ^SingleRA0; - ByteRA0 = array [0..0] of byte; - Bytep0 = ^ByteRA0; - - //int8RA0 = array [0..0] of byte; - //int8p0 = ^int8RA0; - int8RA = array [1..1] of int8; - int8p = ^int8RA; - - WordRA0 = array [0..0] of Word; - Wordp0 = ^WordRA0; - SmallIntRA0 = array [0..0] of SmallInt; - SMallIntp0 = ^SmallIntRA0; - LongIntRA0 = array [0..0] of LongInt; - LongIntp0 = ^LongIntRA0; - DWordRA = array [1..1] of DWord; - DWordp = ^DWordRA; - ByteRA = array [1..1] of byte; - Bytep = ^ByteRA; - WordRA = array [1..1] of Word; - Wordp = ^WordRA; - SmallIntRA = array [1..1] of SmallInt; - SMallIntp = ^SmallIntRA; - LongIntRA = array [1..1] of LongInt; - LongIntp = ^LongIntRA; - SingleRA = array [1..1] of Single; - Singlep = ^SingleRA; - SingleRARA = array [1..1] of Singlep; - SingleRAp = ^SingleRARA; - DoubleRA = array [1..1] of Double; - Doublep = ^DoubleRA; - DoubleRA0 = array [0..0] of Double; - Doublep0 = ^DoubleRA0; - HistoRA = array [0..kHistoBins] of longint; - HistoDoubleRA = array [0..kHistoBins] of double; - //pRGBQuadArray = ^TRGBQuad; - //TRGBQuadeArray = ARRAY[0..PixelCountMax-1] OF TRGBQuad; - //RGBQuadRA = array [1..1] of TRGBQuad; - //RGBQuadp = ^RGBQuadRA; - TQuadRA = array [1..1] of TRGBQuad; - - RGBQuadp = ^TQuadRA; - - -// pRGBTripleArray = ^TRGBTripleArray; -// TRGBTripleArray = ARRAY[0..PixelCountMax-1] OF TRGBTriple; -FUNCTION specialsingle (var s:single): boolean; //check if 32-bit float is Not-A-Number, infinity, etc -function FSize (lFName: String): Int64; -function FileExistsEX(Name: String): Boolean; -function ParseFileName (lFilewExt:String): string; -function ParseFileFinalDir (lFileName:String): string; -function ExtractFileDirWithPathDelim(lInFilename: string): string; -function PadStr (lValIn, lPadLenIn: integer): string; -function ChangeFileExtX( var lFilename: string; lExt: string): string; -//function swap2i(SmallInt): Smallint; -function swap4r4ui (s:single): uint32; //swap and convert: endian-swap and then typecast 32-bit float as 32-bit integer -function conv4r4ui (s:single): uint32; //convert: typecast 32-bit float as 32-bit integer -function swap4r4i (s:single): longint; //swap and convert: endian-swap and then typecast 32-bit float as 32-bit integer -function conv4r4i (s:single): longint; //convert: typecast 32-bit float as 32-bit integer -function swap8r(s : double):double; //endian-swap 64-bit float -procedure pswap4i(var s : LongInt); //procedure to endian-swap 32-bit integer -procedure pswap4r ( var s:single); //procedure to endian-swap 32-bit integer -function swap64r(s : double):double; -function specialdouble (d:double): boolean; -function RealToStr(lR: double {was extended}; lDec: integer): string; -function UpCaseExt(lFileName: string): string;//file.brik.gz->BRIK.GZ, file.nii.gz -> NII.GZ -function ExtGZ (lFilename: string): boolean; -procedure swap4(var s : LongInt); -procedure Xswap4r ( var s:single); -function Bool2Char (lBool: boolean): char; -function Char2Bool (lChar: char): boolean; -function Log(X, Base: single): single; -//procedure GZipBuffer(var FGzipFilename,FFileDestination: String;lxInBuffer: byteP;lInSize: Integer; lOverwritewarn: boolean); -//procedure GZipBuffer(var FGzipFilename,FFileDestination: String;lxInBuffer: byteP;lInSize: Integer); -{$IFNDEF FPC} -function DiskFreeEx (DriveStr: String): Integer; -{$ELSE} -function DiskFreeEx (DriveStr: String): Int64; -{$ENDIF} -procedure SortSingle(var lLo,lHi: single); -procedure SortInteger(var lLo,lHi: integer); -function IniInt(lIniFile: TIniFile; lIdent: string; lDefault: integer): integer; -function IniBool(var lIniFile: TIniFile; lIdent: string; lDefault: boolean): boolean; -procedure CopyFileEX (lInName,lOutName: string); -procedure CopyFileEXoverwrite (lInName,lOutName: string); -procedure fx (a: double); overload; //fx used to help debugging - reports number values -procedure fx (a,b: double); overload; -procedure fx (a,b,c: double); overload; -procedure fx (a,b,c,d: double); overload; -function Swap2(s: smallint): smallint; -//function DefaultsDir (lSubFolder: string): string; -function ChangeFilePostfixExt (lInName,lPostfix,lExt: string): string; -procedure SortCutout (var lCutout : TCutout); //ensure Lo < Hi -function freeRam: Int64; - -function OKMsg(lMsg: string): boolean; //shows dialog with OK/Cancel returns true if user presses OK -function DirExists (lFolderName: String): boolean; -function FilenameParts (lInName: string; var lPath,lName,lExt: string): boolean; -function AddIndexToFilename (lInName: string; lIndex: integer): string; - -procedure createArray64 (var ptr: pointer; var ra :Doublep0; Sz: integer); overload; -procedure createArray64 (var ptr: pointer; var ra :Doublep; Sz: integer); overload; -function GzExt(lFileName: string): boolean; -function ChangeFilePrefixExt (lInName,lPrefix,lExt: string): string; -function ChangeFilePrefix(lInName,lPrefix: string): string; -function makesmallint (b0,b1: byte): smallint; -function makesingle( b0,b1,b2,b3: byte): single; -procedure SortInt (var lMin,lMax: integer); -function Bound (lDefault,lMin,lMax: integer): integer; -function IsNiftiExt(lStr: string): boolean; -function IsExtNIFTIHdr(lStr: string): boolean; -function IsVOIExt(lStr: string): boolean; -//procedure ax(a,b,c,d,e,fx: double); -procedure EnsureDirEndsWithPathDelim (var lDir: string); -//function IsReadOnly(const FileName: string): Boolean;//I think this only works for existing files... not folders and new files -function DirWritePermission(Where: string): Boolean; //I think this is better than above -function ExtractDir (lFilepath: string): string; -{$IFDEF GUI} -function GetDirPrompt (lDefault: string): string; -{$ENDIF} -function Str2Int (lStr: string): integer; -function ResetDefaults : boolean; - -implementation - -function ResetDefaults : boolean; -const - {$IFDEF LINUX} - kKey = 'Right button'; - {$ELSE} - kKey = 'Shift key'; - {$ENDIF} -var - lKey: boolean; -begin - result := false; -{$IFDEF GUI} - {$IFDEF LINUX} - lKey := (GetKeyState(VK_RBUTTON) And $80)<>0; - {$ELSE} - lKey := (ssShift in KeyDataToShiftState(vk_Shift)); - {$ENDIF} - if not lKey then - exit; - {$IFDEF GUI} - case MessageDlg(kKey+' down during launch: do you want to reset the default preferences?', mtConfirmation, - [mbYes, mbNo], 0) of { produce the message dialog box } - idYes: result := true; - end; //case - {$ENDIF} -{$ENDIF} -end; - -function Str2Int (lStr: string): integer; -//robust stringtoint that strips out any junk so that "Implementation Version Name=MR.VB15A" returns 15 -// warning, strips out decimals, so 15.3 will return 153! -//warning also ignores minus sign so -5.21 will return 521! -var - Len,P: integer; - S: string; -begin - result := 0; - Len := length(lStr); - if Len <1 then exit; - S := ''; - for P := 1 to Len do - if lStr[P] in ['-','0'..'9'] then - S := S + lStr[P]; - if length(S) < 1 then exit; - result := strtoint(S); -end; - - -{$IFDEF GUI} -function GetDirPrompt (lDefault: string): string; -// Old versions of Delphi have a clumsy SelectDirectory function, and locks the folder until you quit your application... -var - lD: string; -begin - lD := lDefault; - if not DirExists(lD) then - lD := UserDataFolder; - result := lD; // Set the starting directory - {$IFDEF FPC} - //Delphi SelectDirectory uses FileCtrl - //Lazarus SelectDirectory uses Dialogs - chdir(result); //start search from previous dir... - if SelectDirectory(result, [sdAllowCreate,sdPerformCreate,sdPrompt], 0) then begin - chdir(result); - exit; - end; - {$ELSE} - if SelectDirectoryDelphi('Select folder', result, true) then - exit; - {$ENDIF} - //if the user aborts, make sure we use the default directory... - result := lD; -end; -{$ENDIF} //GUI - -function ExtractDir (lFilepath: string): string; -//if passed file \usr\temp\data.txt returns \usr\temp\ -//if passed dir \usr\temp returns \usr\temp\ -//note returned always includes pathdelim -var - lName,lExt: string; -begin - FilenameParts (lFilepath,Result,lName,lExt); -end; - -function DirWritePermission(Where: string): Boolean; -{$IFDEF UNIX} -//Uses BaseUnix; -begin - result := (fpAccess (ExtractDir(Where),W_OK)=0); -end; -{$ELSE} -Var - i : Longint; - lFilename: string; -Begin - result := false; - if length(Where) < 1 then - exit; - - if DirExists (Where) then begin - if Where[length(Where)] <> PathDelim then - lFilename := Where + pathdelim + 'dummy.dum' - else - lFilename := Where + 'dummy.dum'; - end else - lFilename := Where; - if fileexists (lFilename) then - exit; //do not overwrite existing file - i:=FileCreate (lFilename); - if i=-1 then - Halt(1); - FileClose(i); - DeleteFile(lFilename); - result := true; -end; -{$ENDIF} -(*function IsReadOnly(const FileName: string): Boolean; -var - sr: TSearchRec; -begin - // Assume not read only - Result := False; - if FindFirst(FileName, faAnyFile, sr) = 0 then - begin - Result := (sr.Attr and faReadOnly) <> 0; - FindClose(sr); - end; -end; *) - -procedure EnsureDirEndsWithPathDelim (var lDir: string); -begin - if length(lDir) < 1 then - exit; - if lDir[length(lDir)] = pathdelim then - exit; - lDir := lDir + pathdelim; -end; - - -function AddIndexToFilename (lInName: string; lIndex: integer): string; -var lPath,lName,lExt: string; -begin - result := ''; - if not FilenameParts (lInName, lPath,lName,lExt) then exit; - result := lPath+lName+inttostr(lIndex)+lExt; -end; - -function Bound (lDefault,lMin,lMax: integer): integer; -begin - result := lDefault; - if result < lMin then - result := lMin; - if result > lMax then - result := lMax; -end; - -function IsVOIExt(lStr: string): boolean; -var - lExt: string; -begin - result := false; - lExt := UpCaseExt(lStr); - if (lExt = '.VOI') then - result := true; -end; -function IsNiftiExt(lStr: string): boolean; -var - lExt: string; -begin - result := false; - lExt := UpCaseExt(lStr); - if (lExt = '.MGH') or (lExt = '.MGZ') then - result := true; - if (lExt = '.MHA') or (lExt = '.MHD') then - result := true; - if (lExt = '.HEAD') then - result := true; - if (lExt = '.NRRD') then - result := true; - - if (lExt = '.NII') or (lExt = '.NII.GZ') then - result := true; - if (lExt = '.HDR') and (FSize(ChangeFileExt(lStr,'.img'))> 0) then - result := true; - if (lExt = '.IMG') and (FSize(ChangeFileExt(lStr,'.hdr'))> 0) then - result := true; -end; - -function IsExtNIFTIHdr(lStr: string): boolean; -//detect hdr, nii,niigz -var - lExt: string; -begin - result := false; - lExt := UpCaseExt(lStr); - if (lExt = '.NII') or (lExt = '.NII.GZ') then - result := true; - if (lExt = '.HDR') and (FSize(ChangeFileExt(lStr,'.img'))> 0) then - result := true; - (*if (lExt = '.IMG') and (FSize(ChangeFileExt(lStr,'.hdr'))> 0) then - result := true; *) -end; - -procedure SortInt (var lMin,lMax: integer); -var - lSwap: integer; -begin - if lMin <= lMax then - exit; - lSwap := lMax; - lMax := lMin; - lMin := lSwap; -end; - -function makesmallint (b0,b1: byte): smallint; -type - swaptype = packed record - case byte of - 0:(b0,b1 : byte); //word is 16 bit - 1:(s:smallint); - end; - swaptypep = ^swaptype; -var - //inguy:swaptypep; - outguy:swaptype; -begin - //inguy := @s; //assign address of s to inguy - outguy.b0 := b0; - outguy.b1 := b1; - result:=outguy.s; -end;//makesmallint - - -function makesingle( b0,b1,b2,b3: byte): single; -type - swaptype = packed record - case byte of - 0:(b0,b1,b2,b3 : byte); //word is 16 bit - 1:(long:single); - end; - swaptypep = ^swaptype; -var - outguy:swaptype; -begin - //inguy := @s; //assign address of s to inguy - outguy.b0 := b0; - outguy.b1 := b1; - outguy.b2 := b2; - outguy.b3 := b3; - result:=outguy.long; -end;//makesingle - -function ChangeFilePrefix(lInName,lPrefix: string): string; -var - lC,lLen,lPos: integer; - lStr: string; -begin - //result := changefileext(lInName,lExt); - result := lInName; - lLen := length (result); - if lLen < 1 then exit; - lPos := lLen; - while (lPos > 1) and (result[lPos] <> pathdelim) do - dec(lPos); - lStr := ''; - for lC := 1 to lPos do - lStr := lStr+result[lC]; - lStr := lStr+lPrefix; - if lPos < lLen then - for lC := (lPos+1) to lLen do - lStr := lStr+result[lC]; - result := lStr; -end; - -function ChangeFilePrefixExt (lInName,lPrefix,lExt: string): string; -var - lC,lLen,lPos: integer; - lStr: string; -begin - result := changefileext(lInName,lExt); - lLen := length (result); - if lLen < 1 then exit; - lPos := lLen; - while (lPos > 1) and (result[lPos] <> pathdelim) do - dec(lPos); - lStr := ''; - for lC := 1 to lPos do - lStr := lStr+result[lC]; - lStr := lStr+lPrefix; - if lPos < lLen then begin - lC := lPos+1; - while (lC <= lLen) and (result[lC] <> '.') do begin - lStr := lStr + result[lC]; - inc(lC); - end; - end; - lStr := lStr + lExt; - result := lStr; -end; - - -function GzExt(lFileName: string): boolean; -var lExt: string; -begin - lExt := UpCaseExt(lFilename); - if (lExt = '.VOI') or (lExt = '.NII.GZ') or (lExt = '.GZ') then - result := true - else - result := false; -end; - -function FilenameParts (lInName: string; var lPath,lName,lExt: string): boolean; -var - lLen,lPos,lExtPos,lPathPos: integer; -begin - result := false; - lPath := ''; - lName := ''; - lExt := ''; - lLen := length(lInName); - if lLen < 1 then exit; - //next find final pathdelim - lPathPos := lLen; - while (lPathPos > 0) and (lInName[lPathPos] <> '\') and (lInName[lPathPos] <> '/') do - dec(lPathPos); - if (lInName[lPathPos] = '\') or (lInName[lPathPos] = '/') then begin - for lPos := 1 to lPathPos do - lPath := lPath + lInName[lPos]; - end; - // else - // dec(lPathPos); - inc(lPathPos); - //next find first ext - lExtPos := 1; - while (lExtPos <= lLen) and (lInName[lExtPos] <> '.') do - inc(lExtPos); - if (lInName[lExtPos] = '.') then begin - for lPos := lExtPos to lLen do - lExt := lExt + lInName[lPos]; - end; - // else - // inc(lExtPos); - dec(lExtPos); - //next extract filename - //fx(lPathPos,lExtPos); - - if (lPathPos <= lExtPos) then - for lPos := lPathPos to lExtPos do - lName := lName + lInName[lPos]; - result := true; -end; -(*function FilenameParts (lInName: string; var lPath,lName,lExt: string): boolean; -var - lLen,lPos,lExtPos,lPathPos: integer; -begin - result := false; - lPath := ''; - lName := ''; - lExt := ''; - lLen := length(lInName); - if lLen < 1 then - exit; - if DirExists(lInName) then begin //we have been passed a folder, not a file - if lInName[lLen] = PathDelim then - lPath := lInName - else - lPath := lInName + pathdelim; - exit; - end; - //next find final pathdelim - lPathPos := lLen; - while (lPathPos > 0) and (lInName[lPathPos] <> '\') and (lInName[lPathPos] <> '/') do - dec(lPathPos); - if (lInName[lPathPos] = '\') or (lInName[lPathPos] = '/') then begin - for lPos := 1 to lPathPos do - lPath := lPath + lInName[lPos]; - end; - // else - // dec(lPathPos); - inc(lPathPos); - //next find first ext - //lExtPos := 1; - lExtPos := length(lPath);//July 2009 -- beware of '.' in foldername... - while (lExtPos <= lLen) and (lInName[lExtPos] <> '.') do - inc(lExtPos); - if (lInName[lExtPos] = '.') then begin - for lPos := lExtPos to lLen do - lExt := lExt + lInName[lPos]; - end; - // else - // inc(lExtPos); - dec(lExtPos); - //next extract filename - //fx(lPathPos,lExtPos); - if (lPathPos <= lExtPos) then - for lPos := lPathPos to lExtPos do - lName := lName + lInName[lPos]; - result := true; - -end; *) - -procedure createArray64 (var ptr: pointer; var ra :Doublep0; Sz: integer); overload; -var i: integer; -begin - getmem(ptr,16+(sizeof(double)*Sz)); - {$IFDEF FPC} - ra := align(ptr,16); - {$ELSE} - ra := DoubleP0((integer(ptr) and $FFFFFFF0)+16); - {$ENDIF} - for i := (Sz-1) downto 0 do //initialise array - ra^[i] := 0; -end; - -procedure createArray64 (var ptr: pointer; var ra :Doublep; Sz: integer); overload; -var i: integer; -begin - getmem(ptr,16+(sizeof(double)*Sz)); - {$IFDEF FPC} - ra := align(ptr,16); - {$ELSE} - ra := DoubleP((integer(ptr) and $FFFFFFF0)+16); - {$ENDIF} - for i := (Sz) downto 1 do //initialise array - ra^[i] := 0; -end; - - -function OKMsg(lMsg: string): boolean; //shows dialog with OK/Cancel returns true if user presses OK -begin - result := false; - {$IFDEF GUI} - case MessageDlg(lMsg, mtConfirmation, - [mbYes, mbCancel], 0) of - idCancel {mrCancel}: exit; - end; //case - {$ELSE} - case MsgDlg(lMsg, mtConfirmation, - [mbYes, mbCancel], 0) of - mrCancel: exit; - end; //case - {$ENDIF} - result := true; -end; - -(*function DirExists (lDir: String): boolean; -var lSearchRec: TSearchRec; -begin - FindFirst(lDir, faAnyFile, lSearchRec); - if (faDirectory and lSearchRec.attr) = faDirectory then - DirExists := true - else - DirExists := false; - FindClose(lSearchRec);{} -end;*) - -{$IFNDEF GUI} - {$IFNDEF FPC} - //The FileCtrl unit is pretty bulky, and we only need this one call that it links from SysUtils - function DirectoryExists(const Name: string): Boolean; -var - Code: Integer; -begin - Code := GetFileAttributes(PChar(Name)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); -end; - {$ENDIF} -{$ENDIF} - -function DirExists (lFolderName: string): boolean; -(*{$IFNDEF GUI} -var - lSearchRec: TSearchRec; -begin - result := false; - if fileexists(lFoldername) then //File not folder - exit; - Filemode := 0; //readonly - if FindFirst(lFolderName, faDirectory, lSearchRec) = 0 then begin - result := true; - FindClose(lSearchRec); - end else - result := false; //some files found - Filemode := 2; -{$ELSE} -*) -begin - result := DirectoryExists(lFolderName); -//{$ENDIF} -end; - -function freeRam: Int64; -{$IFDEF UNIX} -begin - result := maxint; -end; -{$ELSE} -var - memory:TMemoryStatus; - -begin - memory.dwLength:=sizeof(memory); - GlobalMemoryStatus(memory); - result := memory.dwavailPhys; - //result := 1024; -end; -{$ENDIF} - -procedure SortCutout (var lCutout : TCutout); //ensure Lo < Hi -var lInc,lSwap: integer; -begin - for lInc := 1 to 3 do - if lCutout.Lo[lInc] > lCutout.Hi[lInc] then begin - lSwap := lCutout.Lo[lInc]; - lCutout.Lo[lInc] := lCutout.Hi[lInc]; - lCutout.Hi[lInc] := lSwap; - end; -end; - - -function ChangeFilePostfixExt (lInName,lPostfix,lExt: string): string; -var - lPath,lName,lExtIn: string; -begin - FilenameParts (lInName, lPath,lName,lExtIn); - result := lPath+lName+lPostFix+lExt; - //showmessage(result); -end; - -(*var - lC,lLen,lPos: integer; - lStr: string; -begin - result := changefileext(lInName,lExt); - lLen := length (result); - if lLen < 1 then exit; - lPos := lLen; - while (lPos > 1) and (result[lPos] <> pathdelim) and (result[lPos] <> '.') do - dec(lPos); - if result[lPos] = '.' then - dec(lPos); - lStr := ''; - for lC := 1 to lPos do - lStr := lStr+result[lC]; - lStr := lStr+lPostfix; - if lPos < lLen then - for lC := (lPos+1) to lLen do - lStr := lStr+result[lC]; - result := lStr; -end; *) - -(*procedure ApplySaveDlgFilter (lSaveDlg: TSaveDialog); -var - lLen,lPos,lPipes,lPipesReq: integer; - lExt: string; -begin - lPipesReq := (lSaveDlg.FilterIndex * 2)-1; - if lPipesReq < 1 then exit; - lLen := length(lSaveDlg.Filter); - lPos := 1; - lPipes := 0; - while (lPos < lLen) and (lPipes < lPipesReq) do begin - if lSaveDlg.Filter[lPos] = '|' then - inc(lPipes); - inc(lPos); - end; - if (lPos >= lLen) or (lPipes < lPipesReq) then - exit; - lExt := ''; - while (lPos <= lLen) and (lSaveDlg.Filter[lPos] <> '|') do begin - if lSaveDlg.Filter[lPos] <> '*' then - lExt := lExt + lSaveDlg.Filter[lPos]; - inc(lPos); - end; - if lExt <> '' then - lSaveDlg.Filename := ChangeFileExt(lSaveDlg.Filename,lExt); -end; *) - -(*function DefaultsDir (lSubFolder: string): string; -//for Linux: DefaultsDir is ~/appname/SubFolder/, e.g. /home/username/mricron/subfolder/ -//for Windows: DefaultsDir is in the location of the executable, e.g. c:\program files\mricron\subfolder\ -//Note: Final character is pathdelim -var - lBaseDir: string; -begin - {$IFDEF Unix} - lBaseDir := GetEnvironmentVariable ('HOME')+pathdelim+'.' +ParseFileName(ExtractFilename(paramstr(0) ) ); - if not DirectoryExists(lBaseDir) then begin - {$I-} - MkDir(lBaseDir); - if IOResult <> 0 then begin - showmessage('Unble to create new folder '+lBaseDir); - end; - {$I+} - end; - lBaseDir := lBaseDir+pathdelim; - {$ELSE} - lBaseDir := extractfiledir(paramstr(0))+pathdelim; - {$ENDIF} - //if not DirectoryExists(extractfiledir(lBaseDir)) then - //mkDir(extractfiledir(lBaseDir)); - if lSubFolder <> '' then begin - lBaseDir := lBaseDir + lSubFolder; - if not DirectoryExists(lBaseDir) then begin - {$I-} - MkDir(lBaseDir); - if IOResult <> 0 then begin - showmessage('Unable to create new folder '+lBaseDir); - end; - {$I+} - end; - result := lBaseDir + pathdelim; - end else - result := lBaseDir; -end; *) - -function Swap2(s : SmallInt): smallint; -type - swaptype = packed record - case byte of - 0:(Word1 : word); //word is 16 bit - 1:(Small1: SmallInt); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word1); - result :=outguy.Small1; -end; - -{$IFDEF GUI} -procedure ShowMsg(s: string); -begin - showmessage(s); -end; -{$ENDIF} -procedure fx (a: double); overload; //fx used to help debugging - reports number values -begin - ShowMsg(floattostr(a)); -end; - -procedure fx (a,b: double); overload; //fx used to help debugging - reports number values -begin - ShowMsg(floattostr(a)+'x'+floattostr(b)); -end; - -procedure fx (a,b,c: double); overload; //fx used to help debugging - reports number values -begin - ShowMsg(floattostr(a)+'x'+floattostr(b)+'x'+floattostr(c)); -end; - -procedure fx (a,b,c,d: double); overload; //fx used to help debugging - reports number values -begin - ShowMsg(floattostr(a)+'x'+floattostr(b)+'x'+floattostr(c)+'x'+floattostr(d)); -end; - -procedure CopyFileEXoverwrite (lInName,lOutName: string); -var lFSize: Integer; - lBuff: bytep0; - lFData: file; -begin - lFSize := FSize(lInName); - if (lFSize < 1) then exit; - assignfile(lFdata,lInName); - filemode := 0; - reset(lFdata,lFSize{1}); - GetMem( lBuff, lFSize); - BlockRead(lFdata, lBuff^, 1{lFSize}); - closefile(lFdata); - assignfile(lFdata,lOutName); - filemode := 2; - Rewrite(lFdata,lFSize); - BlockWrite(lFdata,lBuff^, 1 {, NumWritten}); - closefile(lFdata); - freemem(lBuff); -end; - -procedure CopyFileEX (lInName,lOutName: string); -var lFSize: Integer; -begin - lFSize := FSize(lInName); - if (lFSize < 1) or (fileexistsEX(lOutName)) then exit; - CopyFileEXoverwrite (lInName,lOutName); -end; - -function IniInt(lIniFile: TIniFile; lIdent: string; lDefault: integer): integer; -var - lStr: string; -begin - result := lDefault; - lStr := lIniFile.ReadString('INT',lIdent, ''); - if length(lStr) > 0 then - result := StrToInt(lStr); -end; //proc IniInt - -function IniBool(var lIniFile: TIniFile; lIdent: string; lDefault: boolean): boolean; -var - lStr: string; -begin - result := lDefault; - lStr := lIniFile.ReadString('BOOL',lIdent, ''); - //showmessage('x'+lStr+'x'); - if length(lStr) > 0 then - result := Char2Bool(lStr[1]); -end; //nested IniBool - - -procedure SortInteger(var lLo,lHi: integer); -var lSwap: integer; -begin - if lLo > lHi then begin - lSwap := lLo; - lLo := lHi; - lHi := lSwap; - end; //if Lo>Hi -end; //proc SortSingle - -procedure SortSingle(var lLo,lHi: single); -var lSwap: single; -begin - if lLo > lHi then begin - lSwap := lLo; - lLo := lHi; - lHi := lSwap; - end; //if Lo>Hi -end; //proc SortSingle - -{$IFDEF FPC} - {$IFDEF UNIX} //FPC and Unix - function DiskFreeEx (DriveStr: String): Int64; - var - lOutDisk: Integer; - begin - - lOutDisk := AddDisk(DriveStr); - result := DiskFree(lOutDisk); - if result < 0 then - result := 9223372036854775807; - end; - {$ELSE} //FPC and Windows - function DiskFreeEx (DriveStr: String): Int64; - var - lOutDisk: Integer; - begin - lOutDisk := ord(upcase(DriveStr[1]))+1-ord('A'); - if (lOutDisk >= 0) and (lOutDisk <= 26) then - result := DiskFree(lOutDisk) - else - result := 0; - //showmessage(DriveStr+'->*'+inttostr(lOutDisk)+'* :'+inttostr(result)); - //showmessage(inttostr(DiskFree(0){current drive})+' :'+inttostr(DiskFree(3) {C drive})); - end; - {$ENDIF} -{$ELSE} //Delphi Windows - -function DiskFreeEx (DriveStr: String): Integer; -var - lOutDisk: Integer; - lDiskDir : string; - lSize8: Tinteger8; -begin - lOutDisk := ord(upcase(DriveStr[1]))+1-ord('A'); - if (lOutDisk >= ord('A')) and (lOutDisk <= ord('Z')) then begin - DiskFreeEx := DiskFree(lOutDisk); - end else begin - lDiskDir :=(ExtractFileDrive(DriveStr))+'\'; - lSize8 := DiskFreeStr (lDiskDir); - if lSize8 > MaxINt then DiskFreeEx := MaxInt - else DiskFreeEx := round(lSize8); - end; -end; - {$ENDIF} - -function Log(X, Base: single): single; -begin - if X = 0 then - result := 0 - else - Log := Ln(X) / Ln(Base); -end; - -function Bool2Char (lBool: boolean): char; -begin - if lBool then - result := '1' - else - result := '0'; -end; - -function Char2Bool (lChar: char): boolean; -begin - if lChar = '1' then - result := true - else - result := false; -end; - -procedure Xswap4r ( var s:single); -type - swaptype = packed record - case byte of - 0:(Word1,Word2 : word); //word is 16 bit - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word2); - outguy.Word2 := swap(inguy^.Word1); - inguy^.Word1 := outguy.Word1; - inguy^.Word2 := outguy.Word2; -end; - -procedure swap4(var s : LongInt); -type - swaptype = packed record - case byte of - 0:(Word1,Word2 : word); //word is 16 bit - 1:(Long:LongInt); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word2); - outguy.Word2 := swap(inguy^.Word1); - s:=outguy.Long; -end; - -function UpCaseExt(lFileName: string): string; -var lI: integer; -l2ndExt,lExt : string; -begin - lExt := ExtractFileExt(lFileName); - if length(lExt) > 0 then - for lI := 1 to length(lExt) do - lExt[lI] := upcase(lExt[lI]); - result := lExt; - if lExt <> '.GZ' then exit; - lI := length(lFileName) - 6; - if li < 1 then exit; - l2ndExt := upcase(lFileName[lI])+upcase(lFileName[lI+1])+upcase(lFileName[li+2])+upcase(lFileName[li+3]); - if (l2ndExt = '.NII')then - result := l2ndExt+lExt - else if (l2ndExt = 'BRIK') and (lI > 1) and (lFileName[lI-1] = '.') then - result := '.BRIK'+lExt; -end; - -function ExtGZ (lFilename: string): boolean; -var - lI: integer; - lExt : string; -begin - lExt := ExtractFileExt(lFileName); - if length(lExt) > 0 then - for lI := 1 to length(lExt) do - lExt[lI] := upcase(lExt[lI]); - if lExt = '.GZ' then - result := true - else - result := false; -end; - -function RealToStr(lR: double {was extended}; lDec: integer): string; -begin - RealTOStr := FloatToStrF(lR, ffFixed,7,lDec); -end; - -FUNCTION specialdouble (d:double): boolean; -//returns true if s is Infinity, NAN or Indeterminate -//8byte IEEE: msb[63] = signbit, bits[52-62] exponent, bits[0..51] mantissa -//exponent of all 1s = Infinity, NAN or Indeterminate -CONST kSpecialExponent = 2047 shl 20; -VAR Overlay: ARRAY[1..2] OF LongInt ABSOLUTE d; -BEGIN - IF ((Overlay[2] AND kSpecialExponent) = kSpecialExponent) THEN - RESULT := true - ELSE - RESULT := false; -END; - -function swap8r(s : double):double; -type - swaptype = packed record - case byte of - 0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit - 1:(float:double); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word4); - outguy.Word2 := swap(inguy^.Word3); - outguy.Word3 := swap(inguy^.Word2); - outguy.Word4 := swap(inguy^.Word1); - try - result:=outguy.float; - except - result := 0; - exit; - end; -end; //func swap8r - -procedure pswap4i(var s : LongInt); -type - swaptype = packed record - case byte of - 0:(Word1,Word2 : word); //word is 16 bit - 1:(Long:LongInt); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word2); - outguy.Word2 := swap(inguy^.Word1); - s:=outguy.Long; -end; //proc swap4 - -function swap64r(s : double):double; -type - swaptype = packed record - case byte of - 0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit - 1:(float:double); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word4); - outguy.Word2 := swap(inguy^.Word3); - outguy.Word3 := swap(inguy^.Word2); - outguy.Word4 := swap(inguy^.Word1); - try - swap64r:=outguy.float; - except - swap64r := 0; - exit; - end;{} -end; - -procedure pswap4r ( var s:single); -type - swaptype = packed record - case byte of - 0:(Word1,Word2 : word); //word is 16 bit - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word2); - outguy.Word2 := swap(inguy^.Word1); - inguy^.Word1 := outguy.Word1; - inguy^.Word2 := outguy.Word2; -end; //proc Xswap4r - -function conv4r4ui (s:single): uint32; -type - swaptype = packed record - case byte of - 1:(long:uint32); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; -begin - inguy := @s; //assign address of s to inguy - result := inguy^.long; -end; //conv4r4ui - -function swap4r4ui (s:single): uint32; -type - swaptype = packed record - case byte of - 0:(Word1,Word2 : word); //word is 16 bit - 1:(long:uint32); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word2); - outguy.Word2 := swap(inguy^.Word1); - result := outguy.long; -end;//swap4r4ui - -function conv4r4i (s:single): longint; -type - swaptype = packed record - case byte of - 1:(long:longint); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; -begin - inguy := @s; //assign address of s to inguy - conv4r4i:=inguy^.long; -end; - -function swap4r4i (s:single): longint; -type - swaptype = packed record - case byte of - 0:(Word1,Word2 : word); //word is 16 bit - 1:(long:longint); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word2); - outguy.Word2 := swap(inguy^.Word1); - swap4r4i:=outguy.long; -end;//swap4r4i - -(*function ChangeFileExtX( var lFilename: string; lExt: string): string; -begin - result := ChangeFileExt(lFilename,lExt); -end; *) - -function ChangeFileExtX(var lFilename: string; lExt: string): string;// overload; -//sees .nii.gz as single extension -var - lPath,lName,lOrigExt: string; -begin - if FilenameParts (lFilename, lPath,lName,lOrigExt) then begin - //showmessage('12222'+lPath +'**'+lName+'**'+lOrigExt); - result := lPath+lName+lExt; - end else begin - //showmessage('z'); - result := ChangeFileExt(lFilename,lExt); - end; -end; - -function PadStr (lValIn, lPadLenIn: integer): string; -var lOrigLen,lPad : integer; -begin - lOrigLen := length(inttostr(lValIn)); - result := inttostr(lValIn); - if lOrigLen < lPadLenIn then begin - lOrigLen := lPadLenIn-lOrigLen; - for lPad := 1 to lOrigLen do - result := '0'+result; - end; -end; - -function ExtractFileDirWithPathDelim(lInFilename: string): string; -//F:\filename.ext -> 'F:\' and F:\dir\filename.ext -> 'F:\dir\' -//Despite documentation, Delphi3's ExtractFileDir does not always retain final pathdelim -var lFilePath: string; -begin - result := ''; - if DirExists(lInFilename) then - lFilePath := lInFilename - else - lFilePath := ExtractFileDir(lInFilename); - if length(lFilepath) < 1 then exit; - if lFilePath[length(lFilepath)] <> pathdelim then - lFilepath := lFilepath + pathdelim; //Delphi3 bug: sometimes forgets pathdelim - result := lFilepath; -end; - -function ParseFileFinalDir (lFileName:String): string; -var - lLen,lInc,lPos: integer; - lInName,lName: String; -begin - lInName := extractfiledir(lFilename); - lName := ''; - lLen := length(lInName); - if lLen < 1 then exit; - lInc := lLen; - repeat - dec(lInc); - until (lInName[lInc] = pathdelim) or (lInc = 1); - if lInName[lInc] = pathdelim then inc(lInc); //if '\folder' then return 'folder' - for lPos := lInc to lLen do - lName := lName + lInName[lPos]; - ParseFileFinalDir := lName; -end; - -function ParseFileName (lFilewExt:String): string; -var - lExt: string; - i: integer; -begin - lExt := UpCaseExt(lFilewExt); - if (length(lExt) < 1) or (length(lExt) >= length(lFilewExt)) then exit; - result := ''; - for i := 1 to (length(lFilewExt)-length(lExt)) do - result := result + lFilewExt[i]; -end; - -(*function ParseFileName (lFilewExt:String): string; -var - lLen,lInc: integer; - lName: String; -begin - lName := ''; - lLen := length(lFilewExt); - lInc := lLen+1; - if lLen > 0 then begin - repeat - dec(lInc); - until (lFileWExt[lInc] = '.') or (lInc = 1); - if (UpCaseExt(lFilewExt) = '.NII.GZ') and (lInc > 1) then - repeat - dec(lInc); - until (lFileWExt[lInc] = '.') or (lInc = 1); - end; - if lInc > 1 then - for lLen := 1 to (lInc - 1) do - lName := lName + lFileWExt[lLen] - else - lName := lFilewExt; //no extension - ParseFileName := lName; -end; *) - -Function {TMainForm.}FileExistsEX(Name: String): Boolean; -var - F: File; -begin - result := false; - if Name = '' then - exit; - result := FileExists(Name); - if result then exit; - //the next bit attempts to check for a file to avoid WinNT bug - AssignFile(F, Name); - {$I-} - Reset(F); - {$I+} - Result:=IOresult = 0; - if Result then - CloseFile(F); -end; - -function FSize (lFName: String): Int64; -var SearchRec: TSearchRec; -begin - result := 0; - if not fileexistsex(lFName) then exit; - FindFirst(lFName, faAnyFile, SearchRec); - result := SearchRec.size; - FindClose(SearchRec); -end; - -procedure Xswap8r(var s : double); -type - swaptype = packed record - case byte of - 0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit - //1:(float:double); - end; - swaptypep = ^swaptype; -var - inguy:swaptypep; - outguy:swaptype; -begin - inguy := @s; //assign address of s to inguy - outguy.Word1 := swap(inguy^.Word4); - outguy.Word2 := swap(inguy^.Word3); - outguy.Word3 := swap(inguy^.Word2); - outguy.Word4 := swap(inguy^.Word1); - inguy^.Word1 := outguy.Word1; - inguy^.Word2 := outguy.Word2; - inguy^.Word3 := outguy.Word3; - inguy^.Word4 := outguy.Word4; -end; - -FUNCTION specialsingle (var s:single): boolean; -//returns true if s is Infinity, NAN or Indeterminate -//4byte IEEE: msb[31] = signbit, bits[23-30] exponent, bits[0..22] mantissa -//exponent of all 1s = Infinity, NAN or Indeterminate -CONST kSpecialExponent = 255 shl 23; -VAR Overlay: LongInt ABSOLUTE s; -BEGIN - IF ((Overlay AND kSpecialExponent) = kSpecialExponent) THEN - RESULT := true - ELSE - RESULT := false; -END; - -end. diff --git a/common/backup/nifti_hdr.pas.bak b/common/backup/nifti_hdr.pas.bak deleted file mode 100755 index 81a78ec..0000000 --- a/common/backup/nifti_hdr.pas.bak +++ /dev/null @@ -1,1279 +0,0 @@ -unit nifti_hdr; -interface -{$H+} -{$Include isgui.inc} -{$MODE DELPHI} -uses -{$IFNDEF FPC} - DiskSpaceKludge,gziod, -{$ELSE} - gzio2, -{$ENDIF} -{$IFNDEF Unix} Windows, {$ENDIF} -define_types,SysUtils,GraphicsMathLibrary, nifti_types, nifti_foreign, - dialogsx; - -type - - TAnalyzeHdrSection = packed record //Next: analyze Format Header structure - Pad: array [1..253] of byte; - originator: array [1..5] of smallint; - end;//TAnalyzeHdrSection Structure - - TMRIcroHdr = record //Next: analyze Format Header structure - NIFTIhdr : TNIFTIhdr; - AutoBalMinUnscaled,AutoBalMaxUnscaled - ,WindowScaledMin,WindowScaledMax - ,GlMinUnscaledS,GlMaxUnscaledS,Zero8Bit,Slope8bit: single; //brightness and contrast - NIfTItransform,DiskDataNativeEndian,UsesCustomPalette,UsesCustomPaletteRandomRainbow,UsesLabels,LutFromZero: boolean; - HdrFileName,ImgFileName: string; - //ECodeText: string; - gzBytesX: int64; - NIFTIVersion,LUTindex,ScrnBufferItems,ImgBufferItems,RenderBufferItems,ImgBufferBPP,RenderDim,Index: longint; - ImgBufferUnaligned: Pointer; //raw address of Image Buffer: address may not be aligned - ScrnBuffer,ImgBuffer,RenderBuffer: Bytep; - LUTinvisible: TRGBQuad;//DWord; - LUT: TLUT;//array[0..255] of TRGBQuad; - Mat: TMatrix; - end; //TNIFTIhdr Header Structure - - - function IsVOIROIExt (var lFName: string):boolean; - function ComputeImageDataBytes (var lHdr: TMRIcroHdr): longint; //size of image data in bytes - function ComputeImageDataBytes8bpp (var lHdr: TMRIcroHdr): longint; //size of image as 32-bit per voxel data in bytes - function ComputeImageDataBytes32bpp (var lHdr: TMRIcroHdr): longint; //size of image as 32-bit per voxel data in bytes - procedure NIFTIhdr_SwapBytes (var lAHdr: TNIFTIhdr); //Swap Byte order for the Analyze type - procedure NIFTIhdr_ClearHdr (var lHdr: TMRIcroHdr); //set all values of header to something reasonable - function NIFTIhdr_LoadHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean; - function NIFTIhdr_SaveHdr (var lFilename: string; var lHdr: TMRIcroHdr; lAllowOverwrite: boolean): boolean; overload; - function NIFTIhdr_SaveHdr (var lFilename: string; var lHdr: TNIFTIHdr; lAllowOverwrite,lSPM2: boolean): boolean; overload; - procedure NIFTIhdr_SetIdentityMatrix (var lHdr: TMRIcroHdr); //create neutral rotation matrix - function IsNIfTIHdrExt (var lFName: string):boolean; //1494 - function IsNifTiMagic (var lHdr: TNIFTIhdr): boolean; - //procedure NearestOrtho(var lHdr: TMRIcroHdr); -//function nifti_mat44_orthog( lR :TMatrix; lImm,lJmm,lKmm: double): TMatrix; - - function CopyNiftiHdr (var lInHdr,lOutHdr: TNIFTIhdr): boolean; - procedure WriteNiftiMatrix (var lHdr: TNIFTIhdr; - m11,m12,m13,m14, - m21,m22,m23,m24, - m31,m32,m33,m34: Single); - procedure nifti_mat44_to_quatern( lR :TMatrix; - var qb, qc, qd, - qx, qy, qz, - dx, dy, dz, qfac : single); - - -implementation -uses -{$IFDEF GUI} dialogs,{$ENDIF} -dicomhdr;//2/2208 - -function CopyNiftiHdr (var lInHdr,lOutHdr: TNIFTIhdr): boolean; -begin - move(lInHdr,lOutHdr,sizeof(TNIFTIhdr)); - result := true; -end; - -procedure WriteNiftiMatrix (var lHdr: TNIFTIhdr; - m11,m12,m13,m14, - m21,m22,m23,m24, - m31,m32,m33,m34: Single); -begin - with lHdr do begin - srow_x[0] := m11; - srow_x[1] := m12; - srow_x[2] := m13; - srow_x[3] := m14; - srow_y[0] := m21; - srow_y[1] := m22; - srow_y[2] := m23; - srow_y[3] := m24; - srow_z[0] := m31; - srow_z[1] := m32; - srow_z[2] := m33; - srow_z[3] := m34; - end; //with lHdr -end; - -function IsNifTi1Magic (var lHdr: TNIFTIhdr): boolean; -begin - if (lHdr.magic =kNIFTI_MAGIC_SEPARATE_HDR) or (lHdr.Magic = kNIFTI_MAGIC_EMBEDDED_HDR ) then - result := true - else - result :=false; //analyze -end; - -function IsNifTiMagic (var lHdr: TNIFTIhdr): boolean; -begin - if (IsNifTi1Magic(lHdr)) then - result := true - else - result :=false; //analyze -end; - -function IsNIfTIHdrExt (var lFName: string):boolean; -var - lExt: string; -begin - lExt := UpCaseExt(lFName); - if (lExt='.NII') or (lExt = '.HDR') or (lExt = '.NII.GZ') or (lExt = '.VOI') then - result := true - else - result := false; -end; - -function IsVOIROIExt (var lFName: string):boolean; -var - lExt: string; -begin - lExt := UpCaseExt(lFName); - if (lExt = '.VOI') or (lExt = '.ROI') then - result := true - else - result := false; -end; - -function ComputeImageDataBytes32bpp (var lHdr: TMRIcroHdr): integer; -var - lDim, lBytes : integer; -begin - result := 0; - with lHdr.NIFTIhdr do begin - if Dim[0] < 1 then begin - ShowMsg('NIFTI format error: datasets must have at least one dimension (dim[0] < 1).'); - exit; - end; - lBytes := 4; //bits per voxel - for lDim := 1 to 3 {Dim[0]} do - lBytes := lBytes * Dim[lDim]; - end; //with niftihdr - result := lBytes; //+7 to ensure binary data not clipped -end; //func ComputeImageDataBytes32bpp - -function ComputeImageDataBytes8bpp (var lHdr: TMRIcroHdr): integer; -var - lDim, lBytes: integer; -begin - result := 0; - with lHdr.NIFTIhdr do begin - if Dim[0] < 1 then begin - ShowMsg('NIFTI format error: datasets must have at least one dimension (dim[0] < 1).'); - exit; - end; - lBytes := 1; //bits per voxel - for lDim := 1 to 3 {Dim[0]} do - lBytes := lBytes * Dim[lDim]; - end; //with niftihdr - result := lBytes; //+7 to ensure binary data not clipped -end; //func ComputeImageDataBytes8bpp - -function ComputeImageDataBytes (var lHdr: TMRIcroHdr): integer; -var - lDim : integer; - lSzInBits : Int64; -begin - result := 0; - with lHdr.NIFTIhdr do begin - if Dim[0] < 1 then begin - ShowMsg('NIFTI format error: datasets must have at least one dimension (dim[0] < 1).'); - exit; - end; - lSzInBits := bitpix; //bits per voxel - //showmessage(inttostr(Dim[0])); - for lDim := 1 to 3 {Dim[0]} do - lSzInBits := lSzInBits * Dim[lDim]; - end; //with niftihdr - result := (lSzInBits + 7) div 8; //+7 to ensure binary data not clipped -end; //func ComputeImageDataBytes -function orthogonalMatrix(var lHdr: TMRIcroHdr): boolean; -var - lM: TMatrix; - lRow,lCol,lN0: integer; -begin - result := false; - lM := Matrix3D ( - lHdr.NIFTIhdr.srow_x[0],lHdr.NIFTIhdr.srow_x[1],lHdr.NIFTIhdr.srow_x[2],lHdr.NIFTIhdr.srow_x[3], // 3D "graphics" matrix - lHdr.NIFTIhdr.srow_y[0],lHdr.NIFTIhdr.srow_y[1],lHdr.NIFTIhdr.srow_y[2],lHdr.NIFTIhdr.srow_y[3], // 3D "graphics" matrix - lHdr.NIFTIhdr.srow_z[0],lHdr.NIFTIhdr.srow_z[1],lHdr.NIFTIhdr.srow_z[2],lHdr.NIFTIhdr.srow_z[3], // 3D "graphics" matrix - 0,0,0,1); - for lRow := 1 to 3 do begin - lN0 := 0; - for lCol := 1 to 3 do - if lM.matrix[lRow,lCol] = 0 then - inc(lN0); - if lN0 <> 2 then exit; //exactly two values are zero - end; - for lCol := 1 to 3 do begin - lN0 := 0; - for lRow := 1 to 3 do - if lM.matrix[lRow,lCol] = 0 then - inc(lN0); - if lN0 <> 2 then exit; //exactly two values are zero - end; - result := true; -end; - -function EmptyRow (lRow: integer; var lM: TMatrix): boolean; -begin - //fx(lM.matrix[lRow,1],lM.matrix[lRow,2],lM.matrix[lRow,3]); - if (abs(lM.matrix[lRow,1]) < 0.00000001) and (abs(lM.matrix[lRow,2]) < 0.00000001) and (abs(lM.matrix[lRow,3]) < 0.00000001) then - result := true - else - result := false; -end; - -procedure ReportMatrix (lStr: string;lM:TMatrix); -begin - ShowMsg(lStr+kCR+ - RealToStr(lM.matrix[1,1],6)+','+RealToStr(lM.matrix[1,2],6)+','+RealToStr(lM.matrix[1,3],6)+','+RealToStr(lM.matrix[1,4],6)+ - kCR+RealToStr(lM.matrix[2,1],6)+','+RealToStr(lM.matrix[2,2],6)+','+RealToStr(lM.matrix[2,3],6)+','+RealToStr(lM.matrix[2,4],6)+ - kCR+RealToStr(lM.matrix[3,1],6)+','+RealToStr(lM.matrix[3,2],6)+','+RealToStr(lM.matrix[3,3],6)+','+RealToStr(lM.matrix[3,4],6)+ - kCR+RealToStr(lM.matrix[4,1],6)+','+RealToStr(lM.matrix[4,2],6)+','+RealToStr(lM.matrix[4,3],6)+','+RealToStr(lM.matrix[4,4],6)); -end; - -procedure nifti_quatern_to_mat44( var lR :TMatrix; - var qb, qc, qd, - qx, qy, qz, - dx, dy, dz, qfac : single); -var - a,b,c,d,xd,yd,zd: double; -begin - //a := qb; - b := qb; - c := qc; - d := qd; - //* last row is always [ 0 0 0 1 ] */ - lR.matrix[4,1] := 0; - lR.matrix[4,2] := 0; - lR.matrix[4,3] := 0; - lR.matrix[4,4] := 1; - //* compute a parameter from b,c,d */ - a := 1.0 - (b*b + c*c + d*d) ; - if( a < 1.e-7 ) then begin//* special case */ - a := 1.0 / sqrt(b*b+c*c+d*d) ; - b := b*a ; c := c*a ; d := d*a ;//* normalize (b,c,d) vector */ - a := 0.0 ;//* a = 0 ==> 180 degree rotation */ - end else begin - a := sqrt(a) ; //* angle = 2*arccos(a) */ - end; - //* load rotation matrix, including scaling factors for voxel sizes */ - if dx > 0 then - xd := dx - else - xd := 1; - if dy > 0 then - yd := dy - else - yd := 1; - if dz > 0 then - zd := dz - else - zd := 1; - if( qfac < 0.0 ) then zd := -zd ;//* left handedness? */ - lR.matrix[1,1]:= (a*a+b*b-c*c-d*d) * xd ; - lR.matrix[1,2]:= 2.0 * (b*c-a*d ) * yd ; - lR.matrix[1,3]:= 2.0 * (b*d+a*c ) * zd ; - lR.matrix[2,1]:= 2.0 * (b*c+a*d ) * xd ; - lR.matrix[2,2]:= (a*a+c*c-b*b-d*d) * yd ; - lR.matrix[2,3]:= 2.0 * (c*d-a*b ) * zd ; - lR.matrix[3,1]:= 2.0 * (b*d-a*c ) * xd ; - lR.matrix[3,2]:= 2.0 * (c*d+a*b ) * yd ; - lR.matrix[3,3]:= (a*a+d*d-c*c-b*b) * zd ; - //* load offsets */ - lR.matrix[1,4]:= qx ; - lR.matrix[2,4]:= qy ; - lR.matrix[3,4]:= qz ; - -end; - -function TryQuat2Matrix( var lHdr: TNIfTIHdr; isForce: boolean = false ): boolean; -var lR :TMatrix; -begin - - result := false; - if (not isForce) then begin - if (lHdr.qform_code <= kNIFTI_XFORM_UNKNOWN) or (lHdr.qform_code > kNIFTI_XFORM_MNI_152) then - exit; - - end; - result := true; - nifti_quatern_to_mat44(lR,lHdr.quatern_b,lHdr.quatern_c,lHdr.quatern_d, - lHdr.qoffset_x,lHdr.qoffset_y,lHdr.qoffset_z, - lHdr.pixdim[1],lHdr.pixdim[2],lHdr.pixdim[3], - lHdr.pixdim[0]); - lHdr.srow_x[0] := lR.matrix[1,1]; - lHdr.srow_x[1] := lR.matrix[1,2]; - lHdr.srow_x[2] := lR.matrix[1,3]; - lHdr.srow_x[3] := lR.matrix[1,4]; - lHdr.srow_y[0] := lR.matrix[2,1]; - lHdr.srow_y[1] := lR.matrix[2,2]; - lHdr.srow_y[2] := lR.matrix[2,3]; - lHdr.srow_y[3] := lR.matrix[2,4]; - lHdr.srow_z[0] := lR.matrix[3,1]; - lHdr.srow_z[1] := lR.matrix[3,2]; - lHdr.srow_z[2] := lR.matrix[3,3]; - lHdr.srow_z[3] := lR.matrix[3,4]; - lHdr.sform_code := 1; -end; - -function EmptyMatrix(var lHdr: TMRIcroHdr): boolean; -var - lM: TMatrix; - lRow,lCol: integer; - isUseQForm : boolean = false; -begin - result := false; - - - lM := Matrix3D ( - lHdr.NIFTIhdr.srow_x[0],lHdr.NIFTIhdr.srow_x[1],lHdr.NIFTIhdr.srow_x[2],lHdr.NIFTIhdr.srow_x[3], // 3D "graphics" matrix - lHdr.NIFTIhdr.srow_y[0],lHdr.NIFTIhdr.srow_y[1],lHdr.NIFTIhdr.srow_y[2],lHdr.NIFTIhdr.srow_y[3], // 3D "graphics" matrix - lHdr.NIFTIhdr.srow_z[0],lHdr.NIFTIhdr.srow_z[1],lHdr.NIFTIhdr.srow_z[2],lHdr.NIFTIhdr.srow_z[3], // 3D "graphics" matrix - 0,0,0,1); - if (lHdr.NIFTIhdr.sform_code <= kNIFTI_XFORM_UNKNOWN) and (lHdr.NIFTIhdr.qform_code > kNIFTI_XFORM_UNKNOWN) then - isUseQForm := true; - if EmptyRow(1,lM) or EmptyRow(2,lM) or EmptyRow(3,lM) then - isUseQForm := true; - if (isUseQForm) then begin - TryQuat2Matrix(lHdr,true); - lM := Matrix3D ( - lHdr.NIFTIhdr.srow_x[0],lHdr.NIFTIhdr.srow_x[1],lHdr.NIFTIhdr.srow_x[2],lHdr.NIFTIhdr.srow_x[3], // 3D "graphics" matrix - lHdr.NIFTIhdr.srow_y[0],lHdr.NIFTIhdr.srow_y[1],lHdr.NIFTIhdr.srow_y[2],lHdr.NIFTIhdr.srow_y[3], // 3D "graphics" matrix - lHdr.NIFTIhdr.srow_z[0],lHdr.NIFTIhdr.srow_z[1],lHdr.NIFTIhdr.srow_z[2],lHdr.NIFTIhdr.srow_z[3], // 3D "graphics" matrix - 0,0,0,1); - - end; - - if EmptyRow(1,lM) or EmptyRow(2,lM) or EmptyRow(3,lM) then begin - ReportMatrix('>Matrix appears bogus',lm); - end else begin - for lRow := 1 to 3 do begin {3/2008} - for lCol := 1 to 4 do begin - if (lRow = lCol) then begin - if lM.matrix[lRow,lCol] <> 1 then - exit; - end else begin - if lM.matrix[lRow,lCol] <> 0 then - exit; - end// unity matrix does not count - mriconvert creates bogus [1 0 0 0; 0 1 0 0; 0 0 1 0; 0 0 0 0] - end; //each col - end;//each row - end;//not bogus - result := true; -end; - - - -procedure FromMatrix (M: TMatrix; var m11,m12,m13, m21,m22,m23, - m31,m32,m33: DOUBLE) ; - BEGIN - m11 := M.Matrix[1,1]; - m12 := M.Matrix[1,2]; - m13 := M.Matrix[1,3]; - m21 := M.Matrix[2,1]; - m22 := M.Matrix[2,2]; - m23 := M.Matrix[2,3]; - m31 := M.Matrix[3,1]; - m32 := M.Matrix[3,2]; - m33 := M.Matrix[3,3]; -END {FromMatrix3D}; - - -function nifti_mat33_determ( R: TMatrix ):double; -begin - result := r.matrix[1,1]*r.matrix[2,2]*r.matrix[3,3] - -r.matrix[1,1]*r.matrix[3,2]*r.matrix[2,3] - -r.matrix[2,1]*r.matrix[1,2]*r.matrix[3,3] - +r.matrix[2,1]*r.matrix[3,2]*r.matrix[1,3] - +r.matrix[3,1]*r.matrix[1,2]*r.matrix[2,3] - -r.matrix[3,1]*r.matrix[2,2]*r.matrix[1,3] ; -end; - -procedure FixCrapMat(var lMat: TMatrix); -var - lVec000,lVec100,lVec010,lVec001: TVector; -begin - lVec000 := Vector3D (0, 0, 0); - lVec100 := Vector3D (1, 0, 0); - lVec010 := Vector3D (0, 1, 0); - lVec001 := Vector3D (0, 0, 1); - lVec000 := Transform (lVec000, lMat); - lVec100 := Transform (lVec100, lMat); - lVec010 := Transform (lVec010, lMat); - lVec001 := Transform (lVec001, lMat); - - if SameVec(lVec000,lVec100) or - SameVec(lVec000,lVec010) or - SameVec(lVec000,lVec001) then begin - lMat := eye3D; - ShowMsg('Warning: the transformation matrix is corrupt [some dimensions have zero size]'); - end; -end; - - -function nifti_mat33_rownorm( A: TMatrix ): single; //* max row norm of 3x3 matrix */ -var - r1,r2,r3: single ; -begin - r1 := abs(A.matrix[1,1])+abs(A.matrix[1,2])+abs(A.matrix[1,3]) ; - r2 := abs(A.matrix[2,1])+abs(A.matrix[2,2])+abs(A.matrix[2,3]) ; - r3 := abs(A.matrix[3,1])+abs(A.matrix[3,2])+abs(A.matrix[3,3]) ; - if( r1 < r2 ) then r1 := r2 ; - if( r1 < r3 ) then r1 := r3 ; - result := r1 ; -end; - -function nifti_mat33_colnorm( A: TMatrix ): single; //* max column norm of 3x3 matrix */ -var - r1,r2,r3: single ; -begin - r1 := abs(A.matrix[1,1])+abs(A.matrix[2,1])+abs(A.matrix[3,1]) ; - r2 := abs(A.matrix[1,2])+abs(A.matrix[2,2])+abs(A.matrix[3,2]) ; - r3 := abs(A.matrix[1,3])+abs(A.matrix[2,3])+abs(A.matrix[3,3]) ; - if( r1 < r2 ) then r1 := r2 ; - if( r1 < r3 ) then r1 := r3 ; - result := r1 ; -end; - -function nifti_mat33_inverse( R: TMatrix ): TMatrix; //* inverse of 3x3 matrix */ -var - r11,r12,r13,r21,r22,r23,r31,r32,r33 , deti: double ; - Q: TMatrix ; -begin - FromMatrix(R,r11,r12,r13,r21,r22,r23,r31,r32,r33); - deti := r11*r22*r33-r11*r32*r23-r21*r12*r33 - +r21*r32*r13+r31*r12*r23-r31*r22*r13 ; - - if( deti <> 0.0 ) then deti := 1.0 / deti ; - - Q.matrix[1,1] := deti*( r22*r33-r32*r23) ; - Q.matrix[1,2] := deti*(-r12*r33+r32*r13) ; - Q.matrix[1,3] := deti*( r12*r23-r22*r13) ; - - Q.matrix[2,1] := deti*(-r21*r33+r31*r23) ; - Q.matrix[2,2] := deti*( r11*r33-r31*r13) ; - Q.matrix[2,3] := deti*(-r11*r23+r21*r13) ; - - Q.matrix[3,1] := deti*( r21*r32-r31*r22) ; - Q.matrix[3,2] := deti*(-r11*r32+r31*r12) ; - Q.matrix[3,3] := deti*( r11*r22-r21*r12) ; - result := Q; -end; - -function nifti_mat33_polar( A: TMatrix ): TMatrix; -var - k:integer; - X , Y , Z: TMatrix ; - dif,alp,bet,gam,gmi : single; -begin -dif := 1; -k := 0; - X := A ; - // force matrix to be nonsingular - //reportmatrix('x',X); - gam := nifti_mat33_determ(X) ; - while( gam = 0.0 )do begin //perturb matrix - gam := 0.00001 * ( 0.001 + nifti_mat33_rownorm(X) ) ; - X.matrix[1,1] := X.matrix[1,1]+gam ; - X.matrix[2,2] := X.matrix[2,2]+gam ; - X.matrix[3,3] := X.matrix[3,3] +gam ; - gam := nifti_mat33_determ(X) ; - end; - - while true do begin - Y := nifti_mat33_inverse(X) ; - if( dif > 0.3 )then begin // far from convergence - alp := sqrt( nifti_mat33_rownorm(X) * nifti_mat33_colnorm(X) ) ; - bet := sqrt( nifti_mat33_rownorm(Y) * nifti_mat33_colnorm(Y) ) ; - gam := sqrt( bet / alp ) ; - gmi := 1.0 / gam ; - end else begin - gam := 1.0; - gmi := 1.0 ; //close to convergence - end; - Z.matrix[1,1] := 0.5 * ( gam*X.matrix[1,1] + gmi*Y.matrix[1,1] ) ; - Z.matrix[1,2] := 0.5 * ( gam*X.matrix[1,2] + gmi*Y.matrix[2,1] ) ; - Z.matrix[1,3] := 0.5 * ( gam*X.matrix[1,3] + gmi*Y.matrix[3,1] ) ; - Z.matrix[2,1] := 0.5 * ( gam*X.matrix[2,1] + gmi*Y.matrix[1,2] ) ; - Z.matrix[2,2] := 0.5 * ( gam*X.matrix[2,2] + gmi*Y.matrix[2,2] ) ; - Z.matrix[2,3] := 0.5 * ( gam*X.matrix[2,3] + gmi*Y.matrix[3,2] ) ; - Z.matrix[3,1] := 0.5 * ( gam*X.matrix[3,1] + gmi*Y.matrix[1,3] ) ; - Z.matrix[3,2] := 0.5 * ( gam*X.matrix[3,2] + gmi*Y.matrix[2,3] ) ; - Z.matrix[3,3] := 0.5 * ( gam*X.matrix[3,3] + gmi*Y.matrix[3,3] ) ; - - dif := abs(Z.matrix[1,1]-X.matrix[1,1])+abs(Z.matrix[1,2]-X.matrix[1,2]) - +abs(Z.matrix[1,3]-X.matrix[1,3])+abs(Z.matrix[2,1]-X.matrix[2,1]) - +abs(Z.matrix[2,2]-X.matrix[2,2])+abs(Z.matrix[2,3]-X.matrix[2,3]) - +abs(Z.matrix[3,1]-X.matrix[3,1])+abs(Z.matrix[3,2]-X.matrix[3,2]) - +abs(Z.matrix[3,3]-X.matrix[3,3]) ; - k := k+1 ; - if( k > 100) or (dif < 3.e-6 ) then begin - result := Z; - break ; //convergence or exhaustion - end; - X := Z ; - end; - result := Z ; -end; - - -procedure nifti_mat44_to_quatern( lR :TMatrix; - var qb, qc, qd, - qx, qy, qz, - dx, dy, dz, qfac : single); -var - r11,r12,r13 , r21,r22,r23 , r31,r32,r33, xd,yd,zd , a,b,c,d : double; - P,Q: TMatrix; //3x3 -begin - - - (* offset outputs are read write out of input matrix *) - qx := lR.matrix[1,4]; - qy := lR.matrix[2,4]; - qz := lR.matrix[3,4]; - - (* load 3x3 matrix into local variables *) - FromMatrix(lR,r11,r12,r13,r21,r22,r23,r31,r32,r33); - - (* compute lengths of each column; these determine grid spacings *) - - xd := sqrt( r11*r11 + r21*r21 + r31*r31 ) ; - yd := sqrt( r12*r12 + r22*r22 + r32*r32 ) ; - zd := sqrt( r13*r13 + r23*r23 + r33*r33 ) ; - - (* if a column length is zero, patch the trouble *) - - if( xd = 0.0 )then begin r11 := 1.0 ; r21 := 0; r31 := 0.0 ; xd := 1.0 ; end; - if( yd = 0.0 )then begin r22 := 1.0 ; r12 := 0; r32 := 0.0 ; yd := 1.0 ; end; - if( zd = 0.0 )then begin r33 := 1.0 ; r13 := 0; r23 := 0.0 ; zd := 1.0 ; end; - - (* assign the output lengths *) - dx := xd; - dy := yd; - dz := zd; - - (* normalize the columns *) - - r11 := r11/xd ; r21 := r21/xd ; r31 := r31/xd ; - r12 := r12/yd ; r22 := r22/yd ; r32 := r32/yd ; - r13 := r13/zd ; r23 := r23/zd ; r33 := r33/zd ; - - (* At this point, the matrix has normal columns, but we have to allow - for the fact that the hideous user may not have given us a matrix - with orthogonal columns. - - So, now find the orthogonal matrix closest to the current matrix. - - One reason for using the polar decomposition to get this - orthogonal matrix, rather than just directly orthogonalizing - the columns, is so that inputting the inverse matrix to R - will result in the inverse orthogonal matrix at this point. - If we just orthogonalized the columns, this wouldn't necessarily hold. *) - Q := Matrix2D (r11,r12,r13, // 2D "graphics" matrix - r21,r22,r23, - r31,r32,r33); - - - - P := nifti_mat33_polar(Q) ; (* P is orthog matrix closest to Q *) - FromMatrix(P,r11,r12,r13,r21,r22,r23,r31,r32,r33); - - //ReportMatrix('xxx',Q); - //ReportMatrix('svd',P); - (* [ r11 r12 r13 ] *) - (* at this point, the matrix [ r21 r22 r23 ] is orthogonal *) - (* [ r31 r32 r33 ] *) - - (* compute the determinant to determine if it is proper *) - - zd := r11*r22*r33-r11*r32*r23-r21*r12*r33 - +r21*r32*r13+r31*r12*r23-r31*r22*r13 ; (* should be -1 or 1 *) - - if( zd > 0 )then begin (* proper *) - qfac := 1.0 ; - end else begin (* improper ==> flip 3rd column *) - qfac := -1.0 ; - r13 := -r13 ; r23 := -r23 ; r33 := -r33 ; - end; - - (* now, compute quaternion parameters *) - - a := r11 + r22 + r33 + 1.0; - - if( a > 0.5 ) then begin (* simplest case *) - a := 0.5 * sqrt(a) ; - b := 0.25 * (r32-r23) / a ; - c := 0.25 * (r13-r31) / a ; - d := 0.25 * (r21-r12) / a ; - end else begin (* trickier case *) - xd := 1.0 + r11 - (r22+r33) ; (* 4*b*b *) - yd := 1.0 + r22 - (r11+r33) ; (* 4*c*c *) - zd := 1.0 + r33 - (r11+r22) ; (* 4*d*d *) - if( xd > 1.0 ) then begin - b := 0.5 * sqrt(xd) ; - c := 0.25* (r12+r21) / b ; - d := 0.25* (r13+r31) / b ; - a := 0.25* (r32-r23) / b ; - end else if( yd > 1.0 ) then begin - c := 0.5 * sqrt(yd) ; - b := 0.25* (r12+r21) / c ; - d := 0.25* (r23+r32) / c ; - a := 0.25* (r13-r31) / c ; - end else begin - d := 0.5 * sqrt(zd) ; - b := 0.25* (r13+r31) / d ; - c := 0.25* (r23+r32) / d ; - a := 0.25* (r21-r12) / d ; - end; - if( a < 0.0 )then begin b:=-b ; c:=-c ; d:=-d; {a:=-a; this is not used} end; - end; - - qb := b ; - qc := c ; - qd := d ; - //fx(qb,qc,qd); -end; - - - -{procedure ReportMatrix (lM:TMatrix); -var lStr: string; -begin - - lStr := ( RealToStr(lM.matrix[1,1],6)+','+RealToStr(lM.matrix[1,2],6)+','+RealToStr(lM.matrix[1,3],6)+','+RealToStr(lM.matrix[1,4],6)) - +kCR+( RealToStr(lM.matrix[2,1],6)+','+RealToStr(lM.matrix[2,2],6)+','+RealToStr(lM.matrix[2,3],6)+','+RealToStr(lM.matrix[2,4],6)) - +kCR+( RealToStr(lM.matrix[3,1],6)+','+RealToStr(lM.matrix[3,2],6)+','+RealToStr(lM.matrix[3,3],6)+','+RealToStr(lM.matrix[3,4],6)) - +kCR+( RealToStr(lM.matrix[4,1],6)+','+RealToStr(lM.matrix[4,2],6)+','+RealToStr(lM.matrix[4,3],6)+','+RealToStr(lM.matrix[4,4],6)); -showmessage(lStr); -end; } - -function cleanChar(ch: char): char; -begin - result := ch; - if (ord(ch) <> 0) and ((ord(ch) < ord(' ')) or (ord(ch) in [127,129,130])) then //or (ord(ch) > 135) then - result := '_'; -end; - -procedure FixBadStrs (var lHdr: TNIFTIhdr); -var - lInc: integer; //chr(0) -begin - for lInc := 1 to 80 do - lHdr.descrip[lInc] := cleanChar(lHdr.descrip[lInc]);{80 spaces} - for lInc := 1 to 24 do - lHdr.aux_file[lInc] := cleanChar(lHdr.aux_file[lInc]);{24 spaces} - for lInc := 1 to 10 do - lHdr.Data_Type[lInc] := cleanChar(lHdr.Data_Type[lInc]); - for lInc := 1 to 18 do - lHdr.db_name[lInc] := cleanChar(lHdr.db_name[lInc]); - for lInc := 1 to 16 do - lHdr.intent_name[lInc] := cleanChar(lHdr.intent_name[lInc]); - -end; - -function FixDataType (var lHdr: TMRIcroHdr ): boolean; -//correct mistakes of datatype and bitpix - especially for software which only sets one -label - 191; -var - ldatatypebpp,lbitpix: integer; -begin - result := true; - lbitpix := lHdr.NIFTIhdr.bitpix; - case lHdr.NIFTIhdr.datatype of - kDT_BINARY : ldatatypebpp := 1; - kDT_UNSIGNED_CHAR : ldatatypebpp := 8; // unsigned char (8 bits/voxel) - kDT_SIGNED_SHORT : ldatatypebpp := 16; // signed short (16 bits/voxel) - kDT_SIGNED_INT : ldatatypebpp := 32; // signed int (32 bits/voxel) - kDT_FLOAT : ldatatypebpp := 32; // float (32 bits/voxel) - kDT_COMPLEX : ldatatypebpp := 64; // complex (64 bits/voxel) - kDT_DOUBLE : ldatatypebpp := 64; // double (64 bits/voxel) - kDT_RGB : ldatatypebpp := 24; // RGB triple (24 bits/voxel) - kDT_INT8 : ldatatypebpp := 8; // signed char (8 bits) - kDT_UINT16 : ldatatypebpp := 16; // unsigned short (16 bits) - kDT_UINT32 : ldatatypebpp := 32; // unsigned int (32 bits) - kDT_INT64 : ldatatypebpp := 64; // long long (64 bits) - kDT_UINT64 : ldatatypebpp := 64; // unsigned long long (64 bits) - kDT_FLOAT128 : ldatatypebpp := 128; // long double (128 bits) - kDT_COMPLEX128 : ldatatypebpp := 128; // double pair (128 bits) - kDT_COMPLEX256 : ldatatypebpp := 256; // long double pair (256 bits) - else - ldatatypebpp := 0; - end; - if (ldatatypebpp = lHdr.NIFTIhdr.bitpix) and (ldatatypebpp <> 0) then - exit; - if (ldatatypebpp <> 0) then begin - //use bitpix from datatype... - //showmessage(inttostr(lHdr.NIFTIhdr.datatype) +' '+inttostr(ldatatypebpp)+' '+inttostr(lbitpix)); - lHdr.NIFTIhdr.bitpix := ldatatypebpp; - exit; - end; - - if (lbitpix <> 0) and (ldatatypebpp = 0) then begin - //assume bitpix is correct.... - //note that several datatypes correspond to each bitpix, so assume most popular... - case lbitpix of - 1: lHdr.NIFTIhdr.datatype := kDT_BINARY; - 8: lHdr.NIFTIhdr.datatype := kDT_UNSIGNED_CHAR; - 16: lHdr.NIFTIhdr.datatype := kDT_SIGNED_SHORT; - 24: lHdr.NIFTIhdr.datatype := kDT_RGB; - 32: lHdr.NIFTIhdr.datatype := kDT_FLOAT; - 64: lHdr.NIFTIhdr.datatype := kDT_DOUBLE; - else goto 191; //impossible bitpix - end; - exit; - end; -191: - //Both bitpix and datatype are wrong... assume most popular format - lHdr.NIFTIhdr.bitpix := 16; - lHdr.NIFTIhdr.datatype := kDT_SIGNED_SHORT; - //fx(lHdr.NIFTIhdr.bitpix, lHdr.NIFTIhdr.datatype); -end; - -(*procedure ReadEcode(var lHdr: TMRIcroHdr); -warning: this code will need better initial detection that an ecode is present, e.g. reading bytes 349 and 350 -var - extension : array[0..3] of byte; - myFile : File; - esize , ecode: longint; - lFileSz, lEnd, lStart, i: integer; - lBuff: array of char; -begin - lFileSz := FSize (lHdr.HdrFileName); - if (lFileSz < sizeof(lHdr.NIFTIhdr)+14) then exit; - if (lHdr.gzBytesX = K_gzBytes_headerAndImageUncompressed) then begin - AssignFile(myFile, lHdr.HdrFileName); - FileMode := fmOpenRead; - Reset(myFile, 1); // Now we define one record as 1 byte - seek(myFile, sizeof(lHdr.NIFTIhdr)); - BlockRead(myFile, extension, 4); - if extension[0] = 0 then begin - CloseFile(myFile); - exit; - end; - BlockRead(myFile, esize, 4); - BlockRead(myFile, ecode, 4); - if (lHdr.DiskDataNativeEndian = false) then begin - swap4(esize); - swap4(ecode); - end; - esize := esize - 8; //-8 as esize includes 8 bytes of esize and ecode themselves - lStart := sizeof(lHdr.NIFTIhdr)+12; - lEnd := lStart + esize; - if (lEnd > lFileSz) or (esize < 1) then begin// or ((ecode <> 6) and (ecode <> 4)) then begin //XML or Text - CloseFile(myFile); - exit; - end; - SetLength(lBuff, esize); - BlockRead(myFile, lBuff[0], esize); - SetString(lHdr.ECodeText, PChar(@lBuff[0]), esize); - CloseFile(myFile); - exit; - end; - //next: compressed header - lFileSz := round(lHdr.NIFTIhdr.vox_offset); - SetLength(lBuff, lFileSz); - UnGZip(lHdr.HdrFileName,bytep(lBuff),0,lFileSz); - i := sizeof(lHdr.NIFTIhdr); - extension[0] := ord(lBuff[i]); - if extension[0] = 0 then exit; - i := i + 4; - esize := ord(lBuff[i]) + ord(lBuff[i+1]) shl 8 + ord(lBuff[i+2]) shl 16 + ord(lBuff[i+3]) shl 24; - i := i + 4; - ecode := ord(lBuff[i]) + ord(lBuff[i+1]) shl 8 + ord(lBuff[i+2]) shl 16 + ord(lBuff[i+3]) shl 24; - {$IFDEF ENDIAN_BIG} - if (lHdr.DiskDataNativeEndian = true) then begin - swap4(esize); - swap4(ecode); - end; - {$ELSE} - if (lHdr.DiskDataNativeEndian = false) then begin - swap4(esize); - swap4(ecode); - end; - {$ENDIF} - //showmessage(inttostr(ord(lBuff[i]))+' '+inttostr(ord(lBuff[i+1])) ); - esize := esize - 8; //-8 as esize includes 8 bytes of esize and ecode themselves - lStart := sizeof(lHdr.NIFTIhdr)+12; - lEnd := lStart + esize; - if (lEnd > lFileSz) or (esize < 1) then exit; - SetString(lHdr.ECodeText, PChar(@lBuff[lStart]), esize); - //showmessage(inttostr(esize)); -end;*) - -function NIFTIhdr_LoadHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean; -var - lHdrFile: file; - lOri: array [1..3] of single; - lBuff: Bytep; - lAHdr: TAnalyzeHdrSection; - lFileSz : int64; - swapEndian, isNativeNIfTI: boolean; - lReportedSz, lSwappedReportedSz,lHdrSz: Longint; - lExt: string; //1494 -begin - Result := false; //assume error - if lFilename = '' then exit; - lExt := UpCaseExt(lFilename); - if lExt = '.IMG' then - lFilename := changeFileExt(lFilename,'.hdr'); - if (lExt = '.BRIK') or (lExt = '.BRIK.GZ') then - lFilename := changeFileExtX(lFilename,'.HEAD'); - lExt := UpCaseExt(lFilename); - lHdrSz := sizeof(TniftiHdr); - lFileSz := FSize (lFilename); - if lFileSz = 0 then begin - ShowMsg('Unable to find NIFTI header named '+lFilename+'. Possible solution: make sure VAL file and images are in the same folder.'); - exit; - end; - swapEndian := false; - lHdr.gzBytesX := K_gzBytes_headerAndImageUncompressed; - lHdr.ImgFileName:= lFilename ; - lHdr.HdrFileName:= lFilename ; - //xx lHdr.ECodeText:= ''; - - FileMode := fmOpenRead; //Set file access to read only - isNativeNIfTI := true; - if (lExt = '.MGH') or (lExt = '.MGZ') or (lExt = '.MHD') or (lExt = '.MHA') or (lExt = '.NRRD') or (lExt = '.NHDR') or (lExt = '.HEAD') then begin - result := readForeignHeader( lFilename, lHdr.NIFTIhdr,lHdr.gzBytesX, swapEndian); //we currently ignore result! - lHdr.ImgFileName := lFilename; - isNativeNIfTI := false; - end else begin //native NIfTI - if (lExt = '.NII.GZ') or (lExt = '.VOI') or (lExt = '.GZ') then begin//1388 - lBuff := @lHdr; - UnGZip(lFileName,lBuff,0,lHdrSz); //1388 - lHdr.gzBytesX := K_gzBytes_headerAndImageCompressed; - end else begin //if gzip else uncompressed - if (lFileSz < lHdrSz) then begin - showmsg('Error in reading NIFTI header: NIfTI headers need to be at least '+inttostr(lHdrSz)+ ' bytes: '+lFilename); - result := false; - end else begin - {$I-} - AssignFile(lHdrFile, lFileName); - FileMode := 0; { Set file access to read only } - Reset(lHdrFile, 1); - {$I+} - if ioresult <> 0 then begin - ShowMessage('Error in reading NIFTI header.'+inttostr(IOResult)); - CloseFile(lHdrFile); - FileMode := fmOpenReadWrite; - exit; - end; - BlockRead(lHdrFile, lHdr, lHdrSz); - CloseFile(lHdrFile); - if (lExt = '.HDR') then - lHdr.ImgFileName:= changefileext(lFilename,'.img'); - end; - end; - end; //native NIFTI - // showmessage('---Unable to read this image format '+inttostr(lHdr.NIFTIhdr.datatype)+' '+inttostr(lHdr.NIFTIhdr.bitpix)); - - FileMode := fmOpenReadWrite; - if (IOResult <> 0) then exit; - lReportedSz := lHdr.niftiHdr.HdrSz; - lSwappedReportedSz := lReportedSz; - swap4(lSwappedReportedSz); - lHdr.NIFTIVersion := 1; - if lReportedSz = lHdrSz then begin - lHdr.DiskDataNativeEndian := true; - end else if lSwappedReportedSz = lHdrSz then begin - lHdr.DiskDataNativeEndian := false; - NIFTIhdr_SwapBytes (lHdr.niftiHdr); - end else begin - result := NIFTIhdr_LoadDCM (lFilename,lHdr); //2/2008 - if not result then - ShowMsg('Warning: the header file is not in NIfTi format [the first 4 bytes do not have the value 348]. Assuming big-endian data.'); - exit; - end; - if (lHdr.NIFTIhdr.dim[0] > 7) or (lHdr.NIFTIhdr.dim[0] < 1) then begin //only 1..7 dims, so this - ShowMsg('Illegal NIfTI Format Header: this header does not specify 1..7 dimensions.'); - exit; - end; - FixBadStrs(lHdr.NIFTIhdr); - FixDataType(lHdr); - result := true; - if IsNifTiMagic(lHdr.niftiHdr) then begin //must match MAGMA in nifti_img - lOri[1] := (lHdr.NIFTIhdr.dim[1]+1) div 2; - lOri[2] := (lHdr.NIFTIhdr.dim[2]+1) div 2; - lOri[3] := (lHdr.NIFTIhdr.dim[3]+1) div 2; - //TryQuat2Matrix(lHdr.NiftiHdr); - if (lHdr.NIFTIhdr.sform_code <= kNIFTI_XFORM_UNKNOWN) or (lHdr.NIFTIhdr.sform_code > kNIFTI_XFORM_MNI_152) then - TryQuat2Matrix(lHdr.NiftiHdr); - if emptymatrix(lHdr) then begin - - (*if HasQuat(lHdr.NiftiHdr) then - //HasQuat will specify - else*) begin - lHdr.NIFTIhdr.srow_x[0] := lHdr.NIFTIhdr.pixdim[1]; - lHdr.NIFTIhdr.srow_x[1] := 0; - lHdr.NIFTIhdr.srow_x[2] := 0; - - lHdr.NIFTIhdr.srow_y[0] := 0; - lHdr.NIFTIhdr.srow_y[1] := lHdr.NIFTIhdr.pixdim[2]; - lHdr.NIFTIhdr.srow_y[2] := 0; - lHdr.NIFTIhdr.srow_z[0] := 0; - lHdr.NIFTIhdr.srow_z[1] := 0; - lHdr.NIFTIhdr.srow_z[2] := lHdr.NIFTIhdr.pixdim[3]; - - lHdr.NIFTIhdr.srow_x[3] := -round(lHdr.NIFTIhdr.dim[1]*lHdr.NIFTIhdr.pixdim[1]*0.5); - lHdr.NIFTIhdr.srow_y[3] := -round(lHdr.NIFTIhdr.dim[2]*lHdr.NIFTIhdr.pixdim[2]*0.5); - lHdr.NIFTIhdr.srow_z[3] := -round(lHdr.NIFTIhdr.dim[3]*lHdr.NIFTIhdr.pixdim[3]*0.5); - lHdr.NIFTIhdr.sform_code := 1; - end; - end; - - - if (lHdr.NIFTIhdr.srow_x[0] > 0) and (lHdr.NIFTIhdr.srow_y[1] > 0) and (lHdr.NIFTIhdr.srow_z[2] > 0) and - (lHdr.NIFTIhdr.srow_x[3] > 0) and (lHdr.NIFTIhdr.srow_y[3] > 0) and (lHdr.NIFTIhdr.srow_z[3] > 0) then begin - lHdr.NIFTIhdr.srow_x[3] := -lHdr.NIFTIhdr.srow_x[3]; - lHdr.NIFTIhdr.srow_y[3] := -lHdr.NIFTIhdr.srow_y[3]; - lHdr.NIFTIhdr.srow_z[3] := -lHdr.NIFTIhdr.srow_z[3]; - lHdr.NIFTIhdr.sform_code := 1; - end; //added 4Mar2006 -> corrects for improperly signed offset values... - lHdr.NIfTItransform := true;//NIfTI 12/2010 - end else begin //not NIFT: Analyze - lHdr.NIfTItransform := false;//Analyze - if not lHdr.DiskDataNativeEndian then begin - NIFTIhdr_SwapBytes (lHdr.niftiHdr); - move(lHdr.niftiHdr,lAHdr,sizeof(lAHdr)); - NIFTIhdr_SwapBytes (lHdr.niftiHdr); - lAHdr.Originator[1] := swap(lAHdr.Originator[1]); - lAHdr.Originator[2] := swap(lAHdr.Originator[2]); - lAHdr.Originator[3] := swap(lAHdr.Originator[3]); - end else - move(lHdr.niftiHdr,lAHdr,sizeof(lAHdr)); - lOri[1] :=lAHdr.Originator[1]; - lOri[2] := lAHdr.Originator[2]; - lOri[3] := lAHdr.Originator[3]; - if (lOri[1]=76) and (lOri[2]=116) and (lOri[3]=64) - and (lHdr.NIFTIhdr.dim[1]=151) and (lHdr.NIFTIhdr.dim[2]=188) and (lHdr.NIFTIhdr.dim[3]=154) then begin - lOri[2] := 111; - lOri[3] := 68; - end; //2/2008 Juelich fudge factor - - if ((lOri[1]<1) or (lOri[1]> lHdr.NIFTIhdr.dim[1])) and - ((lOri[2]<1) or (lOri[2]> lHdr.NIFTIhdr.dim[2])) and - ((lOri[3]<1) or (lOri[3]> lHdr.NIFTIhdr.dim[3])) then begin - lOri[1] := (lHdr.NIFTIhdr.dim[1]+1) / 2; //May07 use / not div - lOri[2] := (lHdr.NIFTIhdr.dim[2]+1) / 2; //May07 use / not div - lOri[3] := (lHdr.NIFTIhdr.dim[3]+1) / 2; //May07 use / not div : if 20 slices, then origin is between 10 and 11 - - end; - //showmessage(inttostr(sizeof(lAHdr))+' '+realtostr(lHdr.Ori[1],1)+' '+ realtostr(lHdr.Ori[2],1)+' '+realtostr(lHdr.Ori[3],1) ); - //DANGER: This header was from ANALYZE format, not NIFTI: make sure the rotation matrix is switched off - NIFTIhdr_SetIdentityMatrix(lHdr); - lHdr.NIFTIhdr.qform_code := kNIFTI_XFORM_UNKNOWN; - lHdr.NIFTIhdr.sform_code := kNIFTI_XFORM_UNKNOWN; - //test - input estimated orientation matrix - lHdr.NIFTIhdr.sform_code := kNIFTI_XFORM_SCANNER_ANAT ; - lHdr.NIFTIhdr.srow_x[0] := lHdr.NIFTIhdr.pixdim[1]; - lHdr.NIFTIhdr.srow_y[1] := lHdr.NIFTIhdr.pixdim[2]; - lHdr.NIFTIhdr.srow_z[2] := lHdr.NIFTIhdr.pixdim[3]; - - lHdr.NIFTIhdr.srow_x[3] := (lOri[1]-1)*-lHdr.NIFTIhdr.pixdim[1]; - lHdr.NIFTIhdr.srow_y[3] := (lOri[2]-1)*-lHdr.NIFTIhdr.pixdim[2]; - lHdr.NIFTIhdr.srow_z[3] := (lOri[3]-1)*-lHdr.NIFTIhdr.pixdim[3]; - //fx(lHdr.NIFTIhdr.srow_z[3],lOri[3]); - //end test - //Warning: some of the NIFTI float values that do exist as integer values in Analyze may have bizarre values like +INF, -INF, NaN - lHdr.NIFTIhdr.toffset := 0; - lHdr.NIFTIhdr.intent_code := kNIFTI_INTENT_NONE; - lHdr.NIFTIhdr.dim_info := kNIFTI_SLICE_SEQ_UNKNOWN + (kNIFTI_SLICE_SEQ_UNKNOWN shl 2) + (kNIFTI_SLICE_SEQ_UNKNOWN shl 4); //Freq, Phase and Slice order all unknown - lHdr.NIFTIhdr.xyzt_units := kNIFTI_UNITS_UNKNOWN; - lHdr.NIFTIhdr.slice_duration := 0; //avoid +inf/-inf, NaN - lHdr.NIFTIhdr.intent_p1 := 0; //avoid +inf/-inf, NaN - lHdr.NIFTIhdr.intent_p2 := 0; //avoid +inf/-inf, NaN - lHdr.NIFTIhdr.intent_p3 := 0; //avoid +inf/-inf, NaN - lHdr.NIFTIhdr.pixdim[0] := 1; //QFactor should be 1 or -1 - - end; - if (lHdr.NIFTIhdr.sform_code > kNIFTI_XFORM_UNKNOWN) and (lHdr.NIFTIhdr.sform_code <= kNIFTI_XFORM_MNI_152) then begin //DEC06 - lHdr.Mat:= Matrix3D( - lHdr.NIFTIhdr.srow_x[0],lHdr.NIFTIhdr.srow_x[1],lHdr.NIFTIhdr.srow_x[2],lHdr.NIFTIhdr.srow_x[3], // 3D "graphics" matrix - lHdr.NIFTIhdr.srow_y[0],lHdr.NIFTIhdr.srow_y[1],lHdr.NIFTIhdr.srow_y[2],lHdr.NIFTIhdr.srow_y[3], // 3D "graphics" matrix - lHdr.NIFTIhdr.srow_z[0],lHdr.NIFTIhdr.srow_z[1],lHdr.NIFTIhdr.srow_z[2],lHdr.NIFTIhdr.srow_z[3], // 3D "graphics" matrix - 0,0,0,1); - end else begin - lHdr.Mat:= Matrix3D( - lHdr.NIFTIhdr.pixdim[1],0,0,(lOri[1]-1)*-lHdr.NIFTIhdr.pixdim[1], // 3D "graphics" matrix - 0,lHdr.NIFTIhdr.pixdim[2],0,(lOri[2]-1)*-lHdr.NIFTIhdr.pixdim[2], // 3D "graphics" matrix - 0,0,lHdr.NIFTIhdr.pixdim[3],(lOri[3]-1)*-lHdr.NIFTIhdr.pixdim[3], // 3D "graphics" matrix - 0,0,0,1); - end; - FixCrapMat(lHdr.Mat); - if swapEndian then - lHdr.DiskDataNativeEndian := false;//foreign data with swapped image data - //if (isNativeNIfTI) and (lHdr.NIFTIhdr.vox_offset > sizeof(TNIFTIHdr)) then - // ReadEcode(lHdr);//, swapEndian); -end; //func NIFTIhdr_LoadHdr - -procedure NIFTIhdr_SetIdentityMatrix (var lHdr: TMRIcroHdr); //create neutral rotation matrix -var lInc: integer; -begin - with lHdr.NIFTIhdr do begin - for lInc := 0 to 3 do - srow_x[lInc] := 0; - - for lInc := 0 to 3 do - srow_y[lInc] := 0; - for lInc := 0 to 3 do - srow_z[lInc] := 0; - for lInc := 1 to 16 do - intent_name[lInc] := chr(0); - //next: create identity matrix: if code is switched on there will not be a problem - srow_x[0] := 1; - srow_y[1] := 1; - srow_z[2] := 1; - end; -end; //proc NIFTIhdr_IdentityMatrix - -procedure NIFTIhdr_ClearHdr (var lHdr: TMRIcroHdr); //put sensible default values into header -var lInc: byte; -begin - lHdr.NIFTIVersion := 1; - lHdr.UsesCustomPalette := false; - lHdr.UsesCustomPaletteRandomRainbow:= false; - lHdr.UsesLabels := false; - lHdr.DiskDataNativeEndian := true; - lHdr.LutFromZero := false; - lHdr.NIfTItransform := true;//assume genuine NIfTI, not Analyze - with lHdr.NIFTIhdr do begin - {set to 0} - HdrSz := sizeof(TNIFTIhdr); - for lInc := 1 to 10 do - Data_Type[lInc] := chr(0); - for lInc := 1 to 18 do - db_name[lInc] := chr(0); - extents:=0; - session_error:= 0; - regular:='r'{chr(0)}; - dim_info:=(0); - dim[0] := 4; - for lInc := 1 to 7 do - dim[lInc] := 0; - intent_p1 := 0; - intent_p2 := 0; - intent_p3 := 0; - intent_code:=0; - datatype:=0 ; - bitpix:=0; - slice_start:=0; - for lInc := 1 to 7 do - pixdim[linc]:= 1.0; - vox_offset:= 0.0; - scl_slope := 1.0; - scl_inter:= 0.0; - slice_end:= 0; - slice_code := 0; - xyzt_units := 10; - cal_max:= 0.0; - cal_min:= 0.0; - slice_duration:=0; - toffset:= 0; - glmax:= 0; - glmin:= 0; - for lInc := 1 to 80 do - descrip[lInc] := chr(0);{80 spaces} - for lInc := 1 to 24 do - aux_file[lInc] := chr(0);{24 spaces} - {below are standard settings which are not 0} - bitpix := 16;//vc16; {8bits per pixel, e.g. unsigned char 136} - DataType := 4;//vc4;{2=unsigned char, 4=16bit int 136} - Dim[0] := 3; - Dim[1] := 256; - Dim[2] := 256; - Dim[3] := 128; - Dim[4] := 1; {n vols} - Dim[5] := 1; - Dim[6] := 1; - Dim[7] := 1; - glMin := 0; - glMax := 255; - qform_code := kNIFTI_XFORM_UNKNOWN; - sform_code:= kNIFTI_XFORM_UNKNOWN; - quatern_b := 0; - quatern_c := 0; - quatern_d := 0; - qoffset_x := 0; - qoffset_y := 0; - qoffset_z := 0; - NIFTIhdr_SetIdentityMatrix(lHdr); - magic := kNIFTI_MAGIC_SEPARATE_HDR; - end; //with the NIfTI header... - with lHdr do begin - ScrnBufferItems := 0; - ImgBufferItems := 0; - ImgBufferBPP := 0; - RenderBufferItems := 0; - ScrnBuffer:= nil; - ImgBuffer := nil; - end; - -end; //proc NIFTIhdr_ClearHdr - -function NIFTIhdr_SaveHdr (var lFilename: string; var lHdr: TNIFTIHdr; lAllowOverwrite,lSPM2: boolean): boolean; overload; -var lOutHdr: TNIFTIhdr; - lExt: string; - lF: File; - lOverwrite: boolean; - -begin - lOverwrite := false; //will we overwrite existing file? - result := false; //assume failure - lExt := UpCaseExt(lFilename); - if (lExt='.NII') or (lExt = '.NII.GZ') or (lExt = '.VOI') then - lHdr.magic := kNIFTI_MAGIC_EMBEDDED_HDR; - if (lExt = '.HDR') then - lHdr.magic := kNIFTI_MAGIC_SEPARATE_HDR; - if lHdr.magic = kNIFTI_MAGIC_EMBEDDED_HDR then begin - if (lExt = '.GZ') or (lExt = '.NII.GZ') then begin - ShowMessage('Unable to save .nii.gz headers (first ungzip your image if you wish to edit the header)'); - exit; - end; - lFilename := changefileext(lFilename,'.nii') - end else - lFilename := changefileext(lFilename,'.hdr'); - if ((sizeof(TNIFTIhdr))> DiskFreeEx(lFileName)) then begin - ShowMessage('There is not enough free space on the destination disk to save the header. '+kCR+ - lFileName+ kCR+' Bytes Required: '+inttostr(sizeof(TNIFTIhdr)) ); - exit; - end; - if Fileexists(lFileName) then begin - if lAllowOverwrite then begin - {$IFNDEF GUI} - ShowMsg('Overwriting '+lFilename); - lOverwrite := true; - {$ELSE} - case MessageDlg('Do you wish to modify the existing file '+lFilename+'?', mtConfirmation,[mbYes, mbNo], 0) of { produce the message dialog box } - 6: lOverwrite := true; //6= mrYes, 7=mrNo... not sure what this is for Linux. Hardcoded as we do not include Form values - end;//case - {$ENDIF} - end else - showmessage('Error: the file '+lFileName+' already exists.'); - if not lOverwrite then Exit; - end; - if lHdr.magic = kNIFTI_MAGIC_EMBEDDED_HDR then - if lHdr.vox_offset < sizeof(TNIFTIHdr) then - lHdr.vox_offset := sizeof(TNIFTIHdr); //embedded images MUST start after header - if lHdr.magic = kNIFTI_MAGIC_SEPARATE_HDR then - lHdr.vox_offset := 0; //embedded images MUST start after header - if lSPM2 then begin //SPM2 does not recognize NIfTI - origin values will be wrong - lHdr.magic := 0; - end; - result := true; - move(lHdr, lOutHdr, sizeof(lOutHdr)); - Filemode := 1; - AssignFile(lF, lFileName); {WIN} - if lOverwrite then //this allows us to modify just the 348byte header of an existing NII header without touching image data - Reset(lF,sizeof(TNIFTIhdr)) - else - Rewrite(lF,sizeof(TNIFTIhdr)); - BlockWrite(lF,lOutHdr, 1 {, NumWritten}); - CloseFile(lF); - Filemode := 2; -end; //func NIFTIhdr_SaveHdr - -function NIFTIhdr_SaveHdr (var lFilename: string; var lHdr: TMRIcroHdr; lAllowOverwrite: boolean): boolean; overload; -var lOutHdr: TNIFTIhdr; - lExt: string; - lF: File; - lOverwrite: boolean; -begin - lOverwrite := false; //will we overwrite existing file? - result := false; //assume failure - if lHdr.NIFTIhdr.magic = kNIFTI_MAGIC_EMBEDDED_HDR then begin - lExt := UpCaseExt(lFileName); - if (lExt = '.GZ') or (lExt = '.NII.GZ') then begin - showmessage('Unable to save .nii.gz headers (first ungzip your image if you wish to edit the header)'); - exit; - end; - lFilename := changefileext(lFilename,'.nii') - end else - lFilename := changefileext(lFilename,'.hdr'); - if ((sizeof(TNIFTIhdr))> DiskFreeEx(lFileName)) then begin - ShowMessage('There is not enough free space on the destination disk to save the header. '+kCR+ - lFileName+ kCR+' Bytes Required: '+inttostr(sizeof(TNIFTIhdr)) ); - exit; - end; - if Fileexists(lFileName) then begin - if lAllowOverwrite then begin - {$IFNDEF GUI} - ShowMsg('Overwriting '+lFilename); - lOverwrite := true; - {$ELSE} - case MessageDlg('Do you wish to modify the existing file '+lFilename+'?', mtConfirmation,[mbYes, mbNo], 0) of { produce the message dialog box } - 6: lOverwrite := true; //6= mrYes, 7=mrNo... not sure what this is for unix. Hardcoded as we do not include Form values - end;//case - {$ENDIF} - end else - showmessage('Error: the file '+lFileName+' already exists.'); - if not lOverwrite then Exit; - end; - if lHdr.NIFTIhdr.magic = kNIFTI_MAGIC_EMBEDDED_HDR then - if lHdr.NIFTIhdr.vox_offset < sizeof(TNIFTIHdr) then - lHdr.NIFTIhdr.vox_offset := sizeof(TNIFTIHdr); //embedded images MUST start after header - if lHdr.NIFTIhdr.magic = kNIFTI_MAGIC_SEPARATE_HDR then - lHdr.NIFTIhdr.vox_offset := 0; //embedded images MUST start after header - result := true; - move(lHdr.NIFTIhdr, lOutHdr, sizeof(lOutHdr)); - if lHdr.DiskDataNativeEndian= false then - NIFTIhdr_SwapBytes (lOutHdr);{swap to big-endianformat} - Filemode := 1; - AssignFile(lF, lFileName); {WIN} - if lOverwrite then //this allows us to modify just the 348byte header of an existing NII header without touching image data - Reset(lF,sizeof(TNIFTIhdr)) - else - Rewrite(lF,sizeof(TNIFTIhdr)); - BlockWrite(lF,lOutHdr, 1 {, NumWritten}); - CloseFile(lF); - Filemode := 2; -end; //func NIFTIhdr_SaveHdr - -procedure NIFTIhdr_SwapBytes (var lAHdr: TNIFTIhdr); //Swap Byte order for the Analyze type -var - lInc: integer; -begin - with lAHdr do begin - swap4(hdrsz); - swap4(extents); - session_error := swap(session_error); - for lInc := 0 to 7 do - dim[lInc] := swap(dim[lInc]); - Xswap4r(intent_p1); - Xswap4r(intent_p2); - Xswap4r(intent_p3); - intent_code:= swap(intent_code); - datatype:= swap(datatype); - bitpix := swap(bitpix); - slice_start:= swap(slice_start); - for lInc := 0 to 7 do - Xswap4r(pixdim[linc]); - Xswap4r(vox_offset); - Xswap4r(scl_slope); - Xswap4r(scl_inter); - slice_end := swap(slice_end); - Xswap4r(cal_max); - Xswap4r(cal_min); - Xswap4r(slice_duration); - Xswap4r(toffset); - swap4(glmax); - swap4(glmin); - qform_code := swap(qform_code); - sform_code:= swap(sform_code); - Xswap4r(quatern_b); - Xswap4r(quatern_c); - Xswap4r(quatern_d); - Xswap4r(qoffset_x); - Xswap4r(qoffset_y); - Xswap4r(qoffset_z); - for lInc := 0 to 3 do //alpha - Xswap4r(srow_x[lInc]); - for lInc := 0 to 3 do //alpha - Xswap4r(srow_y[lInc]); - for lInc := 0 to 3 do //alpha - Xswap4r(srow_z[lInc]); - end; //with NIFTIhdr -end; //proc NIFTIhdr_SwapBytes - -end. diff --git a/common/define_types.pas b/common/define_types.pas index 2582b1d..bdb67bc 100755 --- a/common/define_types.pas +++ b/common/define_types.pas @@ -19,8 +19,7 @@ interface SysUtils,classes,IniFiles, {$IFDEF GUI} forms,userdir, dialogs{$ELSE}dialogsx{$ENDIF}; const - //kMRIcronVersDate = '3MAY2016'; - kVers = 'v1.0.20190410'; + kVers = 'v1.0.20190902'; {$IFDEF LCLCocoa} kMRIcronAPI = 'Cocoa'; {$ELSE} diff --git a/common/nifti_hdr.pas b/common/nifti_hdr.pas index b4a524c..c1ce5a5 100755 --- a/common/nifti_hdr.pas +++ b/common/nifti_hdr.pas @@ -69,6 +69,8 @@ implementation {$IFDEF GUI} dialogs,{$ENDIF} dicomhdr;//2/2208 + + function CopyNiftiHdr (var lInHdr,lOutHdr: TNIFTIhdr): boolean; begin move(lInHdr,lOutHdr,sizeof(TNIFTIhdr)); @@ -809,7 +811,7 @@ function NIFTIhdr_LoadHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean lBuff: Bytep; lAHdr: TAnalyzeHdrSection; lFileSz : int64; - swapEndian, isNativeNIfTI: boolean; + swapEndian, isNativeNIfTI, isDimPermute2341: boolean; lReportedSz, lSwappedReportedSz,lHdrSz: Longint; lExt: string; //1494 begin @@ -835,8 +837,10 @@ function NIFTIhdr_LoadHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean FileMode := fmOpenRead; //Set file access to read only isNativeNIfTI := true; - if (lExt = '.MGH') or (lExt = '.MGZ') or (lExt = '.MHD') or (lExt = '.MHA') or (lExt = '.NRRD') or (lExt = '.NHDR') or (lExt = '.HEAD') then begin - result := readForeignHeader( lFilename, lHdr.NIFTIhdr,lHdr.gzBytesX, swapEndian); //we currently ignore result! + if (lExt = '.BVOX') or (lExt = '.MGH') or (lExt = '.MGZ') or (lExt = '.MHD') or (lExt = '.MHA') or (lExt = '.NRRD') or (lExt = '.NHDR') or (lExt = '.HEAD') or (lExt = '.V') or (lExt = '.VTK') then begin + //result := readForeignHeader( lFilename, lHdr.NIFTIhdr,lHdr.gzBytesX, swapEndian); //we currently ignore result! + result := readForeignHeader( lFilename, lHdr.NIFTIhdr,lHdr.gzBytesX, swapEndian, isDimPermute2341); //we currently ignore result! + //function readForeignHeader (var lFilename: string; var lHdr: TNIFTIhdr; var gzBytes: int64; var swapEndian, isDimPermute2341: boolean): boolean; lHdr.ImgFileName := lFilename; isNativeNIfTI := false; end else begin //native NIfTI @@ -873,7 +877,9 @@ function NIFTIhdr_LoadHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean if (IOResult <> 0) then exit; lReportedSz := lHdr.niftiHdr.HdrSz; lSwappedReportedSz := lReportedSz; + swap4(lSwappedReportedSz); + //showmessage(format('%d -> %d', [lReportedSz, lSwappedReportedSz])); lHdr.NIFTIVersion := 1; if lReportedSz = lHdrSz then begin lHdr.DiskDataNativeEndian := true; diff --git a/common/nifti_types.pas b/common/nifti_types.pas index 78ad791..1cd9f1d 100755 --- a/common/nifti_types.pas +++ b/common/nifti_types.pas @@ -7,6 +7,11 @@ interface Classes, SysUtils, define_types; type + TVec3i = packed record + case integer of + 0: (v: array[0..2] of int32); + 1: (x, y, z: int32); + end; TNIFTIhdr = packed record //Next: analyze Format Header structure HdrSz : longint; //MUST BE 348 Data_Type: array [1..10] of ansichar; //unused @@ -119,6 +124,9 @@ interface //byte-swapped magic values kswapNIFTI_MAGIC_SEPARATE_HDR = $6E693100; kswapNIFTI_MAGIC_EMBEDDED_HDR = $6E2B3100; + kNIFTI2_MAGIC_SEPARATE_HDR = $0032696E; + kNIFTI2_MAGIC_EMBEDDED_HDR = $00322B6E; + {$ENDIF} //Statistics Intention kNIFTI_INTENT_NONE =0; @@ -157,9 +165,144 @@ interface kNIFTI_INTENT_POINTSET =1008; kNIFTI_INTENT_TRIANGLE =1009; kNIFTI_INTENT_QUATERNION =1010; +procedure NII_Clear (out lHdr: TNIFTIHdr); +procedure NIFTIhdr_SwapBytes (var lAHdr: TNIFTIhdr); //Swap Byte order for the Analyze type implementation +procedure NIFTIhdr_SwapBytes (var lAHdr: TNIFTIhdr); //Swap Byte order for the Analyze type +var + lInc: integer; +begin + with lAHdr do begin + swap4(hdrsz); + swap4(extents); + session_error := swap2(session_error); + for lInc := 0 to 7 do + dim[lInc] := swap2(dim[lInc]);//666 + Xswap4r(intent_p1); + Xswap4r(intent_p2); + Xswap4r(intent_p3); + intent_code:= swap2(intent_code); + datatype:= swap2(datatype); + bitpix := swap2(bitpix); + slice_start:= swap2(slice_start); + for lInc := 0 to 7 do + Xswap4r(pixdim[linc]); + Xswap4r(vox_offset); +{roi scale = 1} + Xswap4r(scl_slope); + Xswap4r(scl_inter); + slice_end := swap2(slice_end); + Xswap4r(cal_max); + Xswap4r(cal_min); + Xswap4r(slice_duration); + Xswap4r(toffset); + swap4(glmax); + swap4(glmin); + qform_code := swap2(qform_code); + sform_code:= swap2(sform_code); + Xswap4r(quatern_b); + Xswap4r(quatern_c); + Xswap4r(quatern_d); + Xswap4r(qoffset_x); + Xswap4r(qoffset_y); + Xswap4r(qoffset_z); + for lInc := 0 to 3 do //alpha + Xswap4r(srow_x[lInc]); + for lInc := 0 to 3 do //alpha + Xswap4r(srow_y[lInc]); + for lInc := 0 to 3 do //alpha + Xswap4r(srow_z[lInc]); + end; //with NIFTIhdr +end; //proc NIFTIhdr_SwapBytes + + +procedure NII_SetIdentityMatrix (var lHdr: TNIFTIHdr); //create neutral rotation matrix +var lInc: integer; +begin + with lHdr do begin + for lInc := 0 to 3 do + srow_x[lInc] := 0; + for lInc := 0 to 3 do + srow_y[lInc] := 0; + for lInc := 0 to 3 do + srow_z[lInc] := 0; + for lInc := 1 to 16 do + intent_name[lInc] := chr(0); + //next: create identity matrix: if code is switched on there will not be a problem + srow_x[0] := 1; + srow_y[1] := 1; + srow_z[2] := 1; + end; +end; //proc NIFTIhdr_IdentityMatrix + +procedure NII_Clear (out lHdr: TNIFTIHdr); +var + lInc: integer; +begin + with lHdr do begin + HdrSz := sizeof(TNIFTIhdr); + for lInc := 1 to 10 do + Data_Type[lInc] := chr(0); + for lInc := 1 to 18 do + db_name[lInc] := chr(0); + extents:=0; + session_error:= 0; + regular:='r'{chr(0)}; + dim_info:=(0); + intent_p1 := 0; + intent_p2 := 0; + intent_p3 := 0; + intent_code:=0; + datatype:=0 ; + bitpix:=0; + slice_start:=0; + for lInc := 1 to 7 do + pixdim[linc]:= 1.0; + vox_offset:= 0.0; + scl_slope := 1.0; + scl_inter:= 0.0; + slice_end:= 0; + slice_code := 0; + xyzt_units := 10; + cal_max:= 0.0; + cal_min:= 0.0; + slice_duration:=0; + toffset:= 0; + glmax:= 0; + glmin:= 0; + for lInc := 1 to 80 do + descrip[lInc] := chr(0);{80 spaces} + for lInc := 1 to 24 do + aux_file[lInc] := chr(0);{80 spaces} + {below are standard settings which are not 0} + bitpix := 16;//vc16; {8bits per pixel, e.g. unsigned char 136} + DataType := 4;//vc4;{2=unsigned char, 4=16bit int 136} + Dim[0] := 3; + Dim[1] := 256; + Dim[2] := 256; + Dim[3] := 1; + Dim[4] := 1; {n vols} + Dim[5] := 1; + Dim[6] := 1; + Dim[7] := 1; + glMin := 0; + glMax := 255; + qform_code := kNIFTI_XFORM_UNKNOWN; + sform_code:= kNIFTI_XFORM_UNKNOWN; + quatern_b := 0; + quatern_c := 0; + quatern_d := 0; + qoffset_x := 0; + qoffset_y := 0; + qoffset_z := 0; + NII_SetIdentityMatrix(lHdr); + magic := kNIFTI_MAGIC_SEPARATE_HDR; + end; //with the NIfTI header... +end; + + end. diff --git a/crop.pas b/crop.pas index 7809103..e48cf0a 100755 --- a/crop.pas +++ b/crop.pas @@ -158,7 +158,7 @@ function GrowNeck (lFilename: string; lVox: integer): boolean; lByteSwap: boolean; begin gBGImg.Prompt4DVolume := false; - if not HdrForm.OpenAndDisplayHdr(lFilename,gMRIcroOverlay[kBGOverlayNum]) then exit; + if not ImgForm.OpenAndDisplayHdr(lFilename,gMRIcroOverlay[kBGOverlayNum]) then exit; gBGImg.Prompt4DVolume := true; if not OpenImg(gBGImg,gMRIcroOverlay[kBGOverlayNum],false,false,false,false,true {4D!}) then exit; lInHdr := gMRIcroOverlay[kBGOverlayNum].NIFTIHdr; @@ -260,4 +260,4 @@ function GrowNeck (lFilename: string; lVox: integer): boolean; end; -end. \ No newline at end of file +end. diff --git a/dcm2nii.lfm b/dcm2nii.lfm index b82565e..3dd6f16 100644 --- a/dcm2nii.lfm +++ b/dcm2nii.lfm @@ -1,7 +1,7 @@ object dcm2niiForm: Tdcm2niiForm - Left = 315 + Left = 475 Height = 525 - Top = 253 + Top = 54 Width = 965 ActiveControl = SelectFilesBtn AllowDropFiles = True @@ -27,14 +27,14 @@ object dcm2niiForm: Tdcm2niiForm TabOrder = 0 object GeneralGroup: TGroupBox Left = 1 - Height = 215 + Height = 216 Top = 1 Width = 338 Align = alTop AutoSize = True Caption = 'General' ClientHeight = 197 - ClientWidth = 330 + ClientWidth = 328 TabOrder = 0 object BidsLabel: TLabel AnchorSideLeft.Control = OutNameLabel @@ -55,8 +55,9 @@ object dcm2niiForm: Tdcm2niiForm AnchorSideRight.Side = asrBottom Left = 4 Height = 20 + Hint = 'Create a BIDS text file with sequence details.' Top = 177 - Width = 326 + Width = 324 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 4 @@ -68,6 +69,8 @@ object dcm2niiForm: Tdcm2niiForm 'Yes, with Personal Identifiers' ) OnChange = UpdateCommand + ParentShowHint = False + ShowHint = True Style = csDropDownList TabOrder = 3 Text = 'Yes, Anonymized' @@ -80,7 +83,7 @@ object dcm2niiForm: Tdcm2niiForm Left = 4 Height = 20 Top = 133 - Width = 326 + Width = 324 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 4 @@ -117,7 +120,7 @@ object dcm2niiForm: Tdcm2niiForm Left = 4 Height = 20 Top = 89 - Width = 326 + Width = 324 Anchors = [akTop, akLeft, akRight] BorderSpacing.Top = 4 BorderSpacing.Right = 5 @@ -167,7 +170,7 @@ object dcm2niiForm: Tdcm2niiForm Height = 21 Hint = 'Special values: %a=antenna (coil) name, %b=basename, %c=comments, %d=description, %e=echo number, %f=folder name, %i=ID of patient, %j=seriesInstanceUID, %k=studyInstanceUID, %m=manufacturer, %n=name of patient, %p=protocol, %r=instance number, %s=series number, %t=time, %u=acquisition number, %v=vendor, %x=study ID; %z=sequence name' Top = 24 - Width = 322 + Width = 320 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 4 BorderSpacing.Top = 4 @@ -191,14 +194,14 @@ object dcm2niiForm: Tdcm2niiForm end object AdvancedGroup: TGroupBox Left = 1 - Height = 128 - Top = 216 + Height = 153 + Top = 217 Width = 338 Align = alTop AutoSize = True Caption = 'Advanced' - ClientHeight = 110 - ClientWidth = 330 + ClientHeight = 134 + ClientWidth = 328 TabOrder = 1 object IgnoreCheck: TCheckBox Left = 4 @@ -230,54 +233,80 @@ object dcm2niiForm: Tdcm2niiForm ShowHint = True TabOrder = 1 end - object MergeCheck: TCheckBox + object PhilipsPreciseCheck: TCheckBox AnchorSideLeft.Control = IgnoreCheck AnchorSideTop.Control = LosslessScaleCheck AnchorSideTop.Side = asrBottom Left = 4 Height = 18 - Hint = 'Merge 2D slices from same series regardless of study time, echo, coil, orientation, etc.'#10 + Hint = 'Use Philips precise float scaling (not display) scaling.'#10 Top = 48 - Width = 140 + Width = 149 BorderSpacing.Top = 4 - Caption = 'Always Merge Series' + Caption = 'Precise Philips Scaling' OnChange = UpdateCommand ParentShowHint = False ShowHint = True TabOrder = 2 end - object PhilipsPreciseCheck: TCheckBox + object CropCheck: TCheckBox AnchorSideLeft.Control = IgnoreCheck - AnchorSideTop.Control = MergeCheck + AnchorSideTop.Control = PhilipsPreciseCheck AnchorSideTop.Side = asrBottom Left = 4 Height = 18 - Hint = 'Use Philips precise float scaling (not display) scaling.'#10 + Hint = 'Remove excess neck from anatomical (e.g. T1) scans. This can improve spatial registration.' Top = 70 - Width = 149 + Width = 114 BorderSpacing.Top = 4 - Caption = 'Precise Philips Scaling' + Caption = 'Crop 3D Images' OnChange = UpdateCommand ParentShowHint = False ShowHint = True TabOrder = 3 end - object CropCheck: TCheckBox + object VerboseCheck: TCheckBox AnchorSideLeft.Control = IgnoreCheck - AnchorSideTop.Control = PhilipsPreciseCheck + AnchorSideTop.Control = CropCheck AnchorSideTop.Side = asrBottom Left = 4 Height = 18 - Hint = 'Remove excess neck from anatomical (e.g. T1) scans. This can improve spatial registration.' + Hint = 'Provide detailed notes on conversion' Top = 92 - Width = 114 + Width = 69 BorderSpacing.Top = 4 - Caption = 'Crop 3D Images' + Caption = 'Verbose' OnChange = UpdateCommand ParentShowHint = False ShowHint = True TabOrder = 4 end + object MergeDrop: TComboBox + AnchorSideTop.Control = VerboseCheck + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 20 + Hint = 'merge 2D slices from same series regardless of echo, exposure, etc.' + Top = 114 + Width = 324 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + ItemHeight = 26 + ItemIndex = 0 + Items.Strings = ( + 'Automatic Series Merging' + 'Always Merge Series Regardless of Differences' + 'Never Merge Series with Differences' + ) + OnChange = UpdateCommand + ParentShowHint = False + ShowHint = True + Style = csDropDownList + TabOrder = 5 + Text = 'Automatic Series Merging' + end end object UpdateBtn: TButton AnchorSideLeft.Control = Panel1 @@ -287,7 +316,7 @@ object dcm2niiForm: Tdcm2niiForm AnchorSideRight.Side = asrBottom Left = 5 Height = 25 - Top = 348 + Top = 374 Width = 330 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 4 @@ -305,7 +334,7 @@ object dcm2niiForm: Tdcm2niiForm AnchorSideRight.Side = asrBottom Left = 5 Height = 25 - Top = 377 + Top = 403 Width = 330 Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 4 @@ -323,14 +352,14 @@ object dcm2niiForm: Tdcm2niiForm AnchorSideRight.Side = asrBottom Left = 5 Height = 20 - Top = 406 + Top = 432 Width = 330 Anchors = [akTop, akLeft, akRight] AutoSize = True BorderSpacing.Left = 4 BorderSpacing.Top = 4 BorderSpacing.Right = 4 - Caption = 'Select Files To Convert...' + Caption = 'Select Folder To Convert...' OnClick = SelectFilesBtnClick TabOrder = 4 end diff --git a/dcm2nii.pas b/dcm2nii.pas index bcfa7da..3fc64c1 100644 --- a/dcm2nii.pas +++ b/dcm2nii.pas @@ -4,13 +4,14 @@ {$IFDEF Darwin} {$modeswitch objectivec1} {$ENDIF} +//{$DEFINE isGL} interface uses {$IFDEF Darwin} CocoaAll, MacOSAll, {$ENDIF} - strutils, Process, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, - lclintf, IniFiles, ComCtrls, Types; + lclintf, strutils, Process, Classes, SysUtils, Forms, Controls, Graphics, + Dialogs, ExtCtrls, StdCtrls, IniFiles, ComCtrls, Types; type @@ -18,7 +19,9 @@ interface Tdcm2niiForm = class(TForm) BidsDrop: TComboBox; + MergeDrop: TComboBox; BidsLabel: TLabel; + VerboseCheck: TCheckBox; UpdateBtn: TButton; CropCheck: TCheckBox; FormatDrop: TComboBox; @@ -27,7 +30,6 @@ Tdcm2niiForm = class(TForm) AdvancedGroup: TGroupBox; IgnoreCheck: TCheckBox; LosslessScaleCheck: TCheckBox; - MergeCheck: TCheckBox; OutDirDrop: TComboBox; OutDirLabel: TLabel; OutNameEdit: TEdit; @@ -54,6 +56,7 @@ Tdcm2niiForm = class(TForm) procedure UpdateBtnClick(Sender: TObject); procedure UpdateCommand(Sender: TObject); function TerminalCommand: string; + function getCurrentDcm2niix(): string; function getCustomDcm2niix(): string; procedure setCustomDcm2niix(fnm: string); //procedure findCustomDcm2niix(); @@ -69,6 +72,11 @@ Tdcm2niiForm = class(TForm) dcm2niiForm: Tdcm2niiForm; implementation + +{$ifdef LCLCocoa}{$IFDEF isGL} +uses mainunit; //darkmode +{$ENDIF}{$ENDIF} + {$R *.lfm} const kExeName = 'dcm2niix'; {$IFDEF Unix} @@ -78,8 +86,8 @@ implementation {$ENDIF} Type TPrefs = record - UseOutDir, Ignore, LosslessScale,Merge,PhilipsPrecise, Crop: boolean; - Bids,Format: integer; + UseOutDir, Ignore, LosslessScale,PhilipsPrecise, Crop, Verbose: boolean; + SeriesMerge,Bids,Format: integer; OutDir,OutName: String; end; var @@ -116,7 +124,7 @@ function ResourceDir (): string; end; {$ENDIF} -function getDefaultDcm2niix(): string; +function getDefaultDcm2niix2(): string; begin {$IFDEF UNIX} result := ResourceDir + pathdelim + kExeName; @@ -125,10 +133,18 @@ function getDefaultDcm2niix(): string; {$ENDIF} end; + +function Tdcm2niiForm.getCurrentDcm2niix(): string; +begin + result := gCustomDcm2niix; + if (result = '') or (not fileexists(result)) then + result := getDefaultDcm2niix2(); +end; + function Tdcm2niiForm.getCustomDcm2niix(): string; begin - if (gCustomDcm2niix = '') or (not fileexists(gCustomDcm2niix)) then - gCustomDcm2niix := getDefaultDcm2niix(); + //if (gCustomDcm2niix = '') or (not fileexists(gCustomDcm2niix)) then + // gCustomDcm2niix := getDefaultDcm2niix(); result := gCustomDcm2niix; end; @@ -142,9 +158,10 @@ function SetDefaultPrefs(): TPrefs; with result do begin Ignore := false; LosslessScale := false; - Merge := false; + SeriesMerge := 0; PhilipsPrecise := true; Crop := false; + Verbose := false; UseOutDir := false; Bids := 1; Format := 1; @@ -158,9 +175,10 @@ procedure Tdcm2niiForm.ShowPrefs; with gPrefs do begin IgnoreCheck.Checked := Ignore; LosslessScaleCheck.Checked := LosslessScale; - MergeCheck.Checked := Merge; + MergeDrop.ItemIndex := SeriesMerge; PhilipsPreciseCheck.Checked := PhilipsPrecise; CropCheck.Checked := Crop; + VerboseCheck.Checked := Verbose; if (UseOutDir) then OutDirDrop.ItemIndex := 2 else @@ -177,9 +195,10 @@ procedure Tdcm2niiForm.ReadPrefs; with gPrefs do begin Ignore := IgnoreCheck.Checked; LosslessScale := LosslessScaleCheck.Checked; - Merge := MergeCheck.Checked; + SeriesMerge := MergeDrop.ItemIndex; PhilipsPrecise := PhilipsPreciseCheck.Checked; Crop := CropCheck.Checked; + Verbose := VerboseCheck.Checked; UseOutDir := (OutDirDrop.ItemIndex = 2); OutDir := OutDirDrop.Items[2]; Format := FormatDrop.ItemIndex; @@ -268,9 +287,10 @@ function IniFile(lRead: boolean; var lPrefs: TPrefs): boolean; IniBool(lRead,lIniFile, 'UseOutDir',lPrefs.UseOutDir); IniBool(lRead,lIniFile, 'Ignore',lPrefs.Ignore); IniBool(lRead,lIniFile, 'LosslessScale',lPrefs.LosslessScale); - IniBool(lRead,lIniFile, 'Merge',lPrefs.Merge); IniBool(lRead,lIniFile, 'PhilipsPrecise',lPrefs.PhilipsPrecise); IniBool(lRead,lIniFile, 'Crop',lPrefs.Crop); + IniBool(lRead,lIniFile, 'Verbose',lPrefs.Verbose); + IniInt(lRead,lIniFile, 'SeriesMerge',lPrefs.SeriesMerge); IniInt(lRead,lIniFile, 'Bids', lPrefs.Bids); IniInt(lRead,lIniFile, 'Format', lPrefs.Format); IniStr(lRead, lIniFile, 'OutDir', lPrefs.OutDir); @@ -286,14 +306,16 @@ function Tdcm2niiForm.TerminalCommand: string; result := result + ' -f "'+OutNameEdit.Text+'"'; if IgnoreCheck.Checked then result := result + ' -i y'; if LosslessScaleCheck.Checked then result := result + ' -l y'; - if MergeCheck.Checked then result := result + ' -m y'; + if MergeDrop.ItemIndex = 1 then result := result + ' -m y'; + if MergeDrop.ItemIndex = 2 then result := result + ' -m n'; if PhilipsPreciseCheck.Checked then result := result + ' -p y' else result := result + ' -p n'; if CropCheck.Checked then result := result + ' -x y'; + if VerboseCheck.Checked then result := result + ' -v y'; if odd(FormatDrop.ItemIndex) then - result := result + ' -z y' + result := result + ' -z y' else result := result + ' -z n'; if (FormatDrop.ItemIndex > 1) then @@ -318,6 +340,7 @@ procedure Tdcm2niiForm.UpdateCommand(Sender: TObject); procedure Tdcm2niiForm.ResetBtnClick(Sender: TObject); begin gPrefs := SetDefaultPrefs(); + gCustomDcm2niix := ''; ShowPrefs; UpdateCommand(Sender); end; @@ -337,6 +360,7 @@ procedure Tdcm2niiForm.FormShow(Sender: TObject); ShowPrefs; UpdateCommand(Sender); InputDirDialog.InitialDir := GetUserDir; + {$IFDEF LCLCocoa} {$IFDEF isGL} GLForm1.SetFormDarkMode(dcm2niiForm); {$ENDIF}{$ENDIF} end; procedure Tdcm2niiForm.OutDirDropChange(Sender: TObject); @@ -391,7 +415,7 @@ function Tdcm2niiForm.RunCmd (lCmd: string; isDemo: boolean): string; begin result := ''; //EXIT_FAILURE //if (not isAppDoneInitializing) then exit; - exe := getCustomDcm2niix(); + exe := getCurrentDcm2niix(); if not fileexists(exe) then begin OutputMemo.Lines.Clear; OutputMemo.Lines.Add('Error: unable to find '+exe); @@ -470,13 +494,15 @@ procedure Tdcm2niiForm.UpdateDialog(versionMsg: string); //label promptLabel:=TLabel.create(PrefForm); currentDcm2niix := getCustomDcm2niix(); - defaultDcm2niix := getDefaultDcm2niix(); + defaultDcm2niix := getCurrentDcm2niix(); + if (currentDcm2niix = '') or (not fileexists(currentDcm2niix)) then + currentDcm2niix := defaultDcm2niix; isCurrentAlsoDefault := CompareStr(currentDcm2niix, defaultDcm2niix) = 0; if (not fileexists(defaultDcm2niix)) and (not isCurrentAlsoDefault) then isCurrentAlsoDefault := true; //default does not exist: do not show "Select Default") if versionMsg = '' then begin if fileexists(currentDcm2niix) then - promptLabel.Caption:= format('dcm2niix path: "%s"', [gCustomDcm2niix]) + promptLabel.Caption:= format('dcm2niix path: "%s"', [currentDcm2niix]) else promptLabel.Caption:= 'Unable to find dcm2niix'; end else @@ -571,6 +597,7 @@ procedure Tdcm2niiForm.UpdateBtnClick(Sender: TObject); else {$ENDIF} UpdateDialog(''); + UpdateCommand(Sender); end; end. diff --git a/dcm_load.pas b/dcm_load.pas index 1d05c57..5d2e578 100755 --- a/dcm_load.pas +++ b/dcm_load.pas @@ -1,289 +1,375 @@ -unit dcm_load; - -{$mode objfpc}{$H+} - -interface - -uses - {$IFNDEF UNIX} Windows, shlobj, {$ENDIF} - ClipBrd, ExtCtrls, StdCtrls, Forms, Controls, Classes, SysUtils, dialogs, Process; - - -function dcm2Nifti(dcm2niixExe, dicomDir: string): string; - -implementation - -{$ifdef LCLCocoa} -//uses mainunit; //darkmode -{$ENDIF} - -function seriesNum (s: string): single; //"601 myName" returns 601 -begin - result := StrToFloatDef(Copy(s, 1, pos(' ',s)-1),-1); -end; - -function seriesName (s: string): string; //"601 myName" returns 'myName' -var - delimPos: integer; -begin - delimPos := pos(' ',s); - if (delimPos < 1) or (delimPos >= length(s)) then exit; - result := Copy(s, delimPos+1, maxInt); -end; - -function compareSeries(List: TStringList; Index1, Index2: Integer): Integer; -var - n1, n2: single; -begin - n1 := seriesNum(List[Index1]); - n2 := seriesNum(List[Index2]); - if (n1 >= n2) then - result := 1 - else - result := -1; - //result := n1 - n2; -end; - -function dcmStr(s: string): string; -var - sl: TStringList; -begin - result := ''; - if (length(s) < 1) or (s[1] <> chr(9)) then exit; - sl := TStringList.Create; - sl.Delimiter := #9; //TAB - sl.DelimitedText := s; - if sl.Count >= 2 then begin - result := sl[0]+' '+extractfilename(sl[1]) ; - end else - result := ''; - sl.Free; -end; - - -function dcmList(dcm2niixExe, dicomDir: string): TStringList; -//make sure to free result! -//strList := dcmList(); strList.free; -var - hprocess: TProcess; - sData: TStringList; - s: string; - x: integer; -Begin - result := Tstringlist.Create; - if dcm2niixExe = '' then exit; - hProcess := TProcess.Create(nil); - hProcess.Executable := dcm2niixExe; - //hprocess.Parameters.Add('-d'); - //hprocess.Parameters.Add('1'); - hprocess.Parameters.Add('-n'); - hprocess.Parameters.Add('-1'); - hprocess.Parameters.Add('-f'); - hprocess.Parameters.Add('%p_%t'); - hprocess.Parameters.Add(dicomDir); - hProcess.Options := hProcess.Options + [poWaitOnExit, poUsePipes]; - hProcess.Execute; - sData := Tstringlist.Create; - sData.LoadFromStream(hProcess.Output); - for x := 0 to sData.Count -1 do begin - s := dcmStr(sData[x]); - if (s <> '') then - result.Add(s); - end; - //next: sort (optional) - sData.Clear; - sData.AddStrings(result); - sData.CustomSort(@compareSeries); - result.Clear; - result.AddStrings(sData); - //ClipBoard.AsText:=(sData.Text); - //release data - sData.Free; - hProcess.Free; -end; - - -function HomeDir: string; //set path to home if not provided -{$IFDEF UNIX} -begin - result := '/tmp/'; - if fileexists(result) then exit; - result := expandfilename('~/'); -end; -{$ELSE} -var - SpecialPath: PWideChar; -begin - Result := ''; - SpecialPath := WideStrAlloc(MAX_PATH); - try - FillChar(SpecialPath^, MAX_PATH, 0); - if SHGetSpecialFolderPathW(0, SpecialPath, CSIDL_PERSONAL, False) then - Result := SpecialPath+pathdelim; - finally - StrDispose(SpecialPath); - end; -end; -{$ENDIF} - -function dcmSeriesSelectForm(dcm2niixExe, dicomDir: string): string; -const - kMaxItems = 16; -var - PrefForm: TForm; - rg: TRadioGroup; - dcmStrings: TStringlist; - OKBtn, CancelBtn: TButton; - w,h: integer; -label - 123; -begin - result := ''; - dcmStrings := dcmList(dcm2niixExe, dicomDir); - if dcmStrings.Count < 1 then goto 123; //no files - if dcmStrings.Count = 1 then begin - result := dcmStrings[0];//seriesNum(dcmStrings[0]); - goto 123; - end; - PrefForm:=TForm.Create(nil); - PrefForm.SetBounds(100, 100, 520, 212); - //PrefForm.Caption:='DICOM Loading '+dcm2niixExe; - PrefForm.Caption:='Save converted images to '+HomeDir; - PrefForm.Position := poScreenCenter; - PrefForm.BorderStyle := bsDialog; - PrefForm.BorderWidth:= 4; - {$IFNDEF FPC}PrefForm.AutoSize := true;{$ENDIF} - //radio group - rg := TRadioGroup.create(PrefForm); - rg.align := alTop; - rg.AutoSize:=false; - rg.parent := PrefForm; - rg.caption := 'Select DICOM Series'; - if dcmStrings.Count > (kMaxItems) then begin - rg.caption := rg.caption + ' (Partial Listing)'; - while (dcmStrings.Count > kMaxItems) do - dcmStrings.Delete(dcmStrings.Count-1); - end; - rg.items := dcmStrings; - rg.BorderSpacing.Around := 8; - rg.BorderWidth:=4; - rg.AutoSize := true; - rg.HandleNeeded; - rg.GetPreferredSize(w, h); - rg.AutoSize := false; - rg.Align := alTop; - rg.Height := h; - rg.ItemIndex:=0; - //OK button - OkBtn:=TButton.create(PrefForm); - OkBtn.Caption:='OK'; - OkBtn.AutoSize := true; - //OkBtn.Left := PrefForm.Width - 128; - //OkBtn.Width:= 100; - //OkBtn.Top := rg.Height+rg.Top+4; - OkBtn.AnchorSideTop.Control := rg; - OkBtn.AnchorSideTop.Side := asrBottom; - OkBtn.AnchorSideRight.Control := PrefForm; - OkBtn.AnchorSideRight.Side := asrBottom; - OkBtn.BorderSpacing.Right := 4; - OkBtn.Anchors := [akTop, akRight]; - OkBtn.Parent:=PrefForm; - OkBtn.ModalResult:= mrOK; - //Cancel button - CancelBtn:=TButton.create(PrefForm); - CancelBtn.AutoSize := true; - CancelBtn.Caption:='Cancel'; - //CancelBtn.Left := 28; - //CancelBtn.Width:= 100; - //CancelBtn.Top := rg.Height+rg.Top+4; - CancelBtn.AnchorSideTop.Control := OkBtn; - CancelBtn.AnchorSideTop.Side := asrCenter; - CancelBtn.AnchorSideRight.Control := OkBtn; - CancelBtn.BorderSpacing.Right := 4; - CancelBtn.Anchors := [akTop, akRight]; - CancelBtn.Parent:=PrefForm; - CancelBtn.ModalResult:= mrCancel; - PrefForm.AutoSize:= true; - //PrefForm.Height:= OkBtn.Top + OkBtn.Height+4; - //{$IFDEF LCLCocoa}GLForm1.SetFormDarkMode(PrefForm); {$ENDIF} - PrefForm.ShowModal; - result := rg.Items[rg.ItemIndex];//seriesNum(rg.Items[rg.ItemIndex]); - if PrefForm.ModalResult = mrCancel then - result := ''; - FreeAndNil(PrefForm); - 123: //cleanup - dcmStrings.Free; -end; // PrefMenuClick() - -function findNiiFile(baseName: string): string; -//if baseName '~/d/img.nii' does not exist but '~/d/img_e1.nii' does -var - searchResult : tsearchrec; -begin - result := basename; - if FindFirst(changefileext(baseName, '*.nii'), faAnyFile, searchResult) = 0 then begin - result := ExtractFilePath(basename) + searchResult.Name; - FindClose(searchResult); - end; -end; - -function dcm2niiSeries(dcm2niixExe, dicomDir, series_name: string): string; -const - kdcmLoadTempStr = 'MRIcroGLTemp_'; -var - hprocess: TProcess; - series: single; - //isTemp: boolean = false; -Begin - result := ''; - //showmessage(dcm2niixExe+'>'+dicomDir+' >> '+ HomeDir); - if dcm2niixExe = '' then exit; - series := seriesNum(series_name); - if series < 1 then exit; - result := seriesName(series_name); - if result = '' then exit; - result := HomeDir+ result+'.nii'; - {$IFDEF UNIX} - if HomeDir = '/tmp/' then - //ignore - else - {$ENDIF} - if (fileexists(result)) then begin //if we do over-write, make sure temp in filename - if MessageDlg('Overwrite image '+result+'?',mtInformation,[mbAbort, mbOK],0) = mrAbort then - exit; - end; - hProcess := TProcess.Create(nil); - hProcess.Executable := dcm2niixExe; - hprocess.Parameters.Add('-n'); - hprocess.Parameters.Add(format('%g', [series])); - hprocess.Parameters.Add('-f'); - //if isTemp then - // hprocess.Parameters.Add(kdcmLoadTempStr+'%p_%t') - //else - hprocess.Parameters.Add('%p_%t'); - hprocess.Parameters.Add('-b'); - hprocess.Parameters.Add('n'); - hprocess.Parameters.Add('-z'); - hprocess.Parameters.Add('n'); - hprocess.Parameters.Add('-o'); - hprocess.Parameters.Add(HomeDir); - hprocess.Parameters.Add(dicomDir); - hProcess.Options := hProcess.Options + [poWaitOnExit, poUsePipes]; - hProcess.Execute; - hProcess.Free; - if fileexists(result) then exit; - result := findNiiFile(result); //error handling for multiple echo or coil images -end; - -function dcm2Nifti(dcm2niixExe, dicomDir: string): string; -begin - result := ''; - if dcm2niixExe = '' then exit; - result := dcmSeriesSelectForm(dcm2niixExe, dicomDir); - if result = '' then exit; - result := dcm2niiSeries(dcm2niixExe, dicomDir, result); - //showmessage(dicomDir); -end; - -end. - +unit dcm_load; + +{$mode objfpc}{$H+} +//{$DEFINE isGL} + + +interface + +uses + {$IFNDEF UNIX} Windows, shlobj, {$ENDIF} + ClipBrd, ExtCtrls, StdCtrls, Forms, Controls, Classes, SysUtils, dialogs, Process; + + +function dcm2Nifti(dcm2niixExe, dicomDir: string): string; +function HomeDir(useTmp: boolean = true): string; //set path to home if not provided + +implementation + +{$ifdef LCLCocoa} {$IFDEF isGL} +uses mainunit; //darkmode +{$ENDIF} {$ENDIF} + +function seriesName (s: string): string; //"601 myName" returns 'myName' +const + kTab = chr(9); +var + delimPos: integer; +begin + //delimPos := pos(' ',s); + delimPos := pos(kTab,s); + if (delimPos < 1) or (delimPos >= length(s)) then exit(s); + result := Copy(s, delimPos+1, maxInt); +end; + +function seriesNum (s: string): single; //"601 myName" returns 'myName' +const + kTab = chr(9); +var + delimPos: integer; + s2: string; +begin + //delimPos := pos(' ',s); + delimPos := pos(kTab,s); + if (delimPos < 1) or (delimPos >= length(s)) then exit(-1); + s2 := Copy(s, delimPos+1, maxInt); + result := StrToFloatDef(Copy(s2, 1, pos('_',s2)-1),-1); +end; + +function compareSeries(List: TStringList; Index1, Index2: Integer): Integer; +var + n1, n2: single; +begin + n1 := seriesNum(List[Index1]); + n2 := seriesNum(List[Index2]); + if (n1 >= n2) then + result := 1 + else + result := -1; + //result := n1 - n2; +end; + +function seriesCrc (s: string): double; //"601 myName" returns 601 +const + kTab = chr(9); +begin + //result := StrToFloatDef(Copy(s, 1, pos(' ',s)-1),-1); + result := StrToFloatDef(Copy(s, 1, pos(kTab,s)-1),-1); +end; + +function dcmStr(s: string): string; +const + kTab = chr(9); +var + sl: TStringList; + //s2: string; + //i: integer; +begin + result := ''; + if (length(s) < 1) or (s[1] <> chr(9)) then exit; + sl := TStringList.Create; + sl.Delimiter := #9; //TAB + sl.StrictDelimiter := true; + sl.DelimitedText := s; + if sl.Count >= 2 then begin + //result := sl[1]+' '+extractfilename(sl[sl.Count-1]) ; + result := sl[1]+kTab+extractfilename(sl[sl.Count-1]) ; + + //s2 := sl[sl.Count-1]; + //result := sl[1]+kTab+extractfilename(s2) ; + //showmessage(format('*%s*%s*', [result, s2])); + end else + result := ''; + sl.Free; +end; + +(*function dcmStr(s: string): string; +var + sl: TStringList; + s2: string; + i: integer; +begin + result := ''; + if (length(s) < 1) or (s[1] <> chr(9)) then exit; + sl := TStringList.Create; + sl.Delimiter := #9; //TAB + sl.StrictDelimiter := false; + sl.DelimitedText := s; + if sl.Count >= 2 then begin + s2 := sl[1]; + i := 2; + while (i < sl.Count) do begin //in case of space in directory name + s2 := s2 + ' ' + sl[i]; + i := i + 1; + end; + result := sl[0]+' '+extractfilename(s2) ; + end else + result := ''; + sl.Free; +end;*) + +(*procedure printf(s: string); +begin +{$IFDEF UNIX}writeln(s);{$ENDIF} +end;*) + +function dcmList(dcm2niixExe, dicomDir: string): TStringList; +//make sure to free result! +//strList := dcmList(); strList.free; +const + BUF_SIZE = 2048; // Buffer size for reading the output in chunks +var + OutputStream : TStream; + BytesRead : longint; + Buffer : array[1..BUF_SIZE] of byte; + hprocess: TProcess; + sData: TStringList; + s: string; + x: integer; +Begin + result := Tstringlist.Create; + if dcm2niixExe = '' then exit; + hProcess := TProcess.Create(nil); + hProcess.Executable := dcm2niixExe; + hprocess.Parameters.Add('-b'); + hprocess.Parameters.Add('n'); + hprocess.Parameters.Add('-n'); + hprocess.Parameters.Add('-1'); + hprocess.Parameters.Add('-f'); + hprocess.Parameters.Add('%s_%p_%t'); + {$IFDEF UNIX} + hprocess.Parameters.Add('-o'); + hprocess.Parameters.Add(HomeDir); + {$ENDIF} + hprocess.Parameters.Add(dicomDir); + hProcess.Options := hProcess.Options + [ poUsePipes, poNoConsole]; + //code below fails on Windows: http://wiki.freepascal.org/Executing_External_Programs#Reading_large_output + //hProcess.Options := hProcess.Options + [poWaitOnExit, poUsePipes, poNoConsole]; + hProcess.Execute; + OutputStream := TMemoryStream.Create; + repeat + repeat + BytesRead := hProcess.Output.Read(Buffer, BUF_SIZE); + OutputStream.Write(Buffer, BytesRead) + until BytesRead = 0; // Stop if no more data is available + until not hProcess.Running; + hProcess.Free; + sData := Tstringlist.Create; + OutputStream.Position := 0; // Required to make sure all data is copied from the start + sData.LoadFromStream(OutputStream); + OutputStream.Free; + for x := 0 to sData.Count -1 do begin + s := dcmStr(sData[x]); + //printf(s); + if (s <> '') then + result.Add(s); + end; + //next: sort (optional) + sData.Clear; + sData.AddStrings(result); + sData.CustomSort(@compareSeries); + result.Clear; + result.AddStrings(sData); + //release data + sData.Free; +end; + + +function HomeDir(useTmp: boolean = true): string; //set path to home if not provided +{$IFDEF UNIX} +begin + if useTmp then begin + result := '/tmp/'; + if fileexists(result) then exit; + end; + result := expandfilename('~/'); +end; +{$ELSE} +var + SpecialPath: PWideChar; +begin + Result := ''; + SpecialPath := WideStrAlloc(MAX_PATH); + try + FillChar(SpecialPath^, MAX_PATH, 0); + if SHGetSpecialFolderPathW(0, SpecialPath, CSIDL_PERSONAL, False) then + Result := SpecialPath+pathdelim; + finally + StrDispose(SpecialPath); + end; +end; +{$ENDIF} + +function dcmSeriesSelectForm(dcm2niixExe, dicomDir: string): string; +const + kMaxItems = 16; //https://bugs.freepascal.org/view.php?id=35789 +var + PrefForm: TForm; + rg: TRadioGroup; + dcmStrings, dcmStringsSeries: TStringlist; + OKBtn, CancelBtn: TButton; + i, w,h: integer; +label + 123; +begin + result := ''; + dcmStrings := dcmList(dcm2niixExe, dicomDir); + if dcmStrings.Count < 1 then goto 123; //no files + if dcmStrings.Count = 1 then begin + result := dcmStrings[0];//seriesNum(dcmStrings[0]); + goto 123; + end; + PrefForm:=TForm.Create(nil); + PrefForm.BorderWidth := 4; + PrefForm.Caption:='Save converted images to '+HomeDir; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + PrefForm.AutoSize:=false; + //PrefForm.Constraints.MinWidth := 400; + //radio group + rg := TRadioGroup.create(PrefForm); + rg.align := alTop; + //rg.AutoSize:=false; + rg.parent := PrefForm; + rg.caption := 'Select DICOM Series (Series_Protocol_Date)'; + if dcmStrings.Count > (kMaxItems) then begin + rg.caption := rg.caption + ' (Partial Listing)'; + while (dcmStrings.Count > kMaxItems) do + dcmStrings.Delete(dcmStrings.Count-1); + end; + {$IFDEF SHOWCRC} + rg.items := dcmStrings; + {$ELSE} + dcmStringsSeries := Tstringlist.Create; + for i := 0 to (dcmStrings.count -1) do begin + //dcmStringsSeries.add(dcmStrings[i]+'*'+seriesName(dcmStrings[i])); + dcmStringsSeries.add(seriesName(dcmStrings[i])); + end; + rg.items := dcmStringsSeries; + dcmStringsSeries.Free; + {$ENDIF} + //rg.Constraints.MaxWidth:= 300; //https://bugs.freepascal.org/view.php?id=35789 + rg.BorderSpacing.Around := 8; + rg.AutoSize := true; + rg.HandleNeeded; + rg.GetPreferredSize(w, h); + rg.Align := alTop; + rg.Height := h; + rg.ItemIndex:=0; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + OkBtn.AutoSize := true; + OkBtn.AnchorSideTop.Control := rg; + OkBtn.AnchorSideTop.Side := asrBottom; + OkBtn.AnchorSideRight.Control := PrefForm; + OkBtn.AnchorSideRight.Side := asrBottom; + OkBtn.BorderSpacing.Right := 4; + OkBtn.Anchors := [akTop, akRight]; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + //Cancel button + CancelBtn:=TButton.create(PrefForm); + CancelBtn.Caption:='Cancel'; + CancelBtn.AutoSize := true; + CancelBtn.AnchorSideTop.Control := OkBtn; + CancelBtn.AnchorSideTop.Side := asrCenter; + CancelBtn.AnchorSideRight.Control := OkBtn; + CancelBtn.BorderSpacing.Right := 4; + CancelBtn.Anchors := [akTop, akRight]; + CancelBtn.Parent:=PrefForm; + CancelBtn.ModalResult:= mrCancel; + //PrefForm.Height:= OkBtn.Top + OkBtn.Height+4; + PrefForm.AutoSize:=true; + {$IFDEF isGL} + {$IFDEF LCLCocoa}GLForm1.SetFormDarkMode(PrefForm); {$ENDIF} + {$ENDIF} + PrefForm.ShowModal; + result := dcmStrings[rg.ItemIndex]; + if PrefForm.ModalResult = mrCancel then + result := ''; + FreeAndNil(PrefForm); + 123: //cleanup + dcmStrings.Free; +end; // dcmSeriesSelectForm() + + +function findNiiFile(baseName: string): string; +//if baseName '~/d/img.nii' does not exist but '~/d/img_e1.nii' does +var + searchResult : tsearchrec; +begin + result := basename; + if FindFirst(changefileext(baseName, '*.nii'), faAnyFile, searchResult) = 0 then begin + result := ExtractFilePath(basename) + searchResult.Name; + FindClose(searchResult); + end; +end; + +function dcm2niiSeries(dcm2niixExe, dicomDir, series_name: string): string; +var + hprocess: TProcess; + seriesCR: double; +Begin + result := ''; + if dcm2niixExe = '' then exit; + seriesCR := seriesCRC(series_name); + if seriesCR < 1 then exit; + result := seriesName(series_name); + if result = '' then exit; + result := HomeDir+ result+'.nii'; + {$IFDEF UNIX} + if HomeDir = '/tmp/' then + //ignore + else + {$ENDIF} + if (fileexists(result)) then begin //if we do over-write, make sure temp in filename + if MessageDlg('Overwrite image '+result+'?',mtInformation,[mbAbort, mbOK],0) = mrAbort then + exit; + end; + hProcess := TProcess.Create(nil); + hProcess.Executable := dcm2niixExe; + hprocess.Parameters.Add('-n'); + hprocess.Parameters.Add(format('%g', [seriesCR])); + hprocess.Parameters.Add('-f'); + //if isTemp then + // hprocess.Parameters.Add(kdcmLoadTempStr+'%p_%t') + //else + hprocess.Parameters.Add('%s_%p_%t'); + hprocess.Parameters.Add('-b'); + hprocess.Parameters.Add('n'); + hprocess.Parameters.Add('-z'); + hprocess.Parameters.Add('n'); + hprocess.Parameters.Add('-o'); + hprocess.Parameters.Add(HomeDir); + hprocess.Parameters.Add(dicomDir); + //Do NOT use pipes for Windows + hProcess.Options := hProcess.Options + [poWaitOnExit, poNoConsole]; + hProcess.Execute; + hProcess.Free; + if fileexists(result) then exit; + result := findNiiFile(result); //error handling for multiple echo or coil images +end; + +function dcm2Nifti(dcm2niixExe, dicomDir: string): string; +begin + result := ''; + if dcm2niixExe = '' then exit; + if not fileexists(dcm2niixExe) then exit; + result := dcmSeriesSelectForm(dcm2niixExe, dicomDir); + if result = '' then exit; + result := dcm2niiSeries(dcm2niixExe, dicomDir, result); +end; + +end. + diff --git a/dilate.pas b/dilate.pas index 6a04013..fbeaca7 100755 --- a/dilate.pas +++ b/dilate.pas @@ -397,18 +397,18 @@ procedure BatchDilate; mrYes: lMaskBG := true; end; //case if lMaskBG then begin - if not OpenDialogExecute(kImgFilter,'Select background image (mask, e.g. gray matter mask)',false) then exit; - lBGname:= HdrForm.OpenHdrDlg.Filename; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select background image (mask, e.g. gray matter mask)',false) then exit; + lBGname:= ImgForm.OpenHdrDlg.Filename; end else lBGName := ''; lPref := gBGImg.ResliceOnLoad; gBGImg.ResliceOnLoad := false; TextForm.MemoT.Lines.clear; repeat - if not OpenDialogExecute(kImgPlusVOIFilter,'Select VOI',false) then goto 888; - lVOIname := HdrForm.OpenHdrDlg.Filename; - if not OpenDialogExecute(kImgFilter,'Select PERF image',false) then goto 888; - lPerfName := HdrForm.OpenHdrDlg.Filename; + if not ImgForm.OpenDialogExecute(kImgPlusVOIFilter,'Select VOI',false) then goto 888; + lVOIname := ImgForm.OpenHdrDlg.Filename; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select PERF image',false) then goto 888; + lPerfName := ImgForm.OpenHdrDlg.Filename; if lMaskBG then lBaseName := lBGname else @@ -536,7 +536,7 @@ procedure MakeShells; lDilateMM[1] := 6; lDilateMM[2] := 12; {$ELSE} - if not OpenDialogExecute(kImgPlusVOIFilter,'Select VOI[s] to dilate',true) then + if not ImgForm.OpenDialogExecute(kImgPlusVOIFilter,'Select VOI[s] to dilate',true) then exit; lnDilate := ReadIntForm.GetInt('Number of dilation shells ', 2,3,kMaxDilate); if (lnDilate < 2 ) or (lnDilate > kMaxDilate) then @@ -546,11 +546,11 @@ procedure MakeShells; lDilateMM[lInc] := ReadFloatForm.GetFloat('Dilated shell '+inttostr(lInc)+'s outer edge (mm). ', 0,lDilateMM[lInc-1]+3,9999); {$ENDIF} - if HdrForm.OpenHdrDlg.Files.Count < 1 then + if ImgForm.OpenHdrDlg.Files.Count < 1 then exit; - for lV := 1 to HdrForm.OpenHdrDlg.Files.Count do begin //vcx - lFilename := HdrForm.OpenHdrDlg.Files[lV-1]; + for lV := 1 to ImgForm.OpenHdrDlg.Files.Count do begin //vcx + lFilename := ImgForm.OpenHdrDlg.Files[lV-1]; ImgForm.OpenAndDisplayImg(lFileName,false); for lInc := 1 to lnDilate do begin diff --git a/graphx.pas b/graphx.pas index 3336348..45ccc2d 100755 --- a/graphx.pas +++ b/graphx.pas @@ -329,7 +329,7 @@ function TGraph4DForm.ReadGraf(lFilename: string; lBatch,lTRcritical: boolean): showmessage('You need to open a 4D image.'); goto 666; end; - if not HdrForm.OpenAndDisplayHdr(lFilename,g4DHdr) then goto 666; + if not ImgForm.OpenAndDisplayHdr(lFilename,g4DHdr) then goto 666; if not OpenImg(gBGImg,g4DHdr,false,false,false,false,true {4D!}) then goto 666; TrackBar1.Max := lnVol; if gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.PixDim[4] = 0 then begin @@ -457,32 +457,32 @@ procedure TGraph4DForm.OpenDataClick(Sender: TObject); PSPlotClick(nil); exit; {$ENDIF} - if not OpenDialogExecute(kImgFilter,'Select 4D image',false) then exit; - if not ReadGraf(HdrForm.OpenHdrDlg.Filename,false,true) then exit; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select 4D image',false) then exit; + if not ReadGraf(ImgForm.OpenHdrDlg.Filename,false,true) then exit; ImgForm.XViewEdit.value := gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[1] div 2; ImgForm.YViewEdit.value := gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[2] div 2; ImgForm.ZViewEdit.value := gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[3] div 2; - if OpenDialogExecute(kTxtFilter,'Select 3-column event onset time files [optional]',true) then begin - if HdrForm.OpenHdrDlg.Files.Count > 0 then begin - lCnt := HdrForm.OpenHdrDlg.Files.Count; + if ImgForm.OpenDialogExecute(kTxtFilter,'Select 3-column event onset time files [optional]',true) then begin + if ImgForm.OpenHdrDlg.Files.Count > 0 then begin + lCnt := ImgForm.OpenHdrDlg.Files.Count; if lCnt > kMaxCond then begin showmessage('Can only load '+inttostr(kMaxCond)+'conditions'); lCnt := kMaxCond; end; for lI := 1 to lCnt do - ReadCond(HdrForm.OpenHdrDlg.Files[lI-1],g4Ddata,lI); + ReadCond(ImgForm.OpenHdrDlg.Files[lI-1],g4Ddata,lI); end;//if count > 1 end; //if opendialog - if OpenDialogExecute(kImgPlusVOIFilter,'Select regions of interest',true) then begin - if HdrForm.OpenHdrDlg.Files.Count > 0 then begin - lCnt := HdrForm.OpenHdrDlg.Files.Count; + if ImgForm.OpenDialogExecute(kImgPlusVOIFilter,'Select regions of interest',true) then begin + if ImgForm.OpenHdrDlg.Files.Count > 0 then begin + lCnt := ImgForm.OpenHdrDlg.Files.Count; //Apr07 if lCnt > (knMaxOverlay-2) then begin showmessage('Can only load '+inttostr(knMaxOverlay-2)+'conditions'); lCnt := knMaxOverlay; end; for lI := 1 to lCnt do begin - lStr := HdrForm.OpenHdrDlg.Files[lI-1]; + lStr := ImgForm.OpenHdrDlg.Files[lI-1]; ImgForm.OverlayOpenCore(lStr,lI+kBGOverlayNum); end; end;//if count > 1 @@ -626,16 +626,16 @@ procedure TGraph4DForm.Extract4DroisClick(Sender: TObject); begin Close4DTrace(g4Ddata,true); FreeImgMemory(g4DHdr); - if not OpenDialogExecute(kImgFilter,'Select 4D image',false) then exit; - if not ReadGraf(HdrForm.OpenHdrDlg.Filename,false,true) then exit; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select 4D image',false) then exit; + if not ReadGraf(ImgForm.OpenHdrDlg.Filename,false,true) then exit; ImgForm.XViewEdit.value := gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[1] div 2; ImgForm.YViewEdit.value := gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[2] div 2; ImgForm.ZViewEdit.value := gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[3] div 2; lVolSz := gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[1]*gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[2]*gMRIcroOverlay[kBGOverlayNum].NIFTIhdr.dim[3]; - if not OpenDialogExecute(kImgPlusVOIFilter,'Select regions of interest',false) then + if not ImgForm.OpenDialogExecute(kImgPlusVOIFilter,'Select regions of interest',false) then exit; lROInum := 1+kBGOverlayNum; - lStr := HdrForm.OpenHdrDlg.Filename; + lStr := ImgForm.OpenHdrDlg.Filename; ImgForm.OverlayOpenCore(lStr,lROInum); if gMRIcroOverlay[lROInum].ImgBufferBPP <> 1 then begin showmessage('Overlay must be 8-bit image'); @@ -726,25 +726,25 @@ procedure TGraph4DForm.Batchdata1Click(Sender: TObject); ImgForm.CloseImagesClick(nil); Close4DTrace(g4Ddata,true); FreeImgMemory(g4DHdr); - if not OpenDialogExecute(kImgFilter,'Select 4D images',true) then exit; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select 4D images',true) then exit; l4D := TStringList.Create; lVectors := TStringList.Create;//empty lVOI := TStringList.Create; - l4D.AddStrings(HdrForm.OpenHdrDlg.Files); - if OpenDialogExecute(kTxtFilter,'Select 3-column event onset time files',true) then begin - if HdrForm.OpenHdrDlg.Files.Count > kMaxCond then begin + l4D.AddStrings(ImgForm.OpenHdrDlg.Files); + if ImgForm.OpenDialogExecute(kTxtFilter,'Select 3-column event onset time files',true) then begin + if ImgForm.OpenHdrDlg.Files.Count > kMaxCond then begin showmessage('Can only load '+inttostr(kMaxCond)+'conditions'); goto 111; end; - lVectors.AddStrings(HdrForm.OpenHdrDlg.Files); + lVectors.AddStrings(ImgForm.OpenHdrDlg.Files); end; - if not OpenDialogExecute(kImgPlusVOIFilter,'Select region[s] of interest',true) then + if not ImgForm.OpenDialogExecute(kImgPlusVOIFilter,'Select region[s] of interest',true) then goto 111; - if HdrForm.OpenHdrDlg.Files.Count > (knMaxOverlay-2) then begin + if ImgForm.OpenHdrDlg.Files.Count > (knMaxOverlay-2) then begin showmessage('Can only load '+inttostr(knMaxOverlay-2)+'conditions'); goto 111; end; - lVOI.AddStrings(HdrForm.OpenHdrDlg.Files); + lVOI.AddStrings(ImgForm.OpenHdrDlg.Files); if not ReadGraf(l4D[0],false, (lVectors.count > 0) ) then goto 111; //read first dataset to set TR! //get plot settings.... @@ -900,22 +900,22 @@ procedure TGraph4DForm.FSLbatch1Click(Sender: TObject); lUseFSLEVs := OKMsg('Use event vectors from the .FEAT'+pathdelim+'custom_timing_files folder?'); //shows dialog with OK/Cancel returns true if user presses OK if not lUseFSLEVs then begin lVectors.clear; - if OpenDialogExecute(kTxtFilter,'Select 3-column event onset time files',true) then begin - if HdrForm.OpenHdrDlg.Files.Count > kMaxCond then begin + if ImgForm.OpenDialogExecute(kTxtFilter,'Select 3-column event onset time files',true) then begin + if ImgForm.OpenHdrDlg.Files.Count > kMaxCond then begin showmessage('Can only load '+inttostr(kMaxCond)+'conditions'); goto 111; end; - lVectors.AddStrings(HdrForm.OpenHdrDlg.Files); + lVectors.AddStrings(ImgForm.OpenHdrDlg.Files); end; end; //manually select EVs - if not OpenDialogExecute(kImgPlusVOIFilter,'Select volume[s] of interest [2mm MNI space]',true) then + if not ImgForm.OpenDialogExecute(kImgPlusVOIFilter,'Select volume[s] of interest [2mm MNI space]',true) then goto 111; - if HdrForm.OpenHdrDlg.Files.Count > (knMaxOverlay-2) then begin + if ImgForm.OpenHdrDlg.Files.Count > (knMaxOverlay-2) then begin showmessage('Can only load '+inttostr(knMaxOverlay-2)+'conditions'); goto 111; end; - lVOI.AddStrings(HdrForm.OpenHdrDlg.Files); + lVOI.AddStrings(ImgForm.OpenHdrDlg.Files); {$ENDIF} if not ResliceFSLVOIs(lFeatDirs,lVOI) then begin showmessage('Unable to reslice VOIs!'); diff --git a/imgutil.pas b/imgutil.pas index 50d2b45..bc8a062 100755 --- a/imgutil.pas +++ b/imgutil.pas @@ -50,17 +50,17 @@ procedure BatchChangeInterceptSoVOIEqualsZero; FreeImgMemory(gMRIcroOverlay[lInc]); ImgForm.UpdateLayerMenu; - if not OpenDialogExecute(kImgPlusVOIFilter,'Select volume of interest',false) then exit; - lVOIName := HdrForm.OpenHdrDlg.FileName; - if not OpenDialogExecute(kImgFilter,'Select perfusion images',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + if not ImgForm.OpenDialogExecute(kImgPlusVOIFilter,'Select volume of interest',false) then exit; + lVOIName := ImgForm.OpenHdrDlg.FileName; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select perfusion images',true) then exit; + lNumberofFiles:= ImgForm.OpenHdrDlg.Files.Count; if lNumberofFiles < 1 then exit; TextForm.MemoT.Lines.Clear; lPref := gBGImg.ResliceOnLoad; gBGImg.ResliceOnLoad := false; for lInc:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lInc-1]; + lFilename := ImgForm.OpenHdrDlg.Files[lInc-1]; ImgForm.OpenAndDisplayImg(lFilename,false); ImgForm.OverlayOpenCore ( lVOIname, kVOIOverlayNum); lMean := UnscaledMean(kVOIOverlayNum); @@ -72,6 +72,8 @@ procedure BatchChangeInterceptSoVOIEqualsZero; lZeroHdr.scl_inter := lZeroHdr.scl_inter - lMean; lFilename := changefileprefix(lFilename,'z'); SaveAsVOIorNIFTIcore (lFilename, gMRIcroOverlay[kBGOverlayNum].ImgBuffer,gMRIcroOverlay[kBGOverlayNum].ImgBufferItems,gMRIcroOverlay[kBGOverlayNum].ImgBufferBPP,1,lZeroHdr) + //SaveAsVOIorNIFTIcore (lFilename, lImgBuffer: ByteP; lImgBufferItems, lImgBufferBPP,lnVol: integer; var lNiftiHdr: TNIFTIHdr); + end else TextForm.MemoT.Lines.Add(lFilename+' UNCHANGED (mean of VOI is already zero) '); @@ -82,4 +84,4 @@ procedure BatchChangeInterceptSoVOIEqualsZero; end; -end. \ No newline at end of file +end. diff --git a/landmarks.pas b/landmarks.pas index 302afe7..5291017 100755 --- a/landmarks.pas +++ b/landmarks.pas @@ -216,8 +216,8 @@ procedure TAnatForm.OpenAnat(lFilename: string); procedure TAnatForm.OpenBtnClick(Sender: TObject); begin - if not OpenDialogExecute(kAnatFilter,'Select background image',false) then exit; - OpenAnat(HdrForm.OpenHdrDlg.Filename) ; + if not ImgForm.OpenDialogExecute(kAnatFilter,'Select background image',false) then exit; + OpenAnat(ImgForm.OpenHdrDlg.Filename) ; end; procedure TAnatForm.Update(lIndex: integer); diff --git a/mricron.app/Contents/Info.plist b/mricron.app/Contents/Info.plist old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/PkgInfo b/mricron.app/Contents/PkgInfo old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/lut/random.lut b/mricron.app/Contents/Resources/lut/random.lut old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/mricron.icns b/mricron.app/Contents/Resources/mricron.icns old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/templates/AICHAmc.nii.gz b/mricron.app/Contents/Resources/templates/AICHAmc.nii.gz old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/templates/AICHAmc.nii.lut b/mricron.app/Contents/Resources/templates/AICHAmc.nii.lut old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/templates/AICHAmc.nii.txt b/mricron.app/Contents/Resources/templates/AICHAmc.nii.txt old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/templates/HarvardOxford-cort-maxprob-thr0-1mm.nii.gz b/mricron.app/Contents/Resources/templates/HarvardOxford-cort-maxprob-thr0-1mm.nii.gz old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/templates/inia19-NeuroMaps.nii.gz b/mricron.app/Contents/Resources/templates/inia19-NeuroMaps.nii.gz old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/templates/inia19-t1-brain.nii.gz b/mricron.app/Contents/Resources/templates/inia19-t1-brain.nii.gz old mode 100644 new mode 100755 diff --git a/mricron.app/Contents/Resources/templates/natbrainlab.nii.gz b/mricron.app/Contents/Resources/templates/natbrainlab.nii.gz old mode 100644 new mode 100755 diff --git a/mricron.lpi b/mricron.lpi index 0cc3e94..dd6d6ce 100755 --- a/mricron.lpi +++ b/mricron.lpi @@ -268,6 +268,7 @@ + diff --git a/mricron.lps b/mricron.lps old mode 100644 new mode 100755 index fa6527d..136237b --- a/mricron.lps +++ b/mricron.lps @@ -3,7 +3,7 @@ - + @@ -20,12 +20,11 @@ - + - - + + - @@ -34,10 +33,10 @@ - + - - + + @@ -62,14 +61,11 @@ - - + - + - - @@ -91,8 +87,8 @@ - - + + @@ -221,12 +217,10 @@ - + - - @@ -250,8 +244,8 @@ - - + + @@ -276,8 +270,8 @@ - - + + @@ -319,10 +313,11 @@ - + - - + + + @@ -336,12 +331,11 @@ - + - - + + - @@ -407,20 +401,18 @@ - + - - + + - - + - - + @@ -436,27 +428,27 @@ - - - + + + + + - + - - + - + - - - + + @@ -533,7 +525,8 @@ - + + @@ -734,17 +727,20 @@ - - - + + + - + + - + + + @@ -755,128 +751,157 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - - + + - + - + - - + + - - + + - - + + - - + + - - + + - - + + - - - - - - - - - - - - - - - - diff --git a/nifti_foreign.pas b/nifti_foreign.pas new file mode 100755 index 0000000..252393c --- /dev/null +++ b/nifti_foreign.pas @@ -0,0 +1,3185 @@ +unit nifti_foreign; +{$DEFINE MRIcron} +interface +{$H+} +{$DEFINE GZIP} +{$DEFINE GUI} +//{$DEFINE GL10} //define for MRIcroGL1.0, comment for MRIcroGL1.2 and later +{$H+} +{$IFDEF GL10} +{$Include isgui.inc} +{$ENDIF} +uses +{$IFDEF MRIcron}define_types,{$ENDIF} +{$IFDEF GL10} define_types, {$IFNDEF FPC}gziod,{$ELSE}gzio2,{$ENDIF}{$ENDIF} +{$IFDEF GZIP}zstream, {$ENDIF} +{$IFDEF GUI} + dialogs, +{$ELSE} + dialogsx, +{$ENDIF} +//ClipBrd, + nifti_types, sysutils, classes, StrUtils;//2015! dialogsx + +{$IFDEF GL10} +procedure NII_Clear (out lHdr: TNIFTIHdr); +procedure NII_SetIdentityMatrix (var lHdr: TNIFTIHdr); //create neutral rotation matrix +{$ELSE} +Type + mat44 = array [0..3, 0..3] of Single; + {$IFNDEF MRIcron} + ByteRA = array [1..1] of byte; + + Bytep = ^ByteRA; + procedure UnGZip(const FileName: string; buffer: bytep; offset, sz: integer); + {$ENDIF} +{$ENDIF} +function readForeignHeader (var lFilename: string; var lHdr: TNIFTIhdr; var gzBytes: int64; var swapEndian, isDimPermute2341: boolean): boolean; +procedure convertForeignToNifti(var nhdr: TNIFTIhdr); +function FSize (lFName: String): Int64; +function isTIFF(fnm: string): boolean; +procedure nifti_mat44_to_quatern( lR :mat44; var qb, qc, qd, qx, qy, qz, dx, dy, dz, qfac : single); + +implementation + +const + kNaNSingle : single = 1/0; +Type + + + vect4 = array [0..3] of Single; + mat33 = array [0..2, 0..2] of Single; + vect3 = array [0..2] of Single; + ivect3 = array [0..2] of integer; + +{$IFDEF GL10} +procedure NII_SetIdentityMatrix (var lHdr: TNIFTIHdr); //create neutral rotation matrix +var lInc: integer; +begin + with lHdr do begin + for lInc := 0 to 3 do + srow_x[lInc] := 0; + for lInc := 0 to 3 do + srow_y[lInc] := 0; + for lInc := 0 to 3 do + srow_z[lInc] := 0; + for lInc := 1 to 16 do + intent_name[lInc] := chr(0); + //next: create identity matrix: if code is switched on there will not be a problem + srow_x[0] := 1; + srow_y[1] := 1; + srow_z[2] := 1; + end; +end; //proc NIFTIhdr_IdentityMatrix + +procedure NII_Clear (out lHdr: TNIFTIHdr); +var + lInc: integer; +begin + with lHdr do begin + HdrSz := sizeof(TNIFTIhdr); + for lInc := 1 to 10 do + Data_Type[lInc] := chr(0); + for lInc := 1 to 18 do + db_name[lInc] := chr(0); + extents:=0; + session_error:= 0; + regular:='r'{chr(0)}; + dim_info:=(0); + dim[0] := 4; + for lInc := 1 to 7 do + dim[lInc] := 0; + intent_p1 := 0; + intent_p2 := 0; + intent_p3 := 0; + intent_code:=0; + datatype:=0 ; + bitpix:=0; + slice_start:=0; + for lInc := 1 to 7 do + pixdim[linc]:= 1.0; + vox_offset:= 0.0; + scl_slope := 1.0; + scl_inter:= 0.0; + slice_end:= 0; + slice_code := 0; + xyzt_units := 10; + cal_max:= 0.0; + cal_min:= 0.0; + slice_duration:=0; + toffset:= 0; + glmax:= 0; + glmin:= 0; + for lInc := 1 to 80 do + descrip[lInc] := chr(0);{80 spaces} + for lInc := 1 to 24 do + aux_file[lInc] := chr(0);{80 spaces} + {below are standard settings which are not 0} + bitpix := 16;//vc16; {8bits per pixel, e.g. unsigned char 136} + DataType := 4;//vc4;{2=unsigned char, 4=16bit int 136} + Dim[0] := 3; + Dim[1] := 256; + Dim[2] := 256; + Dim[3] := 1; + Dim[4] := 1; {n vols} + Dim[5] := 1; + Dim[6] := 1; + Dim[7] := 1; + glMin := 0; + glMax := 255; + qform_code := kNIFTI_XFORM_UNKNOWN; + sform_code:= kNIFTI_XFORM_UNKNOWN; + quatern_b := 0; + quatern_c := 0; + quatern_d := 0; + qoffset_x := 0; + qoffset_y := 0; + qoffset_z := 0; + NII_SetIdentityMatrix(lHdr); + magic := kNIFTI_MAGIC_SEPARATE_HDR; + end; //with the NIfTI header... +end; +{$ENDIF} + +function UpCaseExt(lFileName: string): string; +var lI: integer; +l2ndExt,lExt : string; +begin + lExt := ExtractFileExt(lFileName); + if length(lExt) > 0 then + for lI := 1 to length(lExt) do + lExt[lI] := upcase(lExt[lI]); + result := lExt; + if lExt <> '.GZ' then exit; + lI := length(lFileName) - 6; + if li < 1 then exit; + l2ndExt := upcase(lFileName[lI])+upcase(lFileName[lI+1])+upcase(lFileName[li+2])+upcase(lFileName[li+3]); + if (l2ndExt = '.NII')then + result := l2ndExt+lExt + else if (l2ndExt = 'BRIK') and (lI > 1) and (lFileName[lI-1] = '.') then + result := '.BRIK'+lExt; +end; + +{$IFNDEF GL10} +procedure UnGZip(const FileName: string; buffer: bytep; offset, sz: integer); +{$IFDEF GZIP} +var + decomp: TGZFileStream; + skip: array of byte; +begin + decomp := TGZFileStream.create(FileName, gzopenread); + if offset > 0 then begin + setlength(skip, offset); + decomp.Read(skip[0], offset); + end; + decomp.Read(buffer[0], sz); + decomp.free; +end; +{$ELSE} +begin + {$IFDEF UNIX} writeln('Recompile with GZ support!'); {$ENDIF} +end; +{$ENDIF} +{$ENDIF} +(* function isECAT(fnm: string): boolean; + type + THdrMain = packed record //Next: ECAT signature + magic: array[1..14] of char; + end; + var + f: file; + mhdr: THdrMain; + begin + result := false; + if not fileexists(fnm) then exit; + if DirectoryExists(fnm) then exit; + if FSize(fnm) < 32 then exit; + {$I-} + AssignFile(f, fnm); + FileMode := fmOpenRead; //Set file access to read only + Reset(f, 1); + {$I+} + if ioresult <> 0 then + exit; + BlockRead(f, mhdr, sizeof(mhdr)); + closefile(f); + if ((mhdr.magic[1] <> 'M') or (mhdr.magic[2] <> 'A') or (mhdr.magic[3] <> 'T') or (mhdr.magic[4] <> 'R') or (mhdr.magic[5] <> 'I') or (mhdr.magic[6] <> 'X')) then + exit; + result := true; + end; *) + function FSize (lFName: String): Int64; +var SearchRec: TSearchRec; +begin + result := 0; + if not fileexists(lFName) then exit; + FindFirst(lFName, faAnyFile, SearchRec); + result := SearchRec.size; + FindClose(SearchRec); +end; + + function Swap2(s : SmallInt): smallint; + type + swaptype = packed record + case byte of + 0:(Word1 : word); //word is 16 bit + 1:(Small1: SmallInt); + end; + swaptypep = ^swaptype; + var + inguy:swaptypep; + outguy:swaptype; + begin + inguy := @s; //assign address of s to inguy + outguy.Word1 := swap(inguy^.Word1); + result :=outguy.Small1; + end; + +procedure Xswap4r ( var s:single); +type + swaptype = packed record + case byte of + 0:(Word1,Word2 : word); //word is 16 bit + end; + swaptypep = ^swaptype; +var + inguy:swaptypep; + outguy:swaptype; +begin + inguy := @s; //assign address of s to inguy + outguy.Word1 := swap(inguy^.Word2); + outguy.Word2 := swap(inguy^.Word1); + inguy^.Word1 := outguy.Word1; + inguy^.Word2 := outguy.Word2; +end; + +procedure swap4(var s : LongInt); +type + swaptype = packed record + case byte of + 0:(Word1,Word2 : word); //word is 16 bit + 1:(Long:LongInt); + end; + swaptypep = ^swaptype; +var + inguy:swaptypep; + outguy:swaptype; +begin + inguy := @s; //assign address of s to inguy + outguy.Word1 := swap(inguy^.Word2); + outguy.Word2 := swap(inguy^.Word1); + s:=outguy.Long; +end; + + +procedure pswap4r ( var s:single); +type + swaptype = packed record + case byte of + 0:(Word1,Word2 : word); //word is 16 bit + end; + swaptypep = ^swaptype; +var + inguy:swaptypep; + outguy:swaptype; +begin + inguy := @s; //assign address of s to inguy + outguy.Word1 := swap(inguy^.Word2); + outguy.Word2 := swap(inguy^.Word1); + inguy^.Word1 := outguy.Word1; + inguy^.Word2 := outguy.Word2; +end; //proc Xswap4r + +procedure pswap4i(var s : LongInt); +type + swaptype = packed record + case byte of + 0:(Word1,Word2 : word); //word is 16 bit + 1:(Long:LongInt); + end; + swaptypep = ^swaptype; +var + inguy:swaptypep; + outguy:swaptype; +begin + inguy := @s; //assign address of s to inguy + outguy.Word1 := swap(inguy^.Word2); + outguy.Word2 := swap(inguy^.Word1); + s:=outguy.Long; +end; //proc swap4 + +function swap64r(s : double):double; +type + swaptype = packed record + case byte of + 0:(Word1,Word2,Word3,Word4 : word); //word is 16 bit + 1:(float:double); + end; + swaptypep = ^swaptype; +var + inguy:swaptypep; + outguy:swaptype; +begin + inguy := @s; //assign address of s to inguy + outguy.Word1 := swap(inguy^.Word4); + outguy.Word2 := swap(inguy^.Word3); + outguy.Word3 := swap(inguy^.Word2); + outguy.Word4 := swap(inguy^.Word1); + try + swap64r:=outguy.float; + except + swap64r := 0; + exit; + end;{} +end; + +FUNCTION specialsingle (var s:single): boolean; +//returns true if s is Infinity, NAN or Indeterminate +//4byte IEEE: msb[31] = signbit, bits[23-30] exponent, bits[0..22] mantissa +//exponent of all 1s = Infinity, NAN or Indeterminate +CONST kSpecialExponent = 255 shl 23; +VAR Overlay: LongInt ABSOLUTE s; +BEGIN + IF ((Overlay AND kSpecialExponent) = kSpecialExponent) THEN + RESULT := true + ELSE + RESULT := false; +END; + +function isBioFormats(fnm: string): string; +//detect LIF and LIFF format or other Imagej/Fiji Bioformat +const + LIF_MAGIC_BYTE = $70; + LIF_MEMORY_BYTE = $2a; +var + f: file; + bs: array[0..255] of byte; +begin + result := ''; + if not fileexists(fnm) then exit; + if DirectoryExists(fnm) then exit; + if FSize(fnm) < 256 then exit; + {$I-} + AssignFile(f, fnm); + FileMode := fmOpenRead; //Set file access to read only + Reset(f, 1); + {$I+} + if ioresult <> 0 then + exit; + BlockRead(f, bs, sizeof(bs)); //Byte-order Identifier + if (bs[8] = LIF_MEMORY_BYTE) and ((bs[0] = LIF_MAGIC_BYTE) or (bs[3] = LIF_MAGIC_BYTE)) then + result := 'LIF'; //file can be read using LIFReader.java + if (bs[4] = ord('i')) and (bs[5] = ord('m')) and (bs[6] = ord('p')) and (bs[7] = ord('r')) then + result := 'LIFF'; //Openlab LIFF format OpenLabReader.java + if (bs[0] = $D0) and (bs[1] = $CF) and (bs[2] = $11) and (bs[3] = $E0) then //IPW_MAGIC_BYTES = 0xd0cf11e0 + result := 'IPW'; //IPWReader.java + if (bs[0] = ord('i')) and (bs[1] = ord('i')) and (bs[2] = ord('i')) and (bs[3] = ord('i')) then + result := 'IPL';//IPLabReader.java + if (bs[0] = $89) and (bs[1] = $48) and (bs[2] = $44) and (bs[3] = $46) then //IPW_MAGIC_BYTES = 0xd0cf11e0 + result := 'HDF';//Various readers: ImarisHDFReader, CellH5Reader, etc + if (bs[0] = $DA) and (bs[1] = $CE) and (bs[2] = $BE) and (bs[3] = $0A) then//DA CE BE 0A + result := 'ND2';//MAGIC_BYTES_1 ND2Reader + if (bs[0] = $6a) and (bs[1] = $50) and (bs[2] = $20) and (bs[3] = $20) then + result := 'ND2';//MAGIC_BYTES_2 ND2Reader + if (bs[208] = $4D) and (bs[209] = $41) and (bs[210] = $50) then + result := 'MAP';//MRCReader http://www.ccpem.ac.uk/mrc_format/mrc2014.php + //GatanReader.java + closefile(f); +end; + + function isTIFF(fnm: string): boolean; + var + f: file; + w: word; + begin + result := false; + if not fileexists(fnm) then exit; + if DirectoryExists(fnm) then exit; + if FSize(fnm) < 32 then exit; + {$I-} + AssignFile(f, fnm); + FileMode := fmOpenRead; //Set file access to read only + Reset(f, 1); + {$I+} + if ioresult <> 0 then + exit; + w := 0; + BlockRead(f, w, sizeof(w)); //Byte-order Identifier + if (w = $4D4D) or (w = $4949) then + result := true; + closefile(f); + end; + +{$IFDEF GUI} +procedure ShowMsg(s: string); +begin + Showmessage(s); +end; +{$ENDIF} + +procedure fromMatrix (m: mat44; var r11,r12,r13,r21,r22,r23,r31,r32,r33: double); +begin + r11 := m[0,0]; + r12 := m[0,1]; + r13 := m[0,2]; + r21 := m[1,0]; + r22 := m[1,1]; + r23 := m[1,2]; + r31 := m[2,0]; + r32 := m[2,1]; + r33 := m[2,2]; +end; + +function Matrix2D (r11,r12,r13,r21,r22,r23,r31,r32,r33: double): mat33; +begin + result[0,0] := r11; + result[0,1] := r12; + result[0,2] := r13; + result[1,0] := r21; + result[1,1] := r22; + result[1,2] := r23; + result[2,0] := r31; + result[2,1] := r32; + result[2,2] := r33; +end; + +function nifti_mat33_determ( R: mat33 ):double; //* determinant of 3x3 matrix */ +begin + result := r[0,0]*r[1,1]*r[2,2] + -r[0,0]*r[2,1]*r[1,2] + -r[1,0]*r[0,1]*r[2,2] + +r[1,0]*r[2,1]*r[0,2] + +r[2,0]*r[0,1]*r[1,2] + -r[2,0]*r[1,1]*r[0,2] ; +end; + +function nifti_mat33_rownorm( A: mat33 ): single; // max row norm of 3x3 matrix +var + r1,r2,r3: single ; +begin + r1 := abs(A[0,0])+abs(A[0,1])+abs(A[0,2]); + r2 := abs(A[1,0])+abs(A[1,1])+abs(A[1,2]); + r3 := abs(A[2,0])+abs(A[2,1])+abs(A[2,2]); + if( r1 < r2 ) then r1 := r2 ; + if( r1 < r3 ) then r1 := r3 ; + result := r1 ; +end; + +procedure fromMatrix33 (m: mat33; var r11,r12,r13,r21,r22,r23,r31,r32,r33: double); +begin + r11 := m[0,0]; + r12 := m[0,1]; + r13 := m[0,2]; + r21 := m[1,0]; + r22 := m[1,1]; + r23 := m[1,2]; + r31 := m[2,0]; + r32 := m[2,1]; + r33 := m[2,2]; +end; + + +function nifti_mat33_inverse( R: mat33 ): mat33; //* inverse of 3x3 matrix */ +var + r11,r12,r13,r21,r22,r23,r31,r32,r33 , deti: double ; +begin + FromMatrix33(R,r11,r12,r13,r21,r22,r23,r31,r32,r33); + deti := r11*r22*r33-r11*r32*r23-r21*r12*r33 + +r21*r32*r13+r31*r12*r23-r31*r22*r13 ; + if( deti <> 0.0 ) then deti := 1.0 / deti ; + result[0,0] := deti*( r22*r33-r32*r23) ; + result[0,1] := deti*(-r12*r33+r32*r13) ; + result[0,2] := deti*( r12*r23-r22*r13) ; + result[1,0] := deti*(-r21*r33+r31*r23) ; + result[1,1] := deti*( r11*r33-r31*r13) ; + result[1,2] := deti*(-r11*r23+r21*r13) ; + result[2,0] := deti*( r21*r32-r31*r22) ; + result[2,1] := deti*(-r11*r32+r31*r12) ; + result[2,2] := deti*( r11*r22-r21*r12) ; +end; + +function nifti_mat33_colnorm( A: mat33 ): single; //* max column norm of 3x3 matrix */ +var + r1,r2,r3: single ; +begin + r1 := abs(A[0,0])+abs(A[1,0])+abs(A[2,0]) ; + r2 := abs(A[0,1])+abs(A[1,1])+abs(A[2,1]) ; + r3 := abs(A[0,2])+abs(A[1,2])+abs(A[2,2]) ; + if( r1 < r2 ) then r1 := r2 ; + if( r1 < r3 ) then r1 := r3 ; + result := r1 ; +end; + +function nifti_mat33_polar( A: mat33 ): mat33; +var + k:integer; + X , Y , Z: mat33 ; + dif,alp,bet,gam,gmi : single; +begin + dif := 1; + k := 0; + X := A ; + gam := nifti_mat33_determ(X) ; + while( gam = 0.0 )do begin //perturb matrix + gam := 0.00001 * ( 0.001 + nifti_mat33_rownorm(X) ) ; + X[0,0] := X[0,0]+gam ; + X[1,1] := X[1,1]+gam ; + X[2,2] := X[2,2] +gam ; + gam := nifti_mat33_determ(X) ; + end; + while true do begin + Y := nifti_mat33_inverse(X) ; + if( dif > 0.3 )then begin // far from convergence + alp := sqrt( nifti_mat33_rownorm(X) * nifti_mat33_colnorm(X) ) ; + bet := sqrt( nifti_mat33_rownorm(Y) * nifti_mat33_colnorm(Y) ) ; + gam := sqrt( bet / alp ) ; + gmi := 1.0 / gam ; + end else begin + gam := 1.0; + gmi := 1.0 ; //close to convergence + end; + Z[0,0] := 0.5 * ( gam*X[0,0] + gmi*Y[0,0] ) ; + Z[0,1] := 0.5 * ( gam*X[0,1] + gmi*Y[1,0] ) ; + Z[0,2] := 0.5 * ( gam*X[0,2] + gmi*Y[2,0] ) ; + Z[1,0] := 0.5 * ( gam*X[1,0] + gmi*Y[0,1] ) ; + Z[1,1] := 0.5 * ( gam*X[1,1] + gmi*Y[1,1] ) ; + Z[1,2] := 0.5 * ( gam*X[1,2] + gmi*Y[2,1] ) ; + Z[2,0] := 0.5 * ( gam*X[2,0] + gmi*Y[0,2] ) ; + Z[2,1] := 0.5 * ( gam*X[2,1] + gmi*Y[1,2] ) ; + Z[2,2] := 0.5 * ( gam*X[2,2] + gmi*Y[2,2] ) ; + dif := abs(Z[0,0]-X[0,0])+abs(Z[0,1]-X[0,1])+abs(Z[0,2]-X[0,2]) + +abs(Z[1,0]-X[1,0])+abs(Z[1,1]-X[1,1])+abs(Z[1,2]-X[1,2]) + +abs(Z[2,0]-X[2,0])+abs(Z[2,1]-X[2,1])+abs(Z[2,2]-X[2,2]); + k := k+1 ; + if( k > 100) or (dif < 3.e-6 ) then begin + result := Z; + break ; //convergence or exhaustion + end; + X := Z ; + end; + result := Z ; +end; + +procedure nifti_mat44_to_quatern( lR :mat44; var qb, qc, qd, qx, qy, qz, dx, dy, dz, qfac : single); +var + r11,r12,r13 , r21,r22,r23 , r31,r32,r33, xd,yd,zd , a,b,c,d : double; + P,Q: mat33; //3x3 +begin + // offset outputs are read write out of input matrix + qx := lR[0,3]; + qy := lR[1,3]; + qz := lR[2,3]; + //load 3x3 matrix into local variables + fromMatrix(lR,r11,r12,r13,r21,r22,r23,r31,r32,r33); + //compute lengths of each column; these determine grid spacings + xd := sqrt( r11*r11 + r21*r21 + r31*r31 ) ; + yd := sqrt( r12*r12 + r22*r22 + r32*r32 ) ; + zd := sqrt( r13*r13 + r23*r23 + r33*r33 ) ; + //if a column length is zero, patch the trouble + if( xd = 0.0 )then begin r11 := 1.0 ; r21 := 0; r31 := 0.0 ; xd := 1.0 ; end; + if( yd = 0.0 )then begin r22 := 1.0 ; r12 := 0; r32 := 0.0 ; yd := 1.0 ; end; + if( zd = 0.0 )then begin r33 := 1.0 ; r13 := 0; r23 := 0.0 ; zd := 1.0 ; end; + //assign the output lengths + dx := xd; + dy := yd; + dz := zd; + //normalize the columns + r11 := r11/xd ; r21 := r21/xd ; r31 := r31/xd ; + r12 := r12/yd ; r22 := r22/yd ; r32 := r32/yd ; + r13 := r13/zd ; r23 := r23/zd ; r33 := r33/zd ; + { At this point, the matrix has normal columns, but we have to allow + for the fact that the hideous user may not have given us a matrix + with orthogonal columns. So, now find the orthogonal matrix closest + to the current matrix. + One reason for using the polar decomposition to get this + orthogonal matrix, rather than just directly orthogonalizing + the columns, is so that inputting the inverse matrix to R + will result in the inverse orthogonal matrix at this point. + If we just orthogonalized the columns, this wouldn't necessarily hold.} + Q := Matrix2D (r11,r12,r13, // 2D "graphics" matrix + r21,r22,r23, + r31,r32,r33); + P := nifti_mat33_polar(Q) ; //P is orthog matrix closest to Q + FromMatrix33(P,r11,r12,r13,r21,r22,r23,r31,r32,r33); +{ [ r11 r12 r13 ] + at this point, the matrix [ r21 r22 r23 ] is orthogonal + [ r31 r32 r33 ] + compute the determinant to determine if it is proper} + + zd := r11*r22*r33-r11*r32*r23-r21*r12*r33 + +r21*r32*r13+r31*r12*r23-r31*r22*r13 ; //should be -1 or 1 + + if( zd > 0 )then begin // proper + qfac := 1.0 ; + end else begin //improper ==> flip 3rd column + qfac := -1.0 ; + r13 := -r13 ; r23 := -r23 ; r33 := -r33 ; + end; + // now, compute quaternion parameters + a := r11 + r22 + r33 + 1.0; + if( a > 0.5 ) then begin //simplest case + a := 0.5 * sqrt(a) ; + b := 0.25 * (r32-r23) / a ; + c := 0.25 * (r13-r31) / a ; + d := 0.25 * (r21-r12) / a ; + end else begin //trickier case + xd := 1.0 + r11 - (r22+r33) ;// 4*b*b + yd := 1.0 + r22 - (r11+r33) ;// 4*c*c + zd := 1.0 + r33 - (r11+r22) ;// 4*d*d + if( xd > 1.0 ) then begin + b := 0.5 * sqrt(xd) ; + c := 0.25* (r12+r21) / b ; + d := 0.25* (r13+r31) / b ; + a := 0.25* (r32-r23) / b ; + end else if( yd > 1.0 ) then begin + c := 0.5 * sqrt(yd) ; + b := 0.25* (r12+r21) / c ; + d := 0.25* (r23+r32) / c ; + a := 0.25* (r13-r31) / c ; + end else begin + d := 0.5 * sqrt(zd) ; + b := 0.25* (r13+r31) / d ; + c := 0.25* (r23+r32) / d ; + a := 0.25* (r21-r12) / d ; + end; + if( a < 0.0 )then begin b:=-b ; c:=-c ; d:=-d; {a:=-a; this is not used} end; + end; + qb := b ; + qc := c ; + qd := d ; +end; + +procedure ZERO_MAT44(var m: mat44); //note sets m[3,3] to one +var + i,j: integer; +begin + for i := 0 to 3 do + for j := 0 to 3 do + m[i,j] := 0.0; + m[3,3] := 1; +end; + +procedure LOAD_MAT33(out m: mat33; m00,m01,m02, m10,m11,m12, m20,m21,m22: single); +begin + m[0,0] := m00; + m[0,1] := m01; + m[0,2] := m02; + m[1,0] := m10; + m[1,1] := m11; + m[1,2] := m12; + m[2,0] := m20; + m[2,1] := m21; + m[2,2] := m22; +end; + +function nifti_mat33vec_mul(m: mat33; v: vect3): vect3; +var + i: integer; +begin + for i := 0 to 2 do + result[i] := (v[0]*m[i,0])+(v[1]*m[i,1])+(v[2]*m[i,2]); +end; + +function nifti_mat33_mul( A,B: mat33): mat33; +var + i,j: integer; +begin + for i:=0 to 2 do + for j:=0 to 2 do + result[i,j] := A[i,0] * B[0,j] + + A[i,1] * B[1,j] + + A[i,2] * B[2,j] ; +end; + +procedure LOAD_MAT44(var m: mat44; m00,m01,m02,m03, m10,m11,m12,m13, m20,m21,m22,m23: single); +begin + m[0,0] := m00; + m[0,1] := m01; + m[0,2] := m02; + m[0,3] := m03; + m[1,0] := m10; + m[1,1] := m11; + m[1,2] := m12; + m[1,3] := m13; + m[2,0] := m20; + m[2,1] := m21; + m[2,2] := m22; + m[2,3] := m23; + m[3,0] := 0.0; + m[3,1] := 0.0; + m[3,2] := 0.0; + m[3,3] := 1.0; +end; + +function validMatrix(var m: mat44): boolean; +var + i: integer; +begin + result := false; + for i := 0 to 2 do begin + if (m[0,i] = 0.0) and (m[1,i] = 0.0) and (m[2,i] = 0.0) then exit; + if (m[i,0] = 0.0) and (m[i,1] = 0.0) and (m[i,2] = 0.0) then exit; + end; + result := true; +end; + +procedure convertForeignToNifti(var nhdr: TNIFTIhdr); +var + i,nonSpatialMult: integer; + qto_xyz: mat44; + //dumqx, dumqy, dumqz, + dumdx, dumdy, dumdz: single; +begin + nhdr.HdrSz := 348; //used to signify header does not need to be byte-swapped + nhdr.magic:=kNIFTI_MAGIC_EMBEDDED_HDR; + if (nhdr.dim[3] = 0) then nhdr.dim[3] := 1; //for 2D images the 3rd dim is not specified and set to zero + nhdr.dim[0] := 3; //for 2D images the 3rd dim is not specified and set to zero + nonSpatialMult := 1; + for i := 4 to 7 do + if nhdr.dim[i] > 0 then + nonSpatialMult := nonSpatialMult * nhdr.dim[i]; + if (nonSpatialMult > 1) then begin + nhdr.dim[0] := 4; + nhdr.dim[4] := nonSpatialMult; + for i := 5 to 7 do + nhdr.dim[i] := 0; + end; + nhdr.bitpix := 8; + if (nhdr.datatype = 4) or (nhdr.datatype = 512) then nhdr.bitpix := 16; + if (nhdr.datatype = 8) or (nhdr.datatype = 16) or (nhdr.datatype = 768) then nhdr.bitpix := 32; + if (nhdr.datatype = 32) or (nhdr.datatype = 64) or (nhdr.datatype = 1024) or (nhdr.datatype = 1280) then nhdr.bitpix := 64; + LOAD_MAT44(qto_xyz, nhdr.srow_x[0], nhdr.srow_x[1], nhdr.srow_x[2], nhdr.srow_x[3], + nhdr.srow_y[0], nhdr.srow_y[1], nhdr.srow_y[2], nhdr.srow_y[3], + nhdr.srow_z[0], nhdr.srow_z[1], nhdr.srow_z[2], nhdr.srow_z[3]); + if not validMatrix(qto_xyz) then begin + nhdr.sform_code := 0; + nhdr.qform_code := 0; + for i := 0 to 3 do begin + nhdr.srow_x[i] := 0; + nhdr.srow_y[i] := 0; + nhdr.srow_z[i] := 0; + end; + nhdr.srow_x[0] := 1; + nhdr.srow_y[1] := 1; + nhdr.srow_z[2] := 1; + exit; + end; + nhdr.sform_code := 1; + nifti_mat44_to_quatern( qto_xyz , nhdr.quatern_b, nhdr.quatern_c, nhdr.quatern_d,nhdr.qoffset_x,nhdr.qoffset_y,nhdr.qoffset_z, dumdx, dumdy, dumdz,nhdr.pixdim[0]) ; + nhdr.qform_code := 0;//kNIFTI_XFORM_SCANNER_ANAT; +end; + +procedure NSLog( str: string); +begin + {$IFDEF GUI} + showmsg(str); + {$ENDIF} + {$IFDEF UNIX}writeln(str);{$ENDIF} +end; + +function parsePicString(s: string): single; +//given "AXIS_4 001 0.000000e+00 4.000000e-01 microns" return 0.4 +var + sList : TStringList; +begin + result := 0.0; + DecimalSeparator := '.'; + sList := TStringList.Create; + sList.Delimiter := ' '; // Each list item will be blank separated + sList.DelimitedText := s; + if sList.Count > 4 then begin + //ShowMessage(sList[3]); + try + result := StrToFloat(sList[3]); // Middle blanks are not supported + except + //ShowMessage(Exception.Message); + end; + end; + sList.Free; +end; + +function nii_readVmr (var fname: string; isV16: boolean; var nhdr: TNIFTIhdr; var swapEndian: boolean): boolean; +//http://support.brainvoyager.com/automation-aamp-development/23-file-formats/385-developer-guide-26-the-format-of-vmr-files.html +Type + Tvmr_header = packed record //Next: VMR Format Header structure + ver, nx, ny, nz: word; // 0,4,8,12 + end; // Tbv_header; + (*Tvmr_tail = packed record // + Xoff,Yoff,Zoff,FramingCube: int16; //v3 + PosFlag,CoordSystem: int32; + X1, Y1, Z1,Xn,Yn,Zn, RXv,RYv,RZv, CXv,CYv,CZv: single; + nRmat, nCmat: int32; + Rfov, Cfov, Zthick, Zgap: single; + nTrans: int32; + LRconv: uint8; + vXres, vYres, vZres: single; + isResVerified, isTal: uint8; + min, mean, max: int32; + end; *) +var + vhdr : Tvmr_header; + //vtail : Tvmr_tail; + lHdrFile: file; + xSz, nvox, FSz, Hsz : integer; +begin + result := false; + {$I-} + AssignFile(lHdrFile, fname); + FileMode := fmOpenRead; //Set file access to read only + Reset(lHdrFile, 1); + {$I+} + if ioresult <> 0 then begin + NSLog('Error in reading vmr header.'+inttostr(IOResult)); + FileMode := 2; + exit; + end; + FSz := Filesize(lHdrFile); + BlockRead(lHdrFile, vhdr, sizeof(Tvmr_header)); + nVox := vhdr.nx * vhdr.ny * vhdr.nz; + if isV16 then + xSz := (2 * nVox) + sizeof(Tvmr_header) + else + xSz := nVox + sizeof(Tvmr_header);//+ sizeof(Tvmr_tail); + Hsz := sizeof(Tvmr_header); + if (xSz > FSz) then begin //version 1? (6 byte header) + nVox := vhdr.ver * vhdr.nx * vhdr.ny; + if isV16 then + xSz := (2 * nVox) + 6 + else + xSz := nVox + 6; + if (xSz = FSz) then begin //version 1 + vhdr.nz := vhdr.ny; + vhdr.ny := vhdr.nx; + vhdr.nx := vhdr.ver; + vhdr.ver := 1; + Hsz := 6; + end; + end; + if (xSz > FSz) then begin //docs do not specify endian - wrong endian? + showmessage(format('Odd v16 or vmr format image %dx%dx%d ver %d sz %d', [vhdr.nx, vhdr.ny, vhdr.nz, vhdr.ver, FSz] )); + CloseFile(lHdrFile); + exit; + end; + //seek(lHdrFile, nVox + sizeof(Tvmr_header)); + //BlockRead(lHdrFile, vtail, sizeof(Tvmr_tail)); + CloseFile(lHdrFile); + swapEndian := false; + nhdr.dim[0]:=3;//3D + nhdr.dim[1]:=vhdr.nx; + nhdr.dim[2]:=vhdr.ny; + nhdr.dim[3]:=vhdr.nz; + nhdr.dim[4]:=1; + nhdr.pixdim[1]:=1.0; + nhdr.pixdim[2]:=1.0; + nhdr.pixdim[3]:=1.0; + //Need examples + //if vtail.isResVerified > 0 then begin + // showmessage(format('%g %g %g',[vtail.X1, vtail.Y1, vtail.Z1])); + //end; + nhdr.bitpix:= 8; + nhdr.datatype := kDT_UNSIGNED_CHAR; + if isV16 then begin + nhdr.bitpix:= 16; + nhdr.datatype := kDT_INT16; + end; + nhdr.vox_offset := HSz; + nhdr.sform_code := 1; + nhdr.srow_x[0]:=nhdr.pixdim[1];nhdr.srow_x[1]:=0.0;nhdr.srow_x[2]:=0.0;nhdr.srow_x[3]:=0.0; + nhdr.srow_y[0]:=0.0;nhdr.srow_y[1]:=nhdr.pixdim[2];nhdr.srow_y[2]:=0.0;nhdr.srow_y[3]:=0.0; + nhdr.srow_z[0]:=0.0;nhdr.srow_z[1]:=0.0;nhdr.srow_z[2]:=-nhdr.pixdim[3];nhdr.srow_z[3]:=0.0; + convertForeignToNifti(nhdr); + //nhdr.scl_inter:= 1; + //nhdr.scl_slope := -1; + result := true; +end; //nii_readVmr() + +function nii_readBVox (var fname: string; var nhdr: TNIFTIhdr; var swapEndian: boolean): boolean; +//http://pythology.blogspot.com/2014/08/you-can-do-cool-stuff-with-manual.html +Type + Tbv_header = packed record //Next: PIC Format Header structure + nx, ny, nz, nvol : LongInt; // 0,4,8,12 + end; // Tbv_header; +var + bhdr : Tbv_header; + lHdrFile: file; + nvox, nvoxswap, FSz : integer; +begin + result := false; + {$I-} + AssignFile(lHdrFile, fname); + FileMode := fmOpenRead; //Set file access to read only + Reset(lHdrFile, 1); + {$I+} + if ioresult <> 0 then begin + NSLog('Error in reading BVox header.'+inttostr(IOResult)); + FileMode := 2; + exit; + end; + FSz := Filesize(lHdrFile); + BlockRead(lHdrFile, bhdr, sizeof(Tbv_header)); + CloseFile(lHdrFile); + swapEndian := false; + nVox := bhdr.nx * bhdr.ny * bhdr.nz * bhdr.nvol * 4; //*4 as 32-bpp + if (nVox + sizeof(Tbv_header) ) <> FSz then begin + swapEndian := true; + pswap4i(bhdr.nx); + pswap4i(bhdr.ny); + pswap4i(bhdr.nz); + pswap4i(bhdr.nvol); + nVoxSwap := bhdr.nx * bhdr.ny * bhdr.nz * bhdr.nvol * 4; //*4 as 32-bpp + if (nVoxSwap + sizeof(Tbv_header) ) <> FSz then begin + NSLog(format('Not a valid BVox file: expected filesize of %d or %d bytes (%dx%dx%dx%d)',[nVoxSwap,nVox, bhdr.nx, bhdr.ny, bhdr.nz, bhdr.nvol])); + exit; + end; + + end; + if (bhdr.nvol > 1) then + nhdr.dim[0]:=4//4D + else + nhdr.dim[0]:=3;//3D + nhdr.dim[1]:=bhdr.nx; + nhdr.dim[2]:=bhdr.ny; + nhdr.dim[3]:=bhdr.nz; + nhdr.dim[4]:=bhdr.nvol; + nhdr.pixdim[1]:=1.0; + nhdr.pixdim[2]:=1.0; + nhdr.pixdim[3]:=1.0; + nhdr.datatype := kDT_FLOAT32; + nhdr.vox_offset := sizeof(Tbv_header); + nhdr.sform_code := 1; + nhdr.srow_x[0]:=nhdr.pixdim[1];nhdr.srow_x[1]:=0.0;nhdr.srow_x[2]:=0.0;nhdr.srow_x[3]:=0.0; + nhdr.srow_y[0]:=0.0;nhdr.srow_y[1]:=nhdr.pixdim[2];nhdr.srow_y[2]:=0.0;nhdr.srow_y[3]:=0.0; + nhdr.srow_z[0]:=0.0;nhdr.srow_z[1]:=0.0;nhdr.srow_z[2]:=-nhdr.pixdim[3];nhdr.srow_z[3]:=0.0; + convertForeignToNifti(nhdr); + //nhdr.scl_inter:= 1; + //nhdr.scl_slope := -1; + result := true; +end; //nii_readBVox + +function nii_readDeltaVision (var fname: string; var nhdr: TNIFTIhdr; var swapEndian: boolean): boolean; +const + kDV_HEADER_SIZE = 1024; + kSIG_NATIVE = 49312; + kSIG_SWAPPED = 41152; +Type + Tdv_header = packed record //Next: PIC Format Header structure + nx, ny, nz, datatype : LongInt; // 0,4,8,12 + pad0: array [1..24] of char; //padding 16..39 + xDim,yDim,zDim : single; //40,44,48 + pad1: array [1..40] of char; //padding 52..91 + ExtendedHeaderSize: LongInt; //92 + sig: word; //96 + pad2: array [1..82] of char; //padding 98..179 + numTimes : int32; //180 + pad3: array [1..12] of char;//padding 184..195 + numChannels : word; //196 + pad4: array [1..10] of char;//padding 198..207 + xOri, yOri, zOri: single; //208,212,216 + pad5: array [1..804] of char;//padding 220..1024 + //padding + end; // Tdv_header; +var + bhdr : Tdv_header; + lHdrFile: file; + sizeZ, sizeT: integer; +begin + result := false; + {$I-} + AssignFile(lHdrFile, fname); + FileMode := fmOpenRead; //Set file access to read only + Reset(lHdrFile, 1); + {$I+} + if ioresult <> 0 then begin + NSLog('Error in reading DeltaVision header.'+inttostr(IOResult)); + FileMode := 2; + exit; + end; + BlockRead(lHdrFile, bhdr, sizeof(Tdv_header)); + CloseFile(lHdrFile); + if (bhdr.sig <> kSIG_NATIVE) and (bhdr.sig <> kSIG_SWAPPED) then begin //signature not found! + NSLog('Error in reading DeltaVision file (signature not correct).'); + exit; + end; + swapEndian := false; + if (bhdr.sig = kSIG_SWAPPED) then begin + swapEndian := true; + pswap4i(bhdr.nx); + pswap4i(bhdr.ny); + pswap4i(bhdr.nz); + pswap4r(bhdr.xDim); + pswap4r(bhdr.yDim); + pswap4r(bhdr.zDim); + pswap4i(bhdr.ExtendedHeaderSize); + bhdr.sig := swap(bhdr.sig); + pswap4i(bhdr.numTimes); + bhdr.numChannels := swap(bhdr.numChannels); + pswap4r(bhdr.xOri); + pswap4r(bhdr.yOri); + pswap4r(bhdr.zOri); + end; + sizeZ := bhdr.nz; + sizeT := 1; + if ( bhdr.nz mod (bhdr.numTimes * bhdr.numChannels) = 0 ) then begin + sizeZ := bhdr.nz div (bhdr.numTimes * bhdr.numChannels); + sizeT := bhdr.nz div sizeZ; + end; + if (sizeT > 1) then + nhdr.dim[0]:=4//4D + else + nhdr.dim[0]:=3;//3D + nhdr.dim[1]:=bhdr.nx; + nhdr.dim[2]:=bhdr.ny; + nhdr.dim[3]:=sizeZ; + nhdr.dim[4]:=sizeT; + nhdr.pixdim[1]:=1.0; + nhdr.pixdim[2]:=1.0; + nhdr.pixdim[3]:=1.0; + nhdr.datatype := kDT_UINT16; + nhdr.vox_offset := kDV_HEADER_SIZE + bhdr.ExtendedHeaderSize; + nhdr.sform_code := 1; + nhdr.srow_x[0]:=nhdr.pixdim[1];nhdr.srow_x[1]:=0.0;nhdr.srow_x[2]:=0.0;nhdr.srow_x[3]:=0.0; + nhdr.srow_y[0]:=0.0;nhdr.srow_y[1]:=nhdr.pixdim[2];nhdr.srow_y[2]:=0.0;nhdr.srow_y[3]:=0.0; + nhdr.srow_z[0]:=0.0;nhdr.srow_z[1]:=0.0;nhdr.srow_z[2]:=-nhdr.pixdim[3];nhdr.srow_z[3]:=0.0; + convertForeignToNifti(nhdr); + result := true; +end; //nii_readDeltaVision + +procedure pswap4ui(var s : uint32); +type + swaptype = packed record + case byte of + 0:(Word1,Word2 : word); //word is 16 bit + 1:(Long:uint32); + end; + swaptypep = ^swaptype; +var + inguy:swaptypep; + outguy:swaptype; +begin + inguy := @s; //assign address of s to inguy + outguy.Word1 := swap(inguy^.Word2); + outguy.Word2 := swap(inguy^.Word1); + s:=outguy.Long; +end; //proc swap4 + +function nii_readGipl (var fname: string; var nhdr: TNIFTIhdr; var swapEndian: boolean): boolean; +const + kmagic_number =4026526128; +Type + Tdv_header = packed record + dim: array [1..4] of Word; + data_type: word; + pixdim: array [1..4] of Single; + patient: array [1..80] of char; + matrix: array [1..20] of Single; + orientation, par2: byte; + voxmin, voxmax: Double; + origin: array [1..4] of Double; + pixval_offset, pixval_cal, interslicegap, user_def2 : single; + magic_number : uint32; + end; // Tdv_header; +var + bhdr : Tdv_header; + lHdrFile: file; + i, FSz,FSzX: integer; +begin + result := false; + {$I-} + AssignFile(lHdrFile, fname); + FileMode := fmOpenRead; //Set file access to read only + Reset(lHdrFile, 1); + {$I+} + if ioresult <> 0 then begin + NSLog('Error in reading GIPL header.'+inttostr(IOResult)); + FileMode := 2; + exit; + end; + FSz := Filesize(lHdrFile); + BlockRead(lHdrFile, bhdr, sizeof(Tdv_header)); + CloseFile(lHdrFile); + swapEndian := false; + {$IFNDEF ENDIAN_BIG} //GIPL is big endian, so byte swap on little endian + swapEndian := true; + for i := 1 to 4 do begin + bhdr.dim[i] := swap(bhdr.dim[i]); + pswap4r(bhdr.pixdim[i]); + bhdr.origin[i] := swap64r(bhdr.origin[i]); + end; + for i := 1 to 20 do + pswap4r(bhdr.matrix[i]); + bhdr.data_type := swap(bhdr.data_type); + bhdr.voxmin := swap64r(bhdr.voxmin); + bhdr.voxmax := swap64r(bhdr.voxmax); + pswap4r(bhdr.pixval_offset); + pswap4r(bhdr.pixval_cal); + pswap4r(bhdr.interslicegap); + pswap4r(bhdr.user_def2); + pswap4ui(bhdr.magic_number); + {$ENDIF} + //NSLog(format('%g %g %g %g ', [bhdr.matrix[1],bhdr.matrix[2],bhdr.matrix[3],bhdr.matrix[4]] )); + if bhdr.magic_number <> kmagic_number then begin + NSLog('Error in reading GIPL header signature '+inttostr(bhdr.magic_number)+' != '+inttostr(sizeof(Tdv_header))); + exit; + end; + if (bhdr.data_type = 1) then + nhdr.datatype := kDT_BINARY + else if (bhdr.data_type = 7) then + nhdr.datatype := kDT_INT8 + else if (bhdr.data_type = 8) then + nhdr.datatype := kDT_UNSIGNED_CHAR + else if (bhdr.data_type = 15) then + nhdr.datatype := kDT_INT16 + else if (bhdr.data_type = 16) then + nhdr.datatype := kDT_UINT16 + else if (bhdr.data_type = 31) then + nhdr.datatype := kDT_UINT32 + else if (bhdr.data_type = 32) then + nhdr.datatype := kDT_INT32 + else if (bhdr.data_type = 64) then + nhdr.datatype := kDT_FLOAT32 + else if (bhdr.data_type = 64) then + nhdr.datatype := kDT_DOUBLE + else begin + NSLog('Unsupported GIPL data type '+inttostr(nhdr.datatype)); + exit; + end; + for i := 1 to 4 do begin + if bhdr.dim[i] < 1 then + bhdr.dim[i] := 1; + nhdr.dim[i]:=bhdr.dim[i]; + nhdr.pixdim[i]:=bhdr.pixdim[i] + end; + if (bhdr.dim[4] > 1) then + nhdr.dim[0]:=4//4D + else + nhdr.dim[0]:=3;//3D + if bhdr.interslicegap > 0 then + nhdr.pixdim[3] := bhdr.pixdim[3] + bhdr.interslicegap; + nhdr.vox_offset := sizeof(Tdv_header); + nhdr.sform_code := 1; + nhdr.srow_x[0]:=nhdr.pixdim[1];nhdr.srow_x[1]:=0.0;nhdr.srow_x[2]:=0.0;nhdr.srow_x[3]:=0.0; + nhdr.srow_y[0]:=0.0;nhdr.srow_y[1]:=nhdr.pixdim[2];nhdr.srow_y[2]:=0.0;nhdr.srow_y[3]:=0.0; + nhdr.srow_z[0]:=0.0;nhdr.srow_z[1]:=0.0;nhdr.srow_z[2]:=nhdr.pixdim[3];nhdr.srow_z[3]:=0.0; + convertForeignToNifti(nhdr); + FSzX := sizeof(Tdv_header) + ( bhdr.dim[1]*bhdr.dim[2]*bhdr.dim[3]*bhdr.dim[4]*(nhdr.bitpix div 8)); + if (nhdr.bitpix <> 1) and (FSz <> FSzX) then begin + NSLog('Error unexpected file size '+inttostr(FSz)+' != '+inttostr(FSzX)); + exit; + end; + result := true; +end; //nii_readGipl + +function nii_readpic (var fname: string; var nhdr: TNIFTIhdr): boolean; +//function nii_readpic (var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian: boolean): boolean; +//https://github.com/jefferis/pic2nifti/blob/master/libpic2nifti.c +const + kBIORAD_HEADER_SIZE = 76; + kBIORAD_NOTE_HEADER_SIZE = 16; + kBIORAD_NOTE_SIZE = 80; +Type + Tbiorad_header = packed record //Next: PIC Format Header structure + nx, ny : word; // 0 2*2 image width and height in pixels + npic: SmallInt; // 4 2 number of images in file + ramp1_min: SmallInt; // 6 2*2 LUT1 ramp min. and max. + ramp1_max: SmallInt; + notes: LongInt; // 10 4 no notes=0; has notes=non zero + byte_format: SmallInt; // 14 2 bytes=TRUE(1); words=FALSE(0) + n : word; // 16 2 image number within file + name: array [1..32] of char; // 18 32 file name + merged: SmallInt; // 50 2 merged format + color1 : word; // 52 2 LUT1 color status + file_id : word; // 54 2 valid .PIC file=12345 + ramp2_min: SmallInt; // 56 2*2 LUT2 ramp min. and max. + ramp2_max: SmallInt; + color2: word; // 60 2 LUT2 color status + edited: SmallInt; // 62 2 image has been edited=TRUE(1) + lens: SmallInt; // 64 2 Integer part of lens magnification + mag_factor: single; // 66 4 4 byte real mag. factor (old ver.) + dummy1, dummy2, dummy3: word; // 70 6 NOT USED (old ver.=real lens mag.) + end; // biorad_header; + Tbiorad_note_header = packed record + blank: SmallInt; // 0 2 + note_flag: LongInt; // 2 4 + blank2: LongInt; // 6 4 + note_type: SmallInt; // 10 2 + blank3: LongInt; // 12 4 + note: array[1..kBIORAD_NOTE_SIZE] of char; + end;//biorad_note_header; +var + bhdr : Tbiorad_header; + nh: Tbiorad_note_header; + lHdrFile: file; + //s: string; + i, bytesHdrImg, nNotes: integer; +begin + result := false; + {$I-} + AssignFile(lHdrFile, fname); + FileMode := fmOpenRead; //Set file access to read only + Reset(lHdrFile, 1); + {$I+} + if ioresult <> 0 then begin + NSLog('Error in reading BioRad PIC header.'+inttostr(IOResult)); + FileMode := 2; + exit; + end; + BlockRead(lHdrFile, bhdr, sizeof(Tbiorad_header)); + if (bhdr.file_id <> 12345) then begin //signature not found! + CloseFile(lHdrFile); + NSLog('Error in reading BioRad PIC header file ID not 12345.'); + exit; + end; + {$IFDEF ENDIAN_BIG} + swapEndian := true; + bhdr.nx := swap(bhdr.nx); + bhdr.ny := swap(bhdr.ny); + bhdr.npic := swap(bhdr.npic); + bhdr.byte_format := swap(bhdr.byte_format); + {$ENDIF} + nhdr.dim[0]:=3;//3D + nhdr.dim[1]:=bhdr.nx; + nhdr.dim[2]:=bhdr.ny; + nhdr.dim[3]:=bhdr.npic; + nhdr.dim[4]:=1; + nhdr.pixdim[1]:=1.0; + nhdr.pixdim[2]:=1.0; + nhdr.pixdim[3]:=1.0; + if (bhdr.byte_format = 1) then + nhdr.datatype := kDT_UINT8 // 2 + else + nhdr.datatype := kDT_UINT16; + nhdr.vox_offset := kBIORAD_HEADER_SIZE; + bytesHdrImg := sizeof(Tbiorad_header)+bhdr.nx*bhdr.ny*bhdr.npic*bhdr.byte_format; + nNotes := (Filesize(lHdrFile) - bytesHdrImg) div (kBIORAD_NOTE_HEADER_SIZE+kBIORAD_NOTE_SIZE); + if (nNotes > 0) then begin + seek(lHdrFile, bytesHdrImg); + for i := 1 to nNotes do begin + BlockRead(lHdrFile, nh, sizeof(Tbiorad_note_header)); + {$IFDEF ENDIAN_BIG} + nh.note_type := swap(nh.note_type); + {$ENDIF} + if(nh.note_type=1) then continue; // These are not interesting notes + if AnsiStartsStr('AXIS_2 ', nh.note) then + nhdr.pixdim[1] := parsePicString(nh.note); + if AnsiStartsStr('AXIS_3 ', nh.note) then + nhdr.pixdim[2] := parsePicString(nh.note); + if AnsiStartsStr('AXIS_4 ', nh.note) then + nhdr.pixdim[3] := parsePicString(nh.note); + end; + end; + CloseFile(lHdrFile); + nhdr.sform_code := 1; + nhdr.srow_x[0]:=nhdr.pixdim[1];nhdr.srow_x[1]:=0.0;nhdr.srow_x[2]:=0.0;nhdr.srow_x[3]:=0.0; + nhdr.srow_y[0]:=0.0;nhdr.srow_y[1]:=nhdr.pixdim[2];nhdr.srow_y[2]:=0.0;nhdr.srow_y[3]:=0.0; + nhdr.srow_z[0]:=0.0;nhdr.srow_z[1]:=0.0;nhdr.srow_z[2]:=-nhdr.pixdim[3];nhdr.srow_z[3]:=0.0; + convertForeignToNifti(nhdr); + result := true; +end; + +function nii_readEcat(var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian: boolean): boolean; +Const + ECAT7_BYTE =1; + (*ECAT7_VAXI2 =2; + ECAT7_VAXI4 =3; + ECAT7_VAXR4 =4; + ECAT7_IEEER4 =5;*) + ECAT7_SUNI2 =6; + ECAT7_SUNI4 =7; + //image types + ECAT7_2DSCAN =1; + (*ECAT7_IMAGE16 =2; + ECAT7_ATTEN =3; + ECAT7_2DNORM =4; + ECAT7_POLARMAP =5; + ECAT7_VOLUME8 =6; + ECAT7_VOLUME16 =7; + ECAT7_PROJ =8; + ECAT7_PROJ16 =9; + ECAT7_IMAGE8 =10; + ECAT7_3DSCAN =11; + ECAT7_3DSCAN8 =12; + ECAT7_3DNORM =13;*) + ECAT7_3DSCANFIT =14; +Label + 666; +Type + THdrMain = packed record //Next: MGH Format Header structure + magic: array[1..14] of char; + original_filename: array[1..32] of char; + sw_version, system_type, file_type: uint16; + serial_number: array[1..10] of char; + scan_start_time: uint32; + isotope_name: array[1..8] of char; + isotope_halflife: single; + radiopharmaceutical: array[1..32] of char; + gantry_tilt, gantry_rotation, bed_elevation, intrinsic_tilt: single; + wobble_speed, transm_source_type: int16; + distance_scanned, transaxial_fov: single; + angular_compression, coin_samp_mode, axial_samp_mode: uint16; + ecat_calibration_factor: single; + calibration_unitS, calibration_units_type, compression_code: uint16; + study_type: array[1..12] of char; + patient_id: array[1..16] of char; + patient_name: array[1..32] of char; + patient_sex, patient_dexterity: char; + patient_age, patient_height, patient_weight: single; + patient_birth_date: uint32; + physician_name, operator_name, study_description: array[1..32] of char; + acquisition_type, patient_orientation: uint16; + facility_name: array[1..20] of char; + num_planes, num_frames, num_gates, num_bed_pos: uint16; + init_bed_position: single; + bed_position: array[1..15] of single; + plane_separation: single; + lwr_sctr_thres, lwr_true_thres, upr_true_thres: uint16; + user_process_code: array[1..10] of char; + acquisition_mode: uint16; + bin_size, branching_fraction: single; + dose_start_time: single; + dosage, well_counter_corr_factor: single; + data_units: array[1..32] of char; + septa_state: uint16; + fill: array[1..12] of char; + end; + THdrList = packed record + hdr, + r01,r02,r03,r04,r05,r06,r07,r08,r09,r10, + r11,r12,r13,r14,r15,r16,r17,r18,r19,r20, + r21,r22,r23,r24,r25,r26,r27,r28,r29,r30, + r31 : array[1..4] of int32; + end; + THdrImg = packed record + data_type, num_dimensions, x_dimension, y_dimension, z_dimension: smallint; + x_offset, y_offset, z_offset, recon_zoom, scale_factor: single; + image_min, image_max: smallint; + x_pixel_size, y_pixel_size, z_pixel_size: single; + frame_duration, frame_start_time,filter_code: smallint; + x_resolution, y_resolution, z_resolution, num_r_elements, num_angles, z_rotation_angle, decay_corr_fctr: single; + processing_code, gate_duration, r_wave_offset, num_accepted_beats: int32; + filter_cutoff_frequenc, filter_resolution, filter_ramp_slope: single; + filter_order: smallint; + filter_scatter_fraction, filter_scatter_slope: single; + annotation: string[40]; + mtx: array [1..9] of single; + rfilter_cutoff, rfilter_resolution: single; + rfilter_code, rfilter_order: int16; + zfilter_cutoff, zfilter_resolution: single; + zfilter_code, zfilter_order: smallint; + mtx_1_4, mtx_2_4, mtx_3_4: single; + scatter_type, recon_type, recon_views: smallint; + fill_cti: array [1..87] of int16; + fill_user: array [1..49] of int16; + end; +var + mhdr: THdrMain; + ihdr: THdrImg; + lhdr: THdrList; + lHdrFile: file; + img1_StartBytes: integer; +begin + result := false; + gzBytes := 0; + {$I-} + AssignFile(lHdrFile, fname); + FileMode := fmOpenRead; //Set file access to read only + Reset(lHdrFile, 1); + {$I+} + if ioresult <> 0 then begin + NSLog('Error in reading ECAT header.'+inttostr(IOResult)); + FileMode := 2; + exit; + end; + BlockRead(lHdrFile, mhdr, sizeof(mhdr)); + {$IFDEF FPC} mhdr.magic:=upcase(mhdr.magic); {$ENDIF} //Delphi 7 can not upcase arrays + if ((mhdr.magic[1] <> 'M') or (mhdr.magic[2] <> 'A') or (mhdr.magic[3] <> 'T') or (mhdr.magic[4] <> 'R') or (mhdr.magic[5] <> 'I') or (mhdr.magic[6] <> 'X')) then + goto 666; + {$IFDEF ENDIAN_BIG} //data always stored big endian + swapEndian := false; + {$ELSE} + swapEndian := true; + mhdr.sw_version := swap2(mhdr.sw_version); + mhdr.file_type := swap2(mhdr.file_type); + mhdr.num_frames := swap2(mhdr.num_frames); + pswap4r(mhdr.ecat_calibration_factor); + {$ENDIF} + if ((mhdr.file_type < ECAT7_2DSCAN) or (mhdr.file_type > ECAT7_3DSCANFIT)) then begin + ShowMsg('Unknown ECAT file type '+ inttostr( mhdr.file_type)); + goto 666; + end; + //read list header + BlockRead(lHdrFile, lhdr, sizeof(lhdr)); + {$IFNDEF ENDIAN_BIG} //data always stored big endian + pswap4i(lhdr.r01[2]); + {$ENDIF} + img1_StartBytes := lhdr.r01[2] * 512; + //read image header + seek(lHdrFile, img1_StartBytes - 512); + BlockRead(lHdrFile, ihdr, sizeof(ihdr)); + {$IFNDEF ENDIAN_BIG} //data always stored big endian + ihdr.data_type := swap(ihdr.data_type); + pswap4r(ihdr.x_pixel_size); + pswap4r(ihdr.y_pixel_size); + pswap4r(ihdr.z_pixel_size); + pswap4r(ihdr.scale_factor); + ihdr.x_dimension := swap(ihdr.x_dimension); + ihdr.y_dimension := swap(ihdr.y_dimension); + ihdr.z_dimension := swap(ihdr.z_dimension); + {$ENDIF} + ihdr.x_pixel_size := ihdr.x_pixel_size * 10.0; + ihdr.y_pixel_size := ihdr.y_pixel_size * 10.0; + ihdr.z_pixel_size := ihdr.z_pixel_size * 10.0; + if ((ihdr.data_type <> ECAT7_BYTE) and (ihdr.data_type <> ECAT7_SUNI2) and (ihdr.data_type <> ECAT7_SUNI4)) then begin + ShowMsg('Unknown ECAT data type '+ inttostr(ihdr.data_type)); + goto 666; + end; + nhdr.scl_slope := ihdr.scale_factor * mhdr.ecat_calibration_factor; + nhdr.datatype := kDT_INT16; + if (ihdr.data_type = ECAT7_BYTE) then + nhdr.datatype := kDT_UINT8 + else if (ihdr.data_type = ECAT7_SUNI4) then + nhdr.datatype := kDT_INT32; + nhdr.dim[1]:=ihdr.x_dimension; + nhdr.dim[2]:=ihdr.y_dimension; + nhdr.dim[3]:=ihdr.z_dimension; + nhdr.dim[4]:=1; + nhdr.pixdim[1]:=ihdr.x_pixel_size; + nhdr.pixdim[2]:=ihdr.y_pixel_size; + nhdr.pixdim[3]:=ihdr.z_pixel_size; + nhdr.vox_offset := img1_StartBytes; + nhdr.sform_code := 0; + nhdr.srow_x[0]:=nhdr.pixdim[1]; nhdr.srow_x[1]:=0; nhdr.srow_x[2]:=0; nhdr.srow_x[3]:=-(ihdr.x_dimension-2.0)/2.0*ihdr.x_pixel_size; + nhdr.srow_y[0]:=0; nhdr.srow_y[1]:=nhdr.pixdim[2]; nhdr.srow_y[2]:=0; nhdr.srow_y[3]:=-(ihdr.y_dimension-2.0)/2.0*ihdr.y_pixel_size; + nhdr.srow_z[0]:=0; nhdr.srow_z[1]:=0; nhdr.srow_z[2]:=nhdr.pixdim[3]; nhdr.srow_z[3]:=-(ihdr.z_dimension-2.0)/2.0*ihdr.z_pixel_size; + convertForeignToNifti(nhdr); + result := true; +666: +CloseFile(lHdrFile); +end; + +function readMGHHeader (var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian: boolean): boolean; +Type + Tmgh = packed record //Next: MGH Format Header structure + version, width,height,depth,nframes,mtype,dof : longint; + goodRASFlag: smallint; + spacingX,spacingY,spacingZ,xr,xa,xs,yr,ya,ys,zr,za,zs,cr,ca,cs: single; + end; +var + mgh: Tmgh; + lBuff: Bytep; + lExt: string; + lHdrFile: file; + PxyzOffset, Pcrs: vect4; + i,j: integer; + base: single; + m: mat44; +begin + result := false; + lExt := UpCaseExt(fname); + if (lExt = '.MGZ') then begin + lBuff := @mgh; + UnGZip(fname,lBuff,0,sizeof(Tmgh)); //1388 + gzBytes := K_gzBytes_headerAndImageCompressed; + end else begin //if MGZ, else assume uncompressed MGH + gzBytes := 0; + {$I-} + AssignFile(lHdrFile, fname); + FileMode := fmOpenRead; //Set file access to read only + Reset(lHdrFile, 1); + {$I+} + if ioresult <> 0 then begin + NSLog('Error in reading MGH header.'+inttostr(IOResult)); + FileMode := 2; + exit; + end; + BlockRead(lHdrFile, mgh, sizeof(Tmgh)); + CloseFile(lHdrFile); + end; + {$IFDEF ENDIAN_BIG} //data always stored big endian + swapEndian := false; + {$ELSE} + swapEndian := true; + swap4(mgh.version); + swap4(mgh.width); + swap4(mgh.height); + swap4(mgh.depth); + swap4(mgh.nframes); + swap4(mgh.mtype); + swap4(mgh.dof); + mgh.goodRASFlag := swap(mgh.goodRASFlag); + Xswap4r(mgh.spacingX); + Xswap4r(mgh.spacingY); + Xswap4r(mgh.spacingZ); + Xswap4r(mgh.xr); + Xswap4r(mgh.xa); + Xswap4r(mgh.xs); + Xswap4r(mgh.yr); + Xswap4r(mgh.ya); + Xswap4r(mgh.ys); + Xswap4r(mgh.zr); + Xswap4r(mgh.za); + Xswap4r(mgh.zs); + Xswap4r(mgh.cr); + Xswap4r(mgh.ca); + Xswap4r(mgh.cs); + {$ENDIF} + if ((mgh.version <> 1) or (mgh.mtype < 0) or (mgh.mtype > 4)) then begin + NSLog('Error: first value in a MGH header should be 1 and data type should be in the range 1..4.'); + exit; + end; + if (mgh.mtype = 0) then + nhdr.datatype := kDT_UINT8 + else if (mgh.mtype = 4) then + nhdr.datatype := kDT_INT16 + else if (mgh.mtype = 1) then + nhdr.datatype := kDT_INT32 + else if (mgh.mtype = 3) then + nhdr.datatype := kDT_FLOAT32; + if ((mgh.width > 32767) or (mgh.height > 32767) or (mgh.depth > 32767) or (mgh.nframes > 32767)) then begin + //MGH datasets can be huge 1D streams, see https://github.com/vistalab/vistasoft/tree/master/fileFilters/freesurfer + NSLog(format('Error: this software requires each dimension is 32767 or less (%dx%dx%dx%d). Perhaps this is a surface you can open in Surfice.', [mgh.width, mgh.height, mgh.depth,mgh.nframes])); + exit; + end; + nhdr.dim[1]:=mgh.width; + nhdr.dim[2]:=mgh.height; + nhdr.dim[3]:=mgh.depth; + nhdr.dim[4]:=mgh.nframes; + nhdr.pixdim[1]:=mgh.spacingX; + nhdr.pixdim[2]:=mgh.spacingY; + nhdr.pixdim[3]:=mgh.spacingZ; + nhdr.vox_offset := 284; + nhdr.sform_code := 1; + //convert MGH to NIfTI transform see Bruce Fischl mri.c MRIxfmCRS2XYZ https://github.com/neurodebian/freesurfer/blob/master/utils/mri.c + LOAD_MAT44(m,mgh.xr*nhdr.pixdim[1],mgh.yr*nhdr.pixdim[2],mgh.zr*nhdr.pixdim[3],0, + mgh.xa*nhdr.pixdim[1],mgh.ya*nhdr.pixdim[2],mgh.za*nhdr.pixdim[3],0, + mgh.xs*nhdr.pixdim[1],mgh.ys*nhdr.pixdim[2],mgh.zs*nhdr.pixdim[3],0); + base := 0.0; //0 or 1: are voxels indexed from 0 or 1? + Pcrs[0] := (nhdr.dim[1]/2.0)+base; + Pcrs[1] := (nhdr.dim[2]/2.0)+base; + Pcrs[2] := (nhdr.dim[3]/2.0)+base; + Pcrs[3] := 1; + for i:=0 to 3 do begin //multiply Pcrs * m + PxyzOffset[i] := 0; + for j := 0 to 3 do + PxyzOffset[i] := PxyzOffset[i]+ (m[i,j]*Pcrs[j]); + end; + nhdr.srow_x[0]:=m[0,0]; nhdr.srow_x[1]:=m[0,1]; nhdr.srow_x[2]:=m[0,2]; nhdr.srow_x[3]:=mgh.cr - PxyzOffset[0]; + nhdr.srow_y[0]:=m[1,0]; nhdr.srow_y[1]:=m[1,1]; nhdr.srow_y[2]:=m[1,2]; nhdr.srow_y[3]:=mgh.ca - PxyzOffset[1]; + nhdr.srow_z[0]:=m[2,0]; nhdr.srow_z[1]:=m[2,1]; nhdr.srow_z[2]:=m[2,2]; nhdr.srow_z[3]:=mgh.cs - PxyzOffset[2]; + convertForeignToNifti(nhdr); + result := true; +end; + +procedure splitStr(delimiter: char; str: string; mArray: TStrings); +begin + mArray.Clear; + mArray.Delimiter := delimiter; + mArray.DelimitedText := str; +end; + +procedure splitStrStrict(delimiter: char; S: string; sl: TStrings); +begin + sl.Clear; + sl.Delimiter := delimiter; + sl.DelimitedText := '"' + StringReplace(S, sl.Delimiter, '"' + sl.Delimiter + '"', [rfReplaceAll]) + '"'; +end; + +function cleanStr (S:string): string; // "(12.31)" ->"12.31" +begin + result := StringReplace(S, '(', '', [rfReplaceAll]); + result := StringReplace(result, ')', '', [rfReplaceAll]); +end; + +type TFByte = File of Byte; +(*procedure ReadLnBin(var f: TFByte; var s: string); +const + kEOLN = $0A; +var + bt : Byte; +begin + s := ''; + while (not EOF(f)) do begin + Read(f,bt); + if bt = kEOLN then exit; + s := s + Chr(bt); + end; +end; *) + function ReadLnBin(var f: TFByte; var s: string): boolean; + const + kEOLN = $0A; + var + bt : Byte; + begin + s := ''; + if EOF(f) then exit(false); + while (not EOF(f)) do begin + Read(f,bt); + if bt = kEOLN then exit(true); + s := s + Chr(bt); + end; + exit(true); + end; + +function readVTKHeader (var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian: boolean): boolean; +//VTK Simple Legacy Formats : STRUCTURED_POINTS : BINARY +// http://daac.hpc.mil/gettingStarted/VTK_DataFormats.html +// https://github.com/bonilhamusclab/MRIcroS/blob/master/%2BfileUtils/%2Bvtk/readVtk.m +// http://www.ifb.ethz.ch/education/statisticalphysics/file-formats.pdf +// ftp://ftp.tuwien.ac.at/visual/vtk/www/FileFormats.pdf +// "The VTK data files described here are written in big endian form" +label + 666; +var + f: TFByte;//TextFile; + strlst: TStringList; + str: string; + i, num_vox: integer; +begin + gzBytes := 0; + {$IFDEF ENDIAN_BIG} + swapEndian := false; + {$ELSE} + swapEndian := true; + {$ENDIF} + result := false; + strlst:=TStringList.Create; + AssignFile(f, fname); + FileMode := fmOpenRead; + {$IFDEF FPC} Reset(f,1); {$ELSE} Reset(f); {$ENDIF} + ReadLnBin(f, str); //signature: '# vtk DataFile' + if pos('VTK', UpperCase(str)) <> 3 then begin + showmessage('Not a VTK file'); + goto 666; + end; + ReadLnBin(f, str); //comment: 'Comment: created with MRIcroS' + ReadLnBin(f, str); //kind: 'BINARY' or 'ASCII' + if pos('BINARY', UpperCase(str)) <> 1 then begin // '# vtk DataFile' + showmessage('Only able to read binary VTK file:'+str); + goto 666; + end; + ReadLnBin(f, str); // kind, e.g. "DATASET POLYDATA" or "DATASET STRUCTURED_ POINTS" + if pos('STRUCTURED_POINTS', UpperCase(str)) = 0 then begin + showmessage('Only able to read VTK images saved as STRUCTURED_POINTS, not '+ str); + goto 666; + end; + while (str <> '') and (pos('POINT_DATA', UpperCase(str)) = 0) do begin + ReadLnBin(f, str); + strlst.DelimitedText := str; + if pos('DIMENSIONS', UpperCase(str)) <> 0 then begin //e.g. "DIMENSIONS 128 128 128" + nhdr.dim[1] := StrToIntDef(strlst[1],1); + nhdr.dim[2] := StrToIntDef(strlst[2],1); + nhdr.dim[3] := StrToIntDef(strlst[3],1); + end; //dimensions + if (pos('ASPECT_RATIO', UpperCase(str)) <> 0) or (pos('SPACING', UpperCase(str)) <> 0) then begin //e.g. "ASPECT_RATIO 1.886 1.886 1.913" + nhdr.pixdim[1] := StrToFloatDef(strlst[1],1); + nhdr.pixdim[2] := StrToFloatDef(strlst[2],1); + nhdr.pixdim[3] := StrToFloatDef(strlst[3],1); + //showmessage(format('%g %g %g',[nhdr.pixdim[1], nhdr.pixdim[2], nhdr.pixdim[3] ])); + end; //aspect ratio + if (pos('ORIGIN', UpperCase(str)) <> 0) then begin //e.g. "ASPECT_RATIO 1.886 1.886 1.913" + nhdr.srow_x[3] := -StrToFloatDef(strlst[1],1); + nhdr.srow_y[3] := -StrToFloatDef(strlst[2],1); + nhdr.srow_z[3] := -StrToFloatDef(strlst[3],1); + //showmessage(format('%g %g %g',[nhdr.pixdim[1], nhdr.pixdim[2], nhdr.pixdim[3] ])); + end; //aspect ratio + end; //not POINT_DATA + if pos('POINT_DATA', UpperCase(str)) = 0 then goto 666; + num_vox := StrToIntDef(strlst[1],0); + if num_vox <> (nhdr.dim[1] * nhdr.dim[2] * nhdr.dim[3]) then begin + showmessage(format('Expected POINT_DATA to equal %dx%dx%d',[nhdr.dim[1], nhdr.dim[2], nhdr.dim[3] ])); + goto 666; + end; + ReadLnBin(f, str); + if pos('SCALARS', UpperCase(str)) = 0 then goto 666; //"SCALARS scalars unsigned_char" + strlst.DelimitedText := str; + str := UpperCase(strlst[2]); + //dataType is one of the types bit, unsigned_char, char, unsigned_short, short, unsigned_int, int, unsigned_long, long, float, or double + if pos('UNSIGNED_CHAR', str) <> 0 then + nhdr.datatype := kDT_UINT8 // + else if pos('SHORT', str) <> 0 then + nhdr.datatype := kDT_INT16 // + else if pos('UNSIGNED_SHORT', str) <> 0 then + nhdr.datatype := kDT_UINT16 // + else if pos('INT', str) <> 0 then + nhdr.datatype := kDT_INT32 // + else if pos('FLOAT', str) <> 0 then + nhdr.datatype := kDT_FLOAT + else if pos('DOUBLE', str) <> 0 then + nhdr.datatype := kDT_DOUBLE + else begin + showmessage('Unknown VTK scalars type '+str); + goto 666; + end; + convertForeignToNifti(nhdr); + //showmessage(inttostr(nhdr.datatype)); + ReadLnBin(f, str); + if pos('LOOKUP_TABLE', UpperCase(str)) = 0 then goto 666; //"LOOKUP_TABLE default" + nhdr.vox_offset := filepos(f); + //fill matrix + for i := 0 to 2 do begin + nhdr.srow_x[i] := 0; + nhdr.srow_y[i] := 0; + nhdr.srow_z[i] := 0; + end; + nhdr.srow_x[0] := nhdr.pixdim[1]; + nhdr.srow_y[1] := nhdr.pixdim[2]; + nhdr.srow_z[2] := nhdr.pixdim[3]; + //showmessage('xx' +inttostr( filepos(f) )); + result := true; + 666: + closefile(f); + strlst.Free; +end; + +function readMHAHeader (var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian: boolean): boolean; +//Read VTK "MetaIO" format image +//http://www.itk.org/Wiki/ITK/MetaIO/Documentation#Reading_a_Brick-of-Bytes_.28an_N-Dimensional_volume_in_a_single_file.29 +//https://www.assembla.com/spaces/plus/wiki/Sequence_metafile_format +//http://itk-insight-users.2283740.n2.nabble.com/MHA-MHD-File-Format-td7585031.html +var + FP: TextFile; + str, tagName, elementNames: string; + ch: char; + isLocal,compressedData: boolean; + matOrient, mat, d, t: mat33; + //compressedDataSize, + nPosition, nOffset, matElements, matElementsOrient, headerSize, nItems, nBytes, i, channels, fileposBytes: longint; + //elementSize, + offset,position: array [0..3] of single; + transformMatrix: array [0..11] of single; + mArray: TStringList; +begin + result := false; + if not FileExists(fname) then exit; + {$IFDEF FPC} + DefaultFormatSettings.DecimalSeparator := '.' ; + // DecimalSeparator := '.'; + {$ELSE} + DecimalSeparator := '.'; + {$ENDIF} + for i := 0 to 3 do begin + position[i] := 0; + offset[i] := 0; + //elementSize[i] := 1; + end; + nPosition := 0; + nOffset := 0; + gzBytes := 0; + fileposBytes := 0; + //compressedDataSize := 0; + swapEndian := false; + isLocal := true; //image and header embedded in same file, if false detached image + headerSize := 0; + matElements := 0; + matElementsOrient := 0; + compressedData := false; + mArray := TStringList.Create; + Filemode := fmOpenRead; + AssignFile(fp,fname); + reset(fp); + while not EOF(fp) do begin + str := ''; + while not EOF(fp) do begin + read(fp,ch); + inc(fileposBytes); + if (ch = chr($0D)) or (ch = chr($0A)) then break; + str := str+ch; + end; + if (length(str) < 1) or (str[1]='#') then continue; + splitstrStrict('=',str,mArray); + if (mArray.count < 2) then continue; + tagName := cleanStr(mArray[0]); + elementNames := mArray[1]; + splitstr(',',elementNames,mArray); + nItems :=mArray.count; + if (nItems < 1) then continue; + for i := 0 to (nItems-1) do + mArray[i] := cleanStr(mArray[i]); //remove '(' and ')', + if AnsiContainsText(tagName, 'ObjectType') and (not AnsiContainsText(mArray.Strings[0], 'Image')) then begin + NSLog('Expecting file with tag "ObjectType = Image" instead of "ObjectType = '+mArray.Strings[0]+'"'); + + end {else if AnsiContainsText(tagName, 'NDims') then begin + nDims := strtoint(mArray[0]); + if (nDims > 4) then begin + NSLog('Warning: only reading first 4 dimensions'); + nDims := 4; + end; + end} else if AnsiContainsText(tagName, 'BinaryDataByteOrderMSB') then begin + {$IFDEF ENDIAN_BIG} //data always stored big endian + if not AnsiContainsText(mArray[0], 'True') then swapEndian := true; + {$ELSE} + if AnsiContainsText(mArray[0], 'True') then swapEndian := true; + {$ENDIF} + end {else if AnsiContainsText(tagName, 'BinaryData') then begin + if AnsiContainsText(mArray[0], 'True') then binaryData := true; + end else if AnsiContainsText(tagName, 'CompressedDataSize') then begin + compressedDataSize := strtoint(mArray[0]); + end} else if AnsiContainsText(tagName, 'CompressedData') then begin + if AnsiContainsText(mArray[0], 'True') then + compressedData := true; + end else if AnsiContainsText(tagName, 'Orientation') and (not AnsiContainsText(tagName, 'Anatomical') ) then begin + if (nItems > 12) then nItems := 12; + matElementsOrient := nItems; + for i := 0 to (nItems-1) do + transformMatrix[i] := strtofloat(mArray[i]); + + + if (matElementsOrient >= 12) then + LOAD_MAT33(matOrient, transformMatrix[0],transformMatrix[1],transformMatrix[2], + transformMatrix[4],transformMatrix[5],transformMatrix[6], + transformMatrix[8],transformMatrix[9],transformMatrix[10]) + else if (matElementsOrient >= 9) then + LOAD_MAT33(matOrient, transformMatrix[0],transformMatrix[1],transformMatrix[2], + transformMatrix[3],transformMatrix[4],transformMatrix[5], + transformMatrix[6],transformMatrix[7],transformMatrix[8]); + + end else if AnsiContainsText(tagName, 'TransformMatrix') then begin + if (nItems > 12) then nItems := 12; + matElements := nItems; + for i := 0 to (nItems-1) do + transformMatrix[i] := strtofloat(mArray[i]); + if (matElements >= 12) then + LOAD_MAT33(mat, transformMatrix[0],transformMatrix[1],transformMatrix[2], + transformMatrix[4],transformMatrix[5],transformMatrix[6], + transformMatrix[8],transformMatrix[9],transformMatrix[10]) + else if (matElements >= 9) then + LOAD_MAT33(mat, transformMatrix[0],transformMatrix[1],transformMatrix[2], + transformMatrix[3],transformMatrix[4],transformMatrix[5], + transformMatrix[6],transformMatrix[7],transformMatrix[8]); + end else if AnsiContainsText(tagName, 'Position') then begin + if (nItems > 3) then nItems := 3; + nPosition := nItems; + for i := 0 to (nItems-1) do + position[i] := strtofloat(mArray[i]); + end else if AnsiContainsText(tagName, 'Offset') then begin + if (nItems > 3) then nItems := 3; + nOffset := nItems; + for i := 0 to (nItems-1) do + offset[i] := strtofloat(mArray[i]); + end else if AnsiContainsText(tagName, 'AnatomicalOrientation') then begin + //e.g. RAI + end else if AnsiContainsText(tagName, 'ElementSpacing') then begin + if (nItems > 4) then nItems := 4; + for i := 0 to (nItems-1) do + nhdr.pixdim[i+1] := strtofloat(mArray[i]); + end else if AnsiContainsText(tagName, 'DimSize') then begin + if (nItems > 4) then nItems := 4; + for i := 0 to (nItems-1) do + nhdr.dim[i+1] := strtoint(mArray[i]); + end else if AnsiContainsText(tagName, 'HeaderSize') then begin + headerSize := strtoint(mArray[0]); + end else if AnsiContainsText(tagName, 'ElementSize') then begin + //if (nItems > 4) then nItems := 4; + //for i := 0 to (nItems-1) do + // elementSize[i] := strtofloat(mArray[i]); + end else if AnsiContainsText(tagName, 'ElementNumberOfChannels') then begin + channels := strtoint(mArray[0]); + if (channels > 1) then NSLog('Unable to read MHA/MHD files with multiple channels '); + end else if AnsiContainsText(tagName, 'ElementByteOrderMSB') then begin + {$IFDEF ENDIAN_BIG} //data always stored big endian + if not AnsiContainsText(mArray[0], 'True') then swapEndian := true; + {$ELSE} + if AnsiContainsText(mArray[0], 'True') then swapEndian := true; + {$ENDIF} + end else if AnsiContainsText(tagName, 'ElementType') then begin + + //convert metaImage format to NIfTI http://portal.nersc.gov/svn/visit/tags/2.2.1/vendor_branches/vtk/src/IO/vtkMetaImageWriter.cxx + //set NIfTI datatype http://nifti.nimh.nih.gov/pub/dist/src/niftilib/nifti1.h + if AnsiContainsText(mArray[0], 'MET_UCHAR') then + nhdr.datatype := kDT_UINT8 // + else if AnsiContainsText(mArray[0], 'MET_CHAR') then + nhdr.dataType := kDT_INT8 // + else if AnsiContainsText(mArray[0], 'MET_SHORT') then + nhdr.dataType := kDT_INT16 // + else if AnsiContainsText(mArray[0], 'MET_USHORT') then + nhdr.dataType := kDT_UINT16 // + else if AnsiContainsText(mArray[0], 'MET_INT') then + nhdr.dataType := kDT_INT32 //DT_INT32 + else if AnsiContainsText(mArray[0], 'MET_UINT') then + nhdr.dataType := kDT_UINT32 //DT_UINT32 + else if AnsiContainsText(mArray[0], 'MET_ULONG') then + nhdr.dataType := kDT_UINT64 //DT_UINT64 + else if AnsiContainsText(mArray[0], 'MET_LONG') then + nhdr.dataType := kDT_INT64 //DT_INT64 + else if AnsiContainsText(mArray[0], 'MET_FLOAT') then + nhdr.dataType := kDT_FLOAT32 //DT_FLOAT32 + else if AnsiContainsText(mArray[0], 'MET_DOUBLE') then + nhdr.dataType := kDT_DOUBLE; //DT_FLOAT64 + end else if AnsiContainsText(tagName, 'ElementDataFile') then begin + if not AnsiContainsText(mArray[0], 'local') then begin + str := mArray.Strings[0]; + if fileexists(str) then + fname := str + else begin + fname := ExtractFilePath(fname)+str; + end; + isLocal := false; + end; + break; + end; + end; //while reading + if (headerSize = 0) and (isLocal) then headerSize :=fileposBytes; //!CRAP 2015 + nhdr.vox_offset := headerSize; + CloseFile(FP); + Filemode := 2; + mArray.free; + //convert transform + if (matElements >= 9) or (matElementsOrient >= 9) then begin + //report_Mat(matOrient); + LOAD_MAT33(d, nhdr.pixdim[1],0,0, + 0, nhdr.pixdim[2],0, + 0,0, nhdr.pixdim[3]); + if (matElements >= 9) then + t := nifti_mat33_mul( d, mat) + else + t := nifti_mat33_mul( d, matOrient) ; + if nPosition > nOffset then begin + offset[0] := position[0]; + offset[1] := position[1]; + offset[2] := position[2]; + + end; + nhdr.srow_x[0] := -t[0,0]; + nhdr.srow_x[1] := -t[1,0]; + nhdr.srow_x[2] := -t[2,0]; + nhdr.srow_x[3] := -offset[0]; + nhdr.srow_y[0] := -t[0,1]; + nhdr.srow_y[1] := -t[1,1]; + nhdr.srow_y[2] := -t[2,1]; + nhdr.srow_y[3] := -offset[1]; + nhdr.srow_z[0] := t[0,2]; + nhdr.srow_z[1] := t[1,2]; + nhdr.srow_z[2] := t[2,2]; + nhdr.srow_z[3] := offset[2]; + end else begin + //NSLog('Warning: unable to determine image orientation (unable to decode metaIO "TransformMatrix" tag)')}; + nhdr.sform_code:=0; + nhdr.srow_x[0] := 0; + nhdr.srow_x[1] := 0; + nhdr.srow_x[2] := 0; + end; + //end transform + convertForeignToNifti(nhdr); + if (compressedData) then + gzBytes := K_gzBytes_onlyImageCompressed; + if (nhdr.vox_offset < 0) then begin + nBytes := (nhdr.bitpix div 8); + for i := 1 to 7 do begin + if nhdr.dim[i] > 0 then + nBytes := nBytes * nhdr.dim[i]; + end; + nhdr.vox_offset := FSize(fname) - nBytes; + if (nhdr.vox_offset < 0) then nhdr.vox_offset := -1; + end; + result := true; +end;//MHA +//{$DEFINE DECOMPRESSGZ} +{$IFDEF DECOMPRESSGZ} +function readMIF(var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian, isDimPermute2341: boolean): boolean; +//https://github.com/MRtrix3/mrtrix3/blob/master/matlab/read_mrtrix.m +//https://mrtrix.readthedocs.io/en/latest/getting_started/image_data.html +//https://mrtrix.readthedocs.io/en/latest/getting_started/image_data.html#the-image-transfom +//https://github.com/MRtrix3/mrtrix3/blob/52a2540d7d3158ec74d762ad5dd387777569f325/core/file/nifti1_utils.cpp +label + 666; +{$IFDEF GZIP} +const + kGzSz=65536; +{$ENDIF} +var + FP: TextFile; + str, key, vals, fstr: string; + mArray: TStringList; + nTransforms, nItems, i, j, k, nDim : integer; + repetitionTime: single; + layout: array [1..7] of double; + pixdim: array [1..7] of single; + dim: array [1..7] of integer; + m: Mat44; + m33: mat33; + originVox, originMM: vect3; + {$IFDEF GZIP} + //the GZ MIF header is trouble: unlike NIfTI it is variable size, unlike NRRD it is part of the compressed stream + // here the kludge is to extract the ENTIRE image to disk in order to read the header. + // optimal would be to read a memory stream and detect '\nEND\n' when decompressing... + // however, this format is discouraged so for the moment this seems sufficient + fnameGZ: string = ''; + zStream: TGZFileStream; + dStream: TFileStream; + bytes : array of byte; + bytescopied: integer; + {$ENDIF} +begin + str := UpCaseExt(fname); + if str = '.GZ' then begin + fstr := fname; + {$IFDEF GZIP} + fname := changefileext(fstr,''); + if not fileexists(fname) then begin + fnameGZ := fstr; + zStream := TGZFileStream.Create(fstr,gzOpenRead); + dStream := TFileStream.Create(fname,fmOpenWrite or fmCreate ); + setlength(bytes, kGzSz); + repeat + bytescopied := zStream.read(bytes[0],kGzSz); + dStream.Write(bytes[0],bytescopied) ; + until bytescopied < kGzSz; + dStream.Free; + zStream.Free; + end; + {$ELSE} + showmessage('Unable to decompress .MIF.GZ'); + exit; + {$ENDIF} + end; + swapEndian :=false; + result := false; + for i := 1 to 7 do begin + layout[i] := i; + dim[i] := 1; + pixdim[i] := 1.0; + end; + repetitionTime := 0.0; + LOAD_MAT44(m,1,0,0,0, 0,1,0,0, 0,0,1,0); + nTransforms := 0; + FileMode := fmOpenRead; + AssignFile(fp,fname); + reset(fp); + mArray := TStringList.Create; + if EOF(fp) then goto 666; + readln(fp,str); + if str <> 'mrtrix image' then goto 666; + while (not EOF(fp)) do begin + readln(fp,str); + if str = 'END' then break; + splitstrStrict(':',str,mArray); + if mArray.count < 2 then continue; + key := mArray[0]; //e.g. "dim: 1,2,3" -> "dim" + vals := mArray[1]; //e.g. "dim: 1,2,3" -> "1,2,3" + splitstrStrict(',',vals,mArray); + nItems := mArray.count; + mArray[0] := Trim(mArray[0]); //" Float32LE" -> "Float32LE" + //str := mArray[0]; + //mArray.Delete(i); + if (ansipos('RepetitionTime', key) = 1) and (nItems > 0) then begin + repetitionTime := strtofloatdef(mArray[0], 0); + continue; + end; + if (ansipos('layout', key) = 1) and (nItems > 1) and (nItems < 7) then begin + for i := 1 to nItems do begin + layout[i] := strtofloatdef(mArray[i-1],i); + if (mArray[i-1][1] = '-') and (layout[i] >= 0) then + layout[i] := -0.00001; + end; + continue; + end; + if (ansipos('transform', key) = 1) and (nItems > 1) and (nItems < 5) and (nTransforms < 3) then begin + for i := 0 to (nItems-1) do + m[nTransforms,i] := strtofloatdef(mArray[i],i); + nTransforms := nTransforms + 1; + continue; + end; + if (ansipos('dim', key) = 1) and (nItems > 1) and (nItems < 7) then begin + nDim := nItems; + for i := 1 to nItems do + dim[i] := strtointdef(mArray[i-1],0); + continue; + end; + if (ansipos('scaling', key) = 1) and (nItems > 1) and (nItems < 7) then begin + nhdr.scl_inter := strtofloatdef(mArray[0],0); + nhdr.scl_slope := strtofloatdef(mArray[1],1); + end; + if (ansipos('vox', key) = 1) and (nItems > 1) and (nItems < 7) then begin + //NSLog('BINGO'+mArray[0]); + for i := 1 to nItems do + pixdim[i] := strtofloatdef(mArray[i-1],0); + //nhdr.pixdim[i] := strtofloatdef(mArray[i-1],0); + continue; + end; + if (ansipos('datatype', key) = 1) and (nItems > 0) then begin + if (ansipos('Int8', mArray[0]) = 1) then + nhdr.datatype := kDT_INT8 + else if (ansipos('UInt8', mArray[0]) = 1) then + nhdr.datatype := kDT_UINT8 + else if (ansipos('UInt16', mArray[0]) = 1) then + nhdr.datatype := kDT_UINT16 + else if (ansipos('Int16', mArray[0]) = 1) then + nhdr.datatype := kDT_INT16 + else if (ansipos('Float32', mArray[0]) = 1) then + nhdr.datatype := kDT_FLOAT32 + else + NSLog('unknown datatype '+mArray[0]+' '+inttostr(ansipos('Float32LX', mArray[0]))); + {$IFDEF ENDIAN_BIG} + if (ansipos('LE', mArray[0]) > 0) then + swapEndian :=true; + {$ELSE} + if (ansipos('BE', mArray[0]) > 0) then + swapEndian :=true; + {$ENDIF} + continue; + + end; + if (ansipos('file', key) = 1) and (nItems > 0) then begin + fstr := trim(copy(str,pos(':',str)+1, maxint)); //get full string, e.g. "file: with spaces.dat" + splitstrStrict(' ',mArray[0],mArray); + nItems :=mArray.count; + if (nItems > 1) and (mArray[0] = '.') then + nhdr.vox_offset := strtointdef(mArray[1],0) //"file: . 328" -> 328 *) + else begin + if not fileexists(fstr) then //e.g. "out.dat" -> "\mydir\out.dat" + fname := ExtractFilePath(fname) + fstr + else + fname := fstr; + end; + continue; + end; + //NSLog(format('%d "%s" %d',[ansipos('file', key) , key, nItems])); + end; + //https://github.com/MRtrix3/mrtrix3/blob/52a2540d7d3158ec74d762ad5dd387777569f325/core/file/nifti_utils.cpp + // transform_type adjust_transform (const Header& H, vector& axes) + for i := 0 to 2 do + originVox[0] := 0; + if nDim < 2 then goto 666; + nhdr.dim[0] := nDim; + LOAD_MAT33(m33,1,0,0, 0,1,0, 0,0,1); + for i := 1 to nDim do begin + j := abs(round(layout[i]))+1; + nhdr.dim[j] := dim[i]; + if specialsingle(pixdim[i]) then + pixdim[i] := 0.0; + nhdr.pixdim[j] := pixdim[i]; + if j = 4 then + nhdr.pixdim[j] := repetitionTime; + if i > 3 then continue; + //for k := 0 to 2 do + // m33[k, j-1] := m[i-1,k]; + //for k := 0 to 2 do + // m33[i-1, k] := m[i-1,k]; + for k := 0 to 2 do + m33[k,j-1] := m[k,i-1]; + + //rot33[j-1,i-1] := nhdr.pixdim[j]; + if layout[i] < 0 then begin + nhdr.pixdim[j] := -pixdim[i]; + originVox[j-1] := dim[i]-1; + end; + end; + //scale matrix + for i := 0 to 2 do + for j := 0 to 2 do + m33[j,i] := m33[j,i] * nhdr.pixdim[i+1]; + originMM := nifti_mat33vec_mul(m33, originVox); + for i := 1 to 3 do + nhdr.pixdim[i] := abs(nhdr.pixdim[i]); + for i := 0 to 2 do + m[i,3] := m[i,3] - originMM[i]; + (* + str := format('%g %g %g', [pixdim[1], pixdim[2], pixdim[3]]); + str := format('m = [%g %g %g; %g %g %g; %g %g %g]',[ + m33[0,0], m33[0,1], m33[0,2], + m33[1,0], m33[1,1], m33[1,2], + m33[2,0], m33[2,1], m33[2,2]]); + str := format('%g %g %g', [originVox[0], originVox[1], originVox[2]]); + str := format('v = [%g %g %g]', [originMM[0], originMM[1], originMM[2]]); + Clipboard.AsText := str; *) + + nhdr.srow_x[0] := m33[0,0]; + nhdr.srow_x[1] := m33[0,1]; + nhdr.srow_x[2] := m33[0,2]; + nhdr.srow_x[3] := m[0,3]; + nhdr.srow_y[0] := m33[1,0]; + nhdr.srow_y[1] := m33[1,1]; + nhdr.srow_y[2] := m33[1,2]; + nhdr.srow_y[3] := m[1,3]; + nhdr.srow_z[0] := m33[2,0]; + nhdr.srow_z[1] := m33[2,1]; + nhdr.srow_z[2] := m33[2,2]; + nhdr.srow_z[3] := m[2,3]; + (*str := (format('m = [%g %g %g %g; %g %g %g %g; %g %g %g %g; 0 0 0 1]',[ + nhdr.srow_x[0], nhdr.srow_x[1], nhdr.srow_x[2], nhdr.srow_x[3], + nhdr.srow_y[0], nhdr.srow_y[1], nhdr.srow_y[2], nhdr.srow_y[3], + nhdr.srow_z[0], nhdr.srow_z[1], nhdr.srow_z[2], nhdr.srow_z[3]])); + Clipboard.AsText := str; *) + convertForeignToNifti(nhdr); + result := true; +666: + CloseFile(FP); + Filemode := 2; + {$IFDEF GZIP} + if (fnameGZ <> '') and (fileexists(fnameGZ)) then begin + deletefile(fname); + fname := fnameGZ; + gzBytes := K_gzBytes_headerAndImageCompressed; + end; + + {$ENDIF} + mArray.Free; +end; //readMIF() +{$ELSE} +function StreamNullStrRaw(Stream: TFileStream): string; +var + b: byte; +begin + result := ''; + while (Stream.Position < Stream.Size) do begin + b := Stream.ReadByte; + if b = $0A then exit; + if b = $0D then continue; + result := result + chr(b); + end; +end; + +(*function StreamNullStrGz(Stream: TGZFileStream): string; +var + b: byte; +begin + result := ''; + while (true) do begin + b := Stream.ReadByte; + if b = $0A then exit; + if b = $00 then exit; + if b = $0D then continue; + result := result + chr(b); + end; +end;*) + +function StreamNullStrGz(Stream: TGZFileStream): string; +var + n: integer; + b: array [0..0] of byte; +begin + result := ''; + b[0] := $0A; + while (true) do begin + n := Stream.read(b,1); + if n < 1 then break; + if b[0] = $0A then exit; + if b[0] = $00 then exit; + if b[0] = $0D then continue; + result := result + chr(b[0]); + end; + if n < 1 then result := 'END'; +end; + + +function readMIF(var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian: boolean): boolean; +//https://github.com/MRtrix3/mrtrix3/blob/master/matlab/read_mrtrix.m +//https://mrtrix.readthedocs.io/en/latest/getting_started/image_data.html +//https://mrtrix.readthedocs.io/en/latest/getting_started/image_data.html#the-image-transfom +//https://github.com/MRtrix3/mrtrix3/blob/52a2540d7d3158ec74d762ad5dd387777569f325/core/file/nifti1_utils.cpp +label + 666; +var + str, key, vals, fstr: string; + mArray: TStringList; + nTransforms, nItems, i, j, k, nDim : integer; + repetitionTime: single; + layout: array [1..7] of double; + pixdim: array [1..7] of single; + dim: array [1..7] of integer; + m: Mat44; + m33: mat33; + originVox, originMM: vect3; + fs: TFileStream; + {$IFDEF GZIP} + zfs: TGZFileStream; + isGz: boolean = false; + {$ENDIF} +begin + str := UpCaseExt(fname); + if str = '.GZ' then begin + {$IFDEF GZIP} + isGz := true; + zfs := TGZFileStream.Create(fname,gzOpenRead); + {$ELSE} + showmessage('Unable to decompress .MIF.GZ'); + exit; + {$ENDIF} + end; + swapEndian :=false; + result := false; + for i := 1 to 7 do begin + layout[i] := i; + dim[i] := 1; + pixdim[i] := 1.0; + end; + repetitionTime := 0.0; + LOAD_MAT44(m,1,0,0,0, 0,1,0,0, 0,0,1,0); + nTransforms := 0; + mArray := TStringList.Create; + if isGz then + str := StreamNullStrGz(zfs) + else begin + fs := TFileStream.Create(fname, fmOpenRead); + str := StreamNullStrRaw(fs); + end; + if str <> 'mrtrix image' then goto 666; + while (isGz ) or ((not isGz) and (fs.position < fs.Size)) do begin + if isGz then + str := StreamNullStrGz(zfs) + else + str := StreamNullStrRaw(fs); + if str = 'END' then break; + splitstrStrict(':',str,mArray); + if mArray.count < 2 then continue; + key := mArray[0]; //e.g. "dim: 1,2,3" -> "dim" + vals := mArray[1]; //e.g. "dim: 1,2,3" -> "1,2,3" + splitstrStrict(',',vals,mArray); + nItems := mArray.count; + mArray[0] := Trim(mArray[0]); //" Float32LE" -> "Float32LE" + if (ansipos('RepetitionTime', key) = 1) and (nItems > 0) then begin + repetitionTime := strtofloatdef(mArray[0], 0); + continue; + end; + if (ansipos('layout', key) = 1) and (nItems > 1) and (nItems < 7) then begin + for i := 1 to nItems do begin + layout[i] := strtofloatdef(mArray[i-1],i); + if (mArray[i-1][1] = '-') and (layout[i] >= 0) then + layout[i] := -0.00001; + if (i <= 3) and (abs(layout[i]) >= 3) then begin + showmessage('The first three strides are expected to be spatial (check for update).'); + goto 666; + end; + end; + continue; + end; + if (ansipos('transform', key) = 1) and (nItems > 1) and (nItems < 5) and (nTransforms < 3) then begin + for i := 0 to (nItems-1) do + m[nTransforms,i] := strtofloatdef(mArray[i],i); + nTransforms := nTransforms + 1; + continue; + end; + if (ansipos('dim', key) = 1) and (nItems > 1) and (nItems < 7) then begin + nDim := nItems; + for i := 1 to nItems do + dim[i] := strtointdef(mArray[i-1],0); + continue; + end; + if (ansipos('scaling', key) = 1) and (nItems > 1) and (nItems < 7) then begin + nhdr.scl_inter := strtofloatdef(mArray[0],0); + nhdr.scl_slope := strtofloatdef(mArray[1],1); + end; + if (ansipos('vox', key) = 1) and (nItems > 1) and (nItems < 7) then begin + //NSLog('BINGO'+mArray[0]); + for i := 1 to nItems do + pixdim[i] := strtofloatdef(mArray[i-1],0); + //nhdr.pixdim[i] := strtofloatdef(mArray[i-1],0); + continue; + end; + if (ansipos('datatype', key) = 1) and (nItems > 0) then begin + if (ansipos('Int8', mArray[0]) = 1) then + nhdr.datatype := kDT_INT8 + else if (ansipos('UInt8', mArray[0]) = 1) then + nhdr.datatype := kDT_UINT8 + else if (ansipos('UInt16', mArray[0]) = 1) then + nhdr.datatype := kDT_UINT16 + else if (ansipos('Int16', mArray[0]) = 1) then + nhdr.datatype := kDT_INT16 + else if (ansipos('Float32', mArray[0]) = 1) then + nhdr.datatype := kDT_FLOAT32 + else + NSLog('unknown datatype '+mArray[0]); + {$IFDEF ENDIAN_BIG} + if (ansipos('LE', mArray[0]) > 0) then + swapEndian :=true; + {$ELSE} + if (ansipos('BE', mArray[0]) > 0) then + swapEndian :=true; + {$ENDIF} + continue; + end; + if (ansipos('file', key) = 1) and (nItems > 0) then begin + fstr := trim(copy(str,pos(':',str)+1, maxint)); //get full string, e.g. "file: with spaces.dat" + splitstrStrict(' ',mArray[0],mArray); + nItems :=mArray.count; + if (nItems > 1) and (mArray[0] = '.') then + nhdr.vox_offset := strtointdef(mArray[1],0) //"file: . 328" -> 328 + else begin + if not fileexists(fstr) then //e.g. "out.dat" -> "\mydir\out.dat" + fname := ExtractFilePath(fname) + fstr + else + fname := fstr; + end; + continue; + end; + end; + //https://github.com/MRtrix3/mrtrix3/blob/52a2540d7d3158ec74d762ad5dd387777569f325/core/file/nifti_utils.cpp + // transform_type adjust_transform (const Header& H, vector& axes) + for i := 0 to 2 do + originVox[0] := 0; + if nDim < 2 then goto 666; + nhdr.dim[0] := nDim; + LOAD_MAT33(m33,1,0,0, 0,1,0, 0,0,1); + for i := 1 to nDim do begin + j := abs(round(layout[i]))+1; + nhdr.dim[j] := dim[i]; + if specialsingle(pixdim[i]) then + pixdim[i] := 0.0; + nhdr.pixdim[j] := pixdim[i]; + if j = 4 then + nhdr.pixdim[j] := repetitionTime; + if i > 3 then continue; + for k := 0 to 2 do + m33[k,j-1] := m[k,i-1]; + if layout[i] < 0 then begin + nhdr.pixdim[j] := -pixdim[i]; + originVox[j-1] := dim[i]-1; + end; + end; + //scale matrix + for i := 0 to 2 do + for j := 0 to 2 do + m33[j,i] := m33[j,i] * nhdr.pixdim[i+1]; + originMM := nifti_mat33vec_mul(m33, originVox); + for i := 1 to 3 do + nhdr.pixdim[i] := abs(nhdr.pixdim[i]); + for i := 0 to 2 do + m[i,3] := m[i,3] - originMM[i]; + nhdr.srow_x[0] := m33[0,0]; + nhdr.srow_x[1] := m33[0,1]; + nhdr.srow_x[2] := m33[0,2]; + nhdr.srow_x[3] := m[0,3]; + nhdr.srow_y[0] := m33[1,0]; + nhdr.srow_y[1] := m33[1,1]; + nhdr.srow_y[2] := m33[1,2]; + nhdr.srow_y[3] := m[1,3]; + nhdr.srow_z[0] := m33[2,0]; + nhdr.srow_z[1] := m33[2,1]; + nhdr.srow_z[2] := m33[2,2]; + nhdr.srow_z[3] := m[2,3]; + convertForeignToNifti(nhdr); + result := true; +666: + if isGz then begin + gzBytes := K_gzBytes_headerAndImageCompressed; + zfs.Free; + end else + fs.Free; + mArray.Free; +end; //readMIF() +{$ENDIF} + +function readICSHeader(var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian: boolean): boolean; +label + 666; +var + isInt: boolean = true; + isSigned: boolean = true; + f: TFByte; + str: string; + i,nItems, lsb, bpp: integer; + mArray: TStringList; + //https://onlinelibrary.wiley.com/doi/epdf/10.1002/cyto.990110502 +begin + lsb := 0; + bpp := 0; + gzBytes := 0; + result := false; + mArray := TStringList.Create; + AssignFile(f, fname); + FileMode := fmOpenRead; + Reset(f,1); + ReadLnBin(f, str); //first line 011 012 + if (length(str) < 1) or (str[1] <> chr($09)) then + goto 666; //not a valid ICS file + ReadLnBin(f, str); //version + if not AnsiStartsText('ics_version', str) then + goto 666; + ReadLnBin(f, str); //filename + if not AnsiStartsText('filename', str) then begin + {$IFDEF UNIX} writeln('Error: expected ICS tag "filename": ICS 2.0?');{$ENDIF} + goto 666; + end; + splitstr(' ',str,mArray); + nItems :=mArray.count; + if (nItems < 2) then goto 666; + str := fname; + fname := extractfilename(mArray[1]); + if upcase(extractfileext(fname)) <> '.IDS' then + fname := fname+'.ids'; + (*if (not fileexists(fname)) and fileexists(fname+ '.Z') then begin + gzBytes := K_gzBytes_onlyImageCompressed;//K_gzBytes_headerAndImageCompressed; + fname := fname+'.Z'; + //example testim_c.ids.Z has no Zlib header or footer + end; *) + if not fileexists(fname) then begin + fname := ExtractFilePath(str)+fname; + (*if (not fileexists(fname)) and fileexists(fname+ '.Z') then begin + gzBytes := K_gzBytes_onlyImageCompressed;//K_gzBytes_headerAndImageCompressed; + fname := fname+'.Z'; + end;*) + if not fileexists(fname) then begin + NSLog('Unable to find IDS image '+fname); + goto 666; + end; + end; + while ReadLnBin(f, str) do begin + splitstr(' ',str,mArray); + nItems :=mArray.count; + //showmessage(str); + if (nItems > 4) and AnsiStartsText('layout', mArray[0]) and AnsiStartsText('sizes', mArray[1]) then begin + //writeln('!bpp', mArray[2]); + bpp := StrToIntDef(mArray[2],0); + //showmessage(str); + for i := 3 to (nItems-1) do + nhdr.dim[i-2] := StrToIntDef(mArray[i],0); + //layout sizes 8 256 256 + end; + if (nItems > 3) and AnsiStartsText('parameter', mArray[0]) and AnsiStartsText('scale', mArray[1]) then begin + for i := 2 to (nItems-1) do + nhdr.pixdim[i-1] := StrToIntDef(mArray[i],0); + end; + if (nItems > 2) and AnsiStartsText('representation', mArray[0]) and AnsiStartsText('compression', mArray[1]) then begin + if not AnsiStartsText('uncompressed', mArray[2]) then begin + {$IFDEF UNIX} writeln('Unknown compression '+str);{$ENDIF} + goto 666; + end; + writeln('!no compression', mArray[2]); + //layout sizes 8 256 256 + end; + if (nItems > 2) and AnsiStartsText('representation', mArray[0]) and AnsiStartsText('format', mArray[1]) then begin + if not AnsiStartsText('integer', mArray[2]) then + isInt := false; + end; + if (nItems > 2) and AnsiStartsText('representation', mArray[0]) and AnsiStartsText('sign', mArray[1]) then begin + if AnsiStartsText('unsigned', mArray[2]) then + isSigned := false; + end; + if (nItems > 2) and AnsiStartsText('representation', mArray[0]) and AnsiStartsText('byte_order', mArray[1]) then begin + lsb := StrToIntDef(mArray[2],0); + end; + //representation byte_order 1 + //writeln('-->'+str+'<<'); + end; + if (bpp = 32) and (not isInt) then + nhdr.datatype := kDT_FLOAT32 + else if (bpp = 32) and (isSigned) and (isInt) then + nhdr.datatype := kDT_INT32 + else if (bpp = 32) and (not isSigned) and (isInt) then + nhdr.datatype := kDT_UINT32 + else if (bpp = 16) and (isSigned) and (isInt) then + nhdr.datatype := kDT_INT16 + else if (bpp = 16) and (not isSigned) and (isInt) then + nhdr.datatype := kDT_UINT16 + else if (bpp = 8) and (isSigned) and (isInt) then + nhdr.datatype := kDT_INT8 + else if (bpp = 8) and (not isSigned) and (isInt) then + nhdr.datatype := kDT_UINT8 + else begin + NSLog(format('Unsupported data type: bits %d signed %s int %s', [bpp, BoolToStr(isSigned,'T','F'), BoolToStr(isInt,'T','F')])); + goto 666; + end; + nhdr.srow_x[0] := -nhdr.pixdim[1]; + nhdr.srow_x[1] := 0; + nhdr.srow_x[2] := 0; + nhdr.srow_x[3] := 0; + + nhdr.srow_y[0] := 0; + nhdr.srow_y[1] := -nhdr.pixdim[2]; + nhdr.srow_y[2] := 0; + nhdr.srow_y[3] := 0; + + nhdr.srow_z[0] := 0; + nhdr.srow_z[1] := 0; + nhdr.srow_z[2] := nhdr.pixdim[3]; + nhdr.srow_z[3] := 0; + + nhdr.vox_offset := 0; + {$IFDEF ENDIAN_BIG} + if (bpp > 8) and (lsb < 2) then + {$ELSE} + if (bpp > 8) and (lsb > 1) then + {$ENDIF} + swapEndian := true; + convertForeignToNifti(nhdr); + result := true; + 666: + mArray.free; + closefile(f); +end; //readICSHeader + +function readNRRDHeader (var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian, isDimPermute2341: boolean): boolean; +//http://www.sci.utah.edu/~gk/DTI-data/ +//http://teem.sourceforge.net/nrrd/format.html +FUNCTION specialdouble (d:double): boolean; +//returns true if s is Infinity, NAN or Indeterminate +//8byte IEEE: msb[63] = signbit, bits[52-62] exponent, bits[0..51] mantissa +//exponent of all 1s = Infinity, NAN or Indeterminate +CONST kSpecialExponent = 2047 shl 20; +VAR Overlay: ARRAY[1..2] OF LongInt ABSOLUTE d; +BEGIN + IF ((Overlay[2] AND kSpecialExponent) = kSpecialExponent) THEN + RESULT := true + ELSE + RESULT := false; +END; +label + 666; +const + NaN : double = 1/0; +var + FP: TextFile; + ch: char; + mArray: TStringList; + pth, str,tagName,elementNames, str2: string; + lineskip,byteskip,i,s,nItems,headerSize,matElements,fileposBytes: integer; + mat: mat33; + rot33: mat33; + isOK, isDetachedFile,isFirstLine: boolean; + offset: array[0..3] of single; + vSqr, flt: single; + transformMatrix: array [0..11] of single; + dtMin, dtMax, dtRange, dtScale, oldRange, oldMin, oldMax: double; +begin + //gX := gX + 1; GLForm1.caption := inttostr(gX); + //LOAD_MAT33(rot33, 1,0,0, 0,1,0, 0,0,1); + LOAD_MAT33(rot33, -1,0,0, 0,-1,0, 0,0,1); + oldMin := NaN; + oldMax := NaN; + isDimPermute2341 := false; + pth := ExtractFilePath(fname); + isOK := true; + {$IFDEF FPC} + DefaultFormatSettings.DecimalSeparator := '.' ; + //DecimalSeparator := '.'; + {$ELSE} + DecimalSeparator := '.'; + {$ENDIF} + result := false; + gzBytes :=0; + fileposBytes := 0; + swapEndian :=false; + //nDims := 0; + headerSize :=0; + lineskip := 0; + byteskip := 0; + isDetachedFile :=false; + matElements :=0; + mArray := TStringList.Create; + isFirstLine := true; + FileMode := fmOpenRead; + AssignFile(fp,fname); + reset(fp); + while (not EOF(fp)) do begin + str := ''; + while not EOF(fp) do begin + read(fp,ch); + if (ch = chr($00)) then break; //NRRD format specifies blank line before raw data, but some writers ignore this requirement, e.g. https://www.mathworks.com/matlabcentral/fileexchange/51174-dicom-medical-image-to-nrrd-medical-image + fileposBytes := fileposBytes + 1; + //if (ch = chr($0D)) or (ch = chr($0A)) then break; + if (ch = chr($0D)) then continue; + if (ch = chr($0A)) then break; + + str := str+ch; + end; + if str = '' then break; //if str = '' then continue; + if (isFirstLine) then begin + if (length(str) <4) or (str[1]<>'N') or (str[2]<>'R') or (str[3]<>'R') or (str[4]<>'D') then + goto 666; + isFirstLine := false; + end; + if (length(str) < 1) or (str[1]='#') then continue; + splitstrStrict(':',str,mArray); + if (mArray.count < 2) then continue; + tagName := mArray[0]; + //showmessage(inttostr(length(tagName))+':'+tagName); + elementNames := mArray[1]; + splitstr(',',elementNames,mArray); + nItems :=mArray.count; + if (nItems < 1) then continue; + for i := 0 to (nItems-1) do + mArray.Strings[i] := cleanStr(mArray.Strings[i]); //remove '(' and ')' + (*if AnsiContainsText(tagName, 'dimension') then + nDims := strtoint(mArray.Strings[0]) + else*) if AnsiStartsText( 'spacings', tagName) then begin + if (nItems > 6) then nItems :=6; + for i:=0 to (nItems-1) do + nhdr.pixdim[i+1] :=strtofloat(mArray.Strings[i]); + end else if (AnsiStartsText( 'oldmin', tagName)) or (AnsiStartsText( 'old min', tagName)) then begin + oldMin :=strtofloat(mArray.Strings[i]); + end else if (AnsiStartsText( 'oldmax', tagName)) or (AnsiStartsText( 'old max', tagName)) then begin + oldMax :=strtofloat(mArray.Strings[i]); + end else if AnsiStartsText('sizes', tagName) then begin + if (nItems > 6) then nItems :=6; + //for i:=1 to 6 do + // nhdr.dim[i] := 1; + for i:=0 to (nItems-1) do + nhdr.dim[i+1] := strtoint(mArray.Strings[i]); + end else if AnsiStartsText('space directions',tagName) then begin + if (nItems > 12) then nItems :=12; + matElements := 0; + for i:=0 to (nItems-1) do begin + if (matElements = 0) and AnsiContainsText(mArray.Strings[i], 'none') then begin + isDimPermute2341 := true; + end; + flt := strToFloatDef(mArray.Strings[i], kNANsingle); + if not specialsingle(flt) then begin + transformMatrix[matElements] :=strtofloat(mArray.Strings[i]); + matElements := matElements + 1; + end; + end; + if (matElements >= 12) then + LOAD_MAT33(mat, transformMatrix[0],transformMatrix[1],transformMatrix[2], + transformMatrix[4],transformMatrix[5],transformMatrix[6], + transformMatrix[8],transformMatrix[9],transformMatrix[10]) + else if (matElements >= 9) then + LOAD_MAT33(mat, transformMatrix[0],transformMatrix[1],transformMatrix[2], + transformMatrix[3],transformMatrix[4],transformMatrix[5], + transformMatrix[6],transformMatrix[7],transformMatrix[8]); + end else if AnsiStartsText('type', tagName) then begin //AnsiContainsText(tagName, 'type') then begin + if AnsiContainsText(mArray.Strings[0], 'uchar') or + AnsiContainsText(mArray.Strings[0], 'uint8') or + AnsiContainsText(mArray.Strings[0], 'uint8_t') then + nhdr.datatype := KDT_UINT8 //DT_UINT8 DT_UNSIGNED_CHAR + else if AnsiContainsText(mArray.Strings[0], 'short') or //specific so + AnsiContainsText(mArray.Strings[0], 'int16') or + AnsiContainsText(mArray.Strings[0], 'int16_t') then + nhdr.datatype :=kDT_INT16 //DT_INT16 + else if AnsiContainsText(mArray.Strings[0], 'float') then + nhdr.datatype := kDT_FLOAT32 //DT_FLOAT32 + else if AnsiContainsText(mArray.Strings[0], 'unsigned') + and (nItems > 1) and AnsiContainsText(mArray.Strings[1], 'char') then + nhdr.datatype := kDT_UINT8 //DT_UINT8 + else if AnsiContainsText(mArray.Strings[0], 'unsigned') and + (nItems > 1) and AnsiContainsText(mArray.Strings[1], 'int') then + nhdr.datatype := kDT_UINT32 // + else if AnsiContainsText(mArray.Strings[0], 'signed') and + (nItems > 1) and AnsiContainsText(mArray.Strings[1], 'char') then + nhdr.datatype := kDT_INT8 //do UNSIGNED first, as "isigned" includes string "unsigned" + else if AnsiContainsText(mArray.Strings[0], 'signed') and + (nItems > 1) and AnsiContainsText(mArray.Strings[1], 'short') then + nhdr.datatype := kDT_INT16 //do UNSIGNED first, as "isigned" includes string "unsigned" + else if AnsiContainsText(mArray.Strings[0], 'double') then + nhdr.datatype := kDT_DOUBLE //DT_DOUBLE + else if AnsiContainsText(mArray.Strings[0], 'uint') then + nhdr.datatype := kDT_UINT32 + else if AnsiContainsText(mArray.Strings[0], 'int') then //do this last and "uint" includes "int" + nhdr.datatype := kDT_INT32 + else begin + NSLog('Unsupported NRRD datatype'+mArray.Strings[0]); + isOK := false; + break; + end + end else if AnsiStartsText('endian', tagName) then begin + {$IFDEF ENDIAN_BIG} //data always stored big endian + if AnsiContainsText(mArray.Strings[0], 'little') then swapEndian :=true; + {$ELSE} + if AnsiContainsText(mArray.Strings[0], 'big') then swapEndian :=true; + {$ENDIF} + end else if AnsiStartsText('encoding',tagName) then begin + if AnsiContainsText(mArray.Strings[0], 'raw') then + gzBytes :=0 + else if AnsiContainsText(mArray.Strings[0], 'gz') or AnsiContainsText(mArray.Strings[0], 'gzip') then + gzBytes := K_gzBytes_headerAndImageCompressed//K_gzBytes_headeruncompressed + else begin + NSLog('Unknown encoding format '+mArray.Strings[0]); + isOK := false; + break; + end; + end else if (AnsiStartsText('lineskip',tagName) or AnsiContainsText(tagName, 'line skip')) then begin //http://teem.sourceforge.net/nrrd/format.html#lineskip + lineskip := strtointdef(mArray.Strings[0],0); + end else if (AnsiStartsText('byteskip', tagName) or AnsiContainsText(tagName, 'byte skip')) then begin //http://teem.sourceforge.net/nrrd/format.html#byteskip + byteskip := strtointdef(mArray.Strings[0],0); + end else if AnsiStartsText('space origin', tagName) then begin + if (nItems > 3) then nItems :=3; + for i:=0 to (nItems-1) do + offset[i] := strtofloat(mArray.Strings[i]); + end else if (nItems > 0) and AnsiStartsText('space', tagName) then begin //must do this after "space origin" check + if AnsiStartsText('right-anterior-superior', mArray.Strings[0]) or AnsiStartsText('RAS', mArray.Strings[0]) then + LOAD_MAT33(rot33, 1,0,0, 0,1,0, 0,0,1); //native NIfTI, default identity transform + if AnsiStartsText('left-anterior-superior', mArray.Strings[0]) or AnsiStartsText('LAS', mArray.Strings[0]) then + LOAD_MAT33(rot33, -1,0,0, 0,1,0, 0,0,1); //left-right swap relative to NIfTI + if AnsiStartsText('left-posterior-superior', mArray.Strings[0]) or AnsiStartsText('LPS', mArray.Strings[0]) then begin//native NIfTI, default identity transform + LOAD_MAT33(rot33, -1,0,0, 0,-1,0, 0,0,1); //left-right and anterior-posterior swap relative to NIfTI + end; + end else if AnsiStartsText('data file',tagName) or AnsiContainsText(tagName, 'datafile') then begin + str2 := str; + str := mArray.Strings[0]; + if (pos('LIST', UpperCase(str)) = 1) and (length(str) = 4) then begin //e.g. "data file: LIST" + readln(fp,str); + end; + if (pos('%', UpperCase(str)) > 0) and (nItems > 1) then begin //e.g. "data file: ./r_sphere_%02d.raw.gz 1 4 1" + str := format(str,[strtoint(mArray.Strings[1])]); + end; + if fileexists(str) then + fname := str + else begin + if (length(str) > 0) and (str[1] = '.') then // "./r_sphere_01.raw.gz" + str := copy(str, 2, length(str)-1 ); + if (length(str) > 0) and (str[1] = pathdelim) then // "./r_sphere_01.raw.gz" + str := copy(str, 2, length(str)-1 ); // "/r_sphere_01.raw.gz" + fname := ExtractFilePath(fname)+str; + end; + if not fileexists(fname) then begin + str2 := trim(copy(str2,pos(':',str2)+1, maxint)); + fname := str2; + if not fileexists(fname) then + fname := pth + str2; + //showmessage(inttostr(nhdr.datatype)); + end; + isDetachedFile :=true; + //break; + + end; //for ...else tag names + end; + if ((headerSize = 0) and ( not isDetachedFile)) then begin + if gzBytes = K_gzBytes_headerAndImageCompressed then + gzBytes := K_gzBytes_onlyImageCompressed; //raw text file followed by GZ image + if lineskip > 0 then begin + for i := 1 to lineskip do begin + while not EOF(fp) do begin + read(fp,ch); + fileposBytes := fileposBytes + 1; + if (ch = chr($0D)) or (ch = chr($0A)) then break; + end; //for each character in line + end; //for each line + end; //if lineskip + headerSize :=fileposBytes; + end; + result := true; + if (lineskip > 0) and (isDetachedFile) then begin + NSLog('Unsupported NRRD feature: lineskip in detached file'); + result := false; + end; + if (byteskip > 0) then begin + headerSize := headerSize + byteskip; + //NSLog('Unsupported NRRD feature: byteskip'); + //result := false; + end; + if (nhdr.datatype <> kDT_FLOAT32) and (nhdr.datatype <> kDT_DOUBLE) and (not specialdouble(oldMin)) and (not specialdouble(oldMax)) then begin + oldRange := oldMax - oldMin; + dtMin := 0; //DT_UINT8, DT_RGB24, DT_UINT16 + if (nhdr.datatype = kDT_INT16) then dtMin := -32768.0; + if (nhdr.datatype = kDT_INT32) then dtMin := -2147483648; + dtMax := 255.00; //DT_UINT8, DT_RGB24 + if (nhdr.datatype = kDT_INT16) then dtMax := 32767; + if (nhdr.datatype = kDT_UINT16) then dtMax := 65535.0; + if (nhdr.datatype = kDT_INT32) then dtMax := 2147483647.0; + dtRange := dtMax - dtMin; + dtScale := oldRange/dtRange; + nhdr.scl_slope := dtScale; + nhdr.scl_inter := oldMin - (dtMin*dtScale); + //showmessage(format('%g..%g', [oldMin,oldMax])); + end; + if (isDetachedFile) then + headerSize := byteskip; + if not isOK then result := false; + //GLForm1.ShaderMemo.Lines.Add(format(' %d', [gzBytes])); +666: + CloseFile(FP); + Filemode := 2; + mArray.free; + if not result then exit; + nhdr.vox_offset := headerSize; + if (matElements >= 9) then begin + //mat := nifti_mat33_mul( mat , rot33); + if rot33[0,0] < 0 then offset[0] := -offset[0]; //origin L<->R + if rot33[1,1] < 0 then offset[1] := -offset[1]; //origin A<->P + if rot33[2,2] < 0 then offset[2] := -offset[2]; //origin S<->I + mat := nifti_mat33_mul( mat , rot33); + nhdr.srow_x[0] := mat[0,0]; + nhdr.srow_x[1] := mat[1,0]; + nhdr.srow_x[2] := mat[2,0]; + nhdr.srow_x[3] := offset[0]; + nhdr.srow_y[0] := mat[0,1]; + nhdr.srow_y[1] := mat[1,1]; + nhdr.srow_y[2] := mat[2,1]; + nhdr.srow_y[3] := offset[1]; + nhdr.srow_z[0] := mat[0,2]; + nhdr.srow_z[1] := mat[1,2]; + nhdr.srow_z[2] := mat[2,2]; + nhdr.srow_z[3] := offset[2]; + //end; + //next: ITK does not generate a "spacings" tag - get this from the matrix... + for s :=0 to 2 do begin + vSqr :=0.0; + for i :=0 to 2 do + vSqr := vSqr+ ( mat[s,i]*mat[s,i]); + nhdr.pixdim[s+1] :=sqrt(vSqr); + end //for each dimension + end; + (*showmessage(format('m = [%g %g %g %g; %g %g %g %g; %g %g %g %g; 0 0 0 1]',[ + nhdr.srow_x[0], nhdr.srow_x[1], nhdr.srow_x[2], nhdr.srow_x[3], + nhdr.srow_y[0], nhdr.srow_y[1], nhdr.srow_y[2], nhdr.srow_y[3], + nhdr.srow_z[0], nhdr.srow_z[1], nhdr.srow_z[2], nhdr.srow_z[3]]));*) + convertForeignToNifti(nhdr); + //showmessage(floattostr(nhdr.vox_offset)); + //nhdr.vox_offset := 209; +end; //readNRRDHeader() + +procedure THD_daxes_to_NIFTI (var nhdr: TNIFTIhdr; xyzDelta, xyzOrigin: vect3; orientSpecific: ivect3); +//see http://afni.nimh.nih.gov/pub/dist/src/thd_matdaxes.c +const + ORIENT_xyz1 = 'xxyyzzg'; //note Pascal strings indexed from 1, not 0! + //ORIENT_sign1 = '+--++-'; //note Pascal strings indexed from 1, not 0! +var + //axnum: array[0..2] of integer; + axcode: array[0..2] of char; + //axsign: array[0..2] of char; + axstart,axstep: array[0..2] of single; + ii, nif_x_axnum, nif_y_axnum, nif_z_axnum: integer; + qto_xyz: mat44; + +begin + nif_x_axnum := -1; + nif_y_axnum := -1; + nif_z_axnum := -1; + //axnum[0] := nhdr.dim[1]; + //axnum[1] := nhdr.dim[2]; + //axnum[2] := nhdr.dim[3]; + axcode[0] := ORIENT_xyz1[1+ orientSpecific[0] ] ; + axcode[1] := ORIENT_xyz1[1+ orientSpecific[1] ] ; + axcode[2] := ORIENT_xyz1[1+ orientSpecific[2] ] ; + //axsign[0] := ORIENT_sign1[1+ orientSpecific[0] ] ; + //axsign[1] := ORIENT_sign1[1+ orientSpecific[1] ] ; + //axsign[2] := ORIENT_sign1[1+ orientSpecific[2] ] ; + axstep[0] := xyzDelta[0] ; + axstep[1] := xyzDelta[1] ; + axstep[2] := xyzDelta[2] ; + axstart[0] := xyzOrigin[0] ; + axstart[1] := xyzOrigin[1] ; + axstart[2] := xyzOrigin[2] ; + for ii := 0 to 2 do begin + if (axcode[ii] = 'x') then + nif_x_axnum := ii + else if (axcode[ii] = 'y') then + nif_y_axnum := ii + else + nif_z_axnum := ii ; + end; + if (nif_x_axnum < 0) or (nif_y_axnum < 0) or (nif_z_axnum < 0) then exit; //not assigned + if (nif_x_axnum = nif_y_axnum) or (nif_x_axnum = nif_z_axnum) or (nif_y_axnum = nif_z_axnum) then exit; //not assigned + ZERO_MAT44(qto_xyz); + //-- set voxel and time deltas and units -- + nhdr.pixdim[1] := abs ( axstep[0] ) ; + nhdr.pixdim[2] := abs ( axstep[1] ) ; + nhdr.pixdim[3] := abs ( axstep[2] ) ; + qto_xyz[0,nif_x_axnum] := - axstep[nif_x_axnum]; + qto_xyz[1,nif_y_axnum] := - axstep[nif_y_axnum]; + qto_xyz[2,nif_z_axnum] := axstep[nif_z_axnum]; + nhdr.qoffset_x := -axstart[nif_x_axnum] ; + nhdr.qoffset_y := -axstart[nif_y_axnum]; + nhdr.qoffset_z := axstart[nif_z_axnum]; + qto_xyz[0,3] := nhdr.qoffset_x ; + qto_xyz[1,3] := nhdr.qoffset_y ; + qto_xyz[2,3] := nhdr.qoffset_z ; + //nifti_mat44_to_quatern( qto_xyz , nhdr.quatern_b, nhdr.quatern_c, nhdr.quatern_d,dumqx, dumqy, dumqz, dumdx, dumdy, dumdz,nhdr.pixdim[0]) ; + //nhdr.qform_code := kNIFTI_XFORM_SCANNER_ANAT; + nhdr.srow_x[0] :=qto_xyz[0,0]; nhdr.srow_x[1] :=qto_xyz[0,1]; nhdr.srow_x[2] :=qto_xyz[0,2]; nhdr.srow_x[3] :=qto_xyz[0,3]; + nhdr.srow_y[0] :=qto_xyz[1,0]; nhdr.srow_y[1] :=qto_xyz[1,1]; nhdr.srow_y[2] :=qto_xyz[1,2]; nhdr.srow_y[3] :=qto_xyz[1,3]; + nhdr.srow_z[0] :=qto_xyz[2,0]; nhdr.srow_z[1] :=qto_xyz[2,1]; nhdr.srow_z[2] :=qto_xyz[2,2]; nhdr.srow_z[3] :=qto_xyz[2,3]; + nhdr.sform_code := kNIFTI_XFORM_SCANNER_ANAT; +end; + +function readAFNIHeader (var fname: string; var nhdr: TNIFTIhdr; var gzBytes: int64; var swapEndian: boolean): boolean; +label + 666; +var + sl, mArray: TStringList; + typeStr,nameStr, valStr: string; + lineNum, itemCount,i, vInt, nVols: integer; + isAllVolumesSame, isProbMap, isStringAttribute: boolean; + valArray : Array of double; + orientSpecific: ivect3; + xyzOrigin, xyzDelta: vect3; +begin + {$IFDEF FPC} + DefaultFormatSettings.DecimalSeparator := '.' ; + //DecimalSeparator := '.'; + {$ELSE} + DecimalSeparator := '.'; + {$ENDIF} + nVols := 1; + result := false; + isProbMap := false; + gzBytes := 0; + swapEndian := false; + sl := TStringList.Create; + mArray := TStringList.Create; + sl.LoadFromFile(fname); + if(sl.count) < 4 then goto 666; + lineNum := -1; + repeat + //read type string + lineNum := lineNum + 1; + if length(sl[lineNum]) < 1 then continue; + splitstr('=',sl[lineNum],mArray); + if mArray.Count < 2 then continue; + if not AnsiContainsText(cleanStr(mArray[0]), 'type') then continue; + typeStr := cleanStr(mArray[1]); + isStringAttribute := AnsiContainsText(typeStr, 'string-attribute'); + //next: read name string + lineNum := lineNum + 1; + if (lineNum >= (sl.count-1)) then continue; + splitstr('=',sl[lineNum],mArray); + if mArray.Count < 2 then continue; + if not AnsiContainsText(cleanStr(mArray[0]), 'name') then continue; + nameStr := cleanStr(mArray[1]); + //if AnsiContainsText(nameStr,'BYTEORDER_STRING') and isStringAttribute then showmessage('txt'); + //next: read count string + lineNum := lineNum + 1; + if (lineNum >= (sl.count-1)) then continue; + splitstr('=',sl[lineNum],mArray); + if mArray.Count < 2 then continue; + if not AnsiContainsText(cleanStr(mArray[0]), 'count') then continue; + itemCount := strtoint(cleanStr(mArray[1])); + if itemCount < 1 then exit; + //next read values + lineNum := lineNum + 1; + if (lineNum > (sl.count-1)) then continue; + valStr := sl[lineNum]; + while ((lineNum+1) <= (sl.count-1)) and (length(sl[lineNum+1]) > 0) do begin + lineNum := lineNum + 1; //AFNI wraps some arrays across multiple lines + valStr := valStr + ' '+ sl[lineNum]; + end; + splitstr(' ',valStr,mArray); + if (mArray.Count < itemCount) then itemCount := mArray.Count; // <- only if corrupt + if itemCount < 1 then continue; // <- only if corrupt data + if isStringAttribute then begin + if AnsiContainsText(nameStr,'BYTEORDER_STRING') then begin + {$IFDEF ENDIAN_BIG} + if AnsiContainsText(mArray[0],'LSB_FIRST') then swapEndian := true; + {$ELSE} + if AnsiContainsText(mArray[0],'MSB_FIRST') then swapEndian := true; + {$ENDIF} + end + end else begin //if numeric attributes... + setlength(valArray,itemCount); + for i := 0 to (itemCount-1) do + valArray[i] := strtofloat(cleanStr(mArray[i]) ); + //next - harvest data from important names + if AnsiContainsText(nameStr,'BRICK_TYPES') then begin + vInt := round(valArray[0]); + if (vInt = 0) then begin + nhdr.datatype := kDT_UINT8; + end else if (vInt = 1) then begin + nhdr.datatype := kDT_INT16; //16 bit signed int + end else if (vInt = 3) then begin + nhdr.datatype := kDT_FLOAT32;//32-bit float + end else begin + NSLog('Unsupported BRICK_TYPES '+inttostr(vInt)); + goto 666; + end; + if (itemCount > 1) then begin //check that all volumes are of the same datatype + nVols := itemCount; + isAllVolumesSame := true; + for i := 1 to (itemCount-1) do + if (valArray[0] <> valArray[i]) then isAllVolumesSame := false; + if (not isAllVolumesSame) then begin + NSLog('Unsupported BRICK_TYPES feature: datatype varies between sub-bricks'); + goto 666; + end; + end; //if acount > 0 + //NSLog('HEAD datatype is '+inttostr(nhdr.datatype) ); + end else if AnsiContainsText(nameStr,'BRICK_FLOAT_FACS') then begin + nhdr.scl_slope := valArray[0]; + if (itemCount > 1) then begin //check that all volumes are of the same datatype + isAllVolumesSame := true; + for i := 1 to (itemCount-1) do + if (valArray[0] <> valArray[i]) then isAllVolumesSame := false; + if (not isAllVolumesSame) then begin + NSLog('Unsupported BRICK_FLOAT_FACS feature: intensity scale between sub-bricks'); + end; + end; //if acount > 0 + end else if AnsiContainsText(nameStr,'DATASET_DIMENSIONS') then begin + if itemCount > 3 then itemCount := 3; + for i := 0 to (itemCount-1) do + nhdr.dim[i+1] := round(valArray[i]); + end else if AnsiContainsText(nameStr,'ORIENT_SPECIFIC') then begin + if itemCount > 3 then itemCount := 3; + for i := 0 to (itemCount-1) do + orientSpecific[i] := round(valArray[i]);; + //NSLog(@"HEAD orient specific %d %d %d",orientSpecific.v[0],orientSpecific.v[1],orientSpecific.v[2]); + end else if AnsiContainsText(nameStr,'ORIGIN') then begin + if itemCount > 3 then itemCount := 3; + for i := 0 to (itemCount-1) do + xyzOrigin[i] := valArray[i]; + //NSLog(@"HEAD origin %g %g %g",xyzOrigin.v[0],xyzOrigin.v[1],xyzOrigin.v[2]); + end else if AnsiContainsText(nameStr,'ATLAS_PROB_MAP') then begin + if (round(valArray[0]) = 1) then isProbMap := true; + end else if AnsiContainsText(nameStr,'ATLAS_LABEL_TABLE') then begin + nhdr.intent_code := kNIFTI_INTENT_LABEL; + end else if AnsiContainsText(nameStr,'DELTA') then begin + if itemCount > 3 then itemCount := 3; + for i := 0 to (itemCount-1) do + xyzDelta[i] := valArray[i]; + //NSLog(@"HEAD delta %g %g %g",xyzDelta.v[0],xyzDelta.v[1],xyzDelta.v[2]); + end else if AnsiContainsText(nameStr,'TAXIS_FLOATS') then begin + if (itemCount > 1) then nhdr.pixdim[4] := valArray[1]; //second item is TR + end; + end;// if isStringAttribute else numeric inputs... + until (lineNum >= (sl.count-1)); + result := true; +666: + valArray := nil; //release dynamic array + Filemode := 2; + sl.free; + mArray.free; + if not result then exit; //error - code jumped to 666 without setting result to true + if (nVols > 1) then nhdr.dim[4] := nVols; + if (isProbMap) and (nhdr.intent_code = kNIFTI_INTENT_LABEL) then nhdr.intent_code := kNIFTI_INTENT_NONE; + THD_daxes_to_NIFTI(nhdr, xyzDelta, xyzOrigin, orientSpecific ); + nhdr.vox_offset := 0; + convertForeignToNifti(nhdr); + fname := ChangeFileExt(fname, '.BRIK'); + if (not FileExists(fname)) then begin + fname := fname+'.gz'; + gzBytes := K_gzBytes_headerAndImageCompressed; + end; +end; + +function readForeignHeader (var lFilename: string; var lHdr: TNIFTIhdr; var gzBytes: int64; var swapEndian, isDimPermute2341: boolean): boolean; +var + lExt, lExt2GZ: string; +begin + NII_Clear (lHdr); + gzBytes := 0; + swapEndian := false; + //gzBytes := false; + isDimPermute2341 := false; + result := false; + if FSize(lFilename) < 140 then + exit; + lExt := UpCaseExt(lFilename); + lExt2GZ := ''; + if (lExt = '.GZ') then begin + lExt2GZ := changefileext(lFilename,''); + lExt2GZ := UpCaseExt(lExt2GZ); + end; + if (lExt = '.DV') then + result := nii_readDeltaVision(lFilename, lHdr, swapEndian) + else if (lExt = '.V') then + result := nii_readEcat(lFilename, lHdr, gzBytes, swapEndian) + else if (lExt = '.VMR') then + result := nii_readVmr(lFilename, false, lHdr, swapEndian) + else if (lExt = '.V16') then + result := nii_readVmr(lFilename, true, lHdr, swapEndian) + else if (lExt = '.BVOX') then + result := nii_readBVox(lFilename, lHdr, swapEndian) + else if (lExt = '.GIPL') then + result := nii_readGipl(lFilename, lHdr, swapEndian) + else if (lExt = '.PIC') then + result := nii_readpic(lFilename, lHdr) + else if (lExt = '.VTK') then + result := readVTKHeader(lFilename, lHdr, gzBytes, swapEndian) + else if (lExt = '.MGH') or (lExt = '.MGZ') then + result := readMGHHeader(lFilename, lHdr, gzBytes, swapEndian) + else if (lExt = '.MHD') or (lExt = '.MHA') then + result := readMHAHeader(lFilename, lHdr, gzBytes, swapEndian) + else if (lExt = '.ICS') then + result := readICSHeader(lFilename, lHdr, gzBytes, swapEndian) + else if ((lExt2GZ = '.MIF') or (lExt = '.MIF') or (lExt = '.MIH')) then + result := readMIF(lFilename, lHdr, gzBytes, swapEndian) + else if (lExt = '.NRRD') or (lExt = '.NHDR') then + result := readNRRDHeader(lFilename, lHdr, gzBytes, swapEndian, isDimPermute2341) + else if (lExt = '.HEAD') then + result := readAFNIHeader(lFilename, lHdr, gzBytes, swapEndian); + if (not result) and (isTIFF(lFilename)) then + NSLog('Use the Import menu (or ImageJ/Fiji) to convert TIFF and LSM files to NIfTI (or NRRD) for viewing') + else if (not result) then begin + lExt2GZ := isBioFormats(lFilename); + if lExt2GZ <> '' then + NSLog('Use ImageJ/Fiji to convert this '+lExt2GZ+' BioFormat image to NRRD for viewing'); + end; +end; + +end. + diff --git a/nifti_hdr_view.lfm b/nifti_hdr_view.lfm index 317c88f..0c33257 100755 --- a/nifti_hdr_view.lfm +++ b/nifti_hdr_view.lfm @@ -1,14 +1,14 @@ object HdrForm: THdrForm - Left = 554 - Height = 406 - Top = 118 - Width = 601 + Left = 503 + Height = 353 + Top = 103 + Width = 604 AutoSize = True - BorderStyle = bsDialog + BorderWidth = 2 Caption = 'NIfTI Header Information' - ClientHeight = 406 - ClientWidth = 601 - Constraints.MinHeight = 320 + ClientHeight = 353 + ClientWidth = 604 + Constraints.MinHeight = 224 Constraints.MinWidth = 540 Menu = HdrMenu OnCreate = FormCreate @@ -17,10 +17,10 @@ object HdrForm: THdrForm Position = poScreenCenter LCLVersion = '2.1.0.0' object PageControl1: TPageControl - Left = 4 - Height = 376 - Top = 4 - Width = 593 + Left = 6 + Height = 319 + Top = 6 + Width = 592 ActivePage = DimensionSheet Align = alClient BorderSpacing.Left = 2 @@ -33,8 +33,8 @@ object HdrForm: THdrForm OnChange = PageControl1Change object DimensionSheet: TTabSheet Caption = 'Dimensions' - ClientHeight = 346 - ClientWidth = 587 + ClientHeight = 289 + ClientWidth = 586 OnContextPopup = DimensionSheetContextPopup object Label21: TLabel AnchorSideLeft.Control = DimensionSheet @@ -48,21 +48,21 @@ object HdrForm: THdrForm Caption = 'Header Type' ParentColor = False end - object Label1: TLabel + object DimLabel: TLabel AnchorSideLeft.Control = DimensionSheet AnchorSideTop.Control = HeaderMagicDrop AnchorSideTop.Side = asrBottom Left = 10 Height = 16 Top = 30 - Width = 251 + Width = 64 BorderSpacing.Left = 10 BorderSpacing.Top = 6 - Caption = 'Dimension Length Spacing Unit' + Caption = 'Dimension' ParentColor = False end object Label2: TLabel - AnchorSideLeft.Control = Label1 + AnchorSideLeft.Control = DimLabel AnchorSideTop.Control = Xmm AnchorSideTop.Side = asrCenter Left = 10 @@ -95,7 +95,7 @@ object HdrForm: THdrForm ParentColor = False end object Label8: TLabel - AnchorSideLeft.Control = Label1 + AnchorSideLeft.Control = DimLabel AnchorSideTop.Control = fTypeDrop AnchorSideTop.Side = asrCenter Left = 10 @@ -110,7 +110,7 @@ object HdrForm: THdrForm AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = PixDim7 AnchorSideTop.Side = asrCenter - Left = 296 + Left = 282 Height = 16 Top = 216 Width = 38 @@ -172,6 +172,7 @@ object HdrForm: THdrForm Width = 239 BorderSpacing.Left = 6 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Unknown' 'ni1: NIfTI separate file (hdr+.img)' @@ -182,7 +183,7 @@ object HdrForm: THdrForm OnSelect = HeaderMagicDropSelect Style = csDropDownList TabOrder = 15 - Text = '0' + Text = 'Unknown' end object Endian: TComboBox AnchorSideLeft.Control = fTypeDrop @@ -192,16 +193,17 @@ object HdrForm: THdrForm Left = 202 Height = 20 Top = 241 - Width = 210 + Width = 212 BorderSpacing.Left = 6 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Native Endian' 'Swapped Endian' ) Style = csDropDownList TabOrder = 16 - Text = '0' + Text = 'Native Endian' end object fTypeDrop: TComboBox AnchorSideLeft.Control = Label8 @@ -216,6 +218,7 @@ object HdrForm: THdrForm BorderSpacing.Top = 6 DropDownCount = 20 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'binary' '8-bit S' @@ -236,19 +239,20 @@ object HdrForm: THdrForm ) Style = csDropDownList TabOrder = 17 - Text = '0' + Text = 'binary' end object xyzt_sizeDrop: TComboBox AnchorSideLeft.Control = Ymm AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Ymm AnchorSideTop.Side = asrCenter - Left = 272 + Left = 260 Height = 20 Top = 79 Width = 128 - BorderSpacing.Left = 6 + BorderSpacing.Left = 8 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Unknown' 'Meter' @@ -258,19 +262,20 @@ object HdrForm: THdrForm ) Style = csDropDownList TabOrder = 18 - Text = '0' + Text = 'Unknown' end object xyzt_timeDrop: TComboBox AnchorSideLeft.Control = TSec AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = TSec AnchorSideTop.Side = asrCenter - Left = 272 + Left = 258 Height = 20 Top = 133 Width = 128 BorderSpacing.Left = 6 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Unknown' 'Second' @@ -282,17 +287,18 @@ object HdrForm: THdrForm ) Style = csDropDownList TabOrder = 19 - Text = '0' + Text = 'Unknown' end object Xdim: TSpinEdit - AnchorSideLeft.Control = Label1 - AnchorSideLeft.Side = asrCenter + AnchorSideLeft.Control = DimLabel + AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Xmm AnchorSideTop.Side = asrCenter - Left = 98 + Left = 82 Height = 21 Top = 52 Width = 74 + BorderSpacing.Left = 8 MaxValue = 9999 MinValue = 1 TabOrder = 0 @@ -302,7 +308,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xdim AnchorSideTop.Control = Ymm AnchorSideTop.Side = asrCenter - Left = 98 + Left = 82 Height = 21 Top = 79 Width = 74 @@ -315,7 +321,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xdim AnchorSideTop.Control = Zmm AnchorSideTop.Side = asrCenter - Left = 98 + Left = 82 Height = 21 Top = 106 Width = 74 @@ -327,15 +333,15 @@ object HdrForm: THdrForm object Xmm: TFloatSpinEdit AnchorSideLeft.Control = Xdim AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Label1 + AnchorSideTop.Control = DimLabel AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Label1 + AnchorSideRight.Control = DimLabel AnchorSideRight.Side = asrBottom - Left = 178 + Left = 164 Height = 21 Top = 52 Width = 88 - BorderSpacing.Left = 6 + BorderSpacing.Left = 8 BorderSpacing.Top = 6 DecimalPlaces = 4 MaxValue = 99999999 @@ -347,7 +353,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xmm AnchorSideTop.Control = Xmm AnchorSideTop.Side = asrBottom - Left = 178 + Left = 164 Height = 21 Top = 79 Width = 88 @@ -362,7 +368,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xmm AnchorSideTop.Control = Ymm AnchorSideTop.Side = asrBottom - Left = 178 + Left = 164 Height = 21 Top = 106 Width = 88 @@ -378,7 +384,7 @@ object HdrForm: THdrForm AnchorSideLeft.Side = asrBottom AnchorSideTop.Control = Label7 AnchorSideTop.Side = asrCenter - Left = 340 + Left = 326 Height = 21 Top = 214 Width = 94 @@ -391,7 +397,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xdim AnchorSideTop.Control = TSec AnchorSideTop.Side = asrCenter - Left = 98 + Left = 82 Height = 21 Top = 133 Width = 74 @@ -404,7 +410,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xmm AnchorSideTop.Control = Zmm AnchorSideTop.Side = asrBottom - Left = 178 + Left = 164 Height = 21 Top = 133 Width = 88 @@ -419,7 +425,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xdim AnchorSideTop.Control = PixDim5 AnchorSideTop.Side = asrCenter - Left = 98 + Left = 82 Height = 21 Top = 160 Width = 74 @@ -432,7 +438,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xdim AnchorSideTop.Control = PixDim6 AnchorSideTop.Side = asrCenter - Left = 98 + Left = 82 Height = 21 Top = 187 Width = 74 @@ -445,7 +451,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xdim AnchorSideTop.Control = PixDim7 AnchorSideTop.Side = asrCenter - Left = 98 + Left = 82 Height = 21 Top = 214 Width = 74 @@ -458,7 +464,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xmm AnchorSideTop.Control = TSec AnchorSideTop.Side = asrBottom - Left = 178 + Left = 164 Height = 21 Top = 160 Width = 88 @@ -473,7 +479,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xmm AnchorSideTop.Control = PixDim5 AnchorSideTop.Side = asrBottom - Left = 178 + Left = 164 Height = 21 Top = 187 Width = 88 @@ -488,7 +494,7 @@ object HdrForm: THdrForm AnchorSideLeft.Control = Xmm AnchorSideTop.Control = PixDim6 AnchorSideTop.Side = asrBottom - Left = 178 + Left = 164 Height = 21 Top = 214 Width = 88 @@ -499,11 +505,41 @@ object HdrForm: THdrForm TabOrder = 8 Value = 0 end + object LengthLabel: TLabel + AnchorSideLeft.Control = Xdim + AnchorSideTop.Control = DimLabel + Left = 82 + Height = 16 + Top = 30 + Width = 42 + Caption = 'Length' + ParentColor = False + end + object SpacingLabel: TLabel + AnchorSideLeft.Control = Xmm + AnchorSideTop.Control = DimLabel + Left = 164 + Height = 16 + Top = 30 + Width = 49 + Caption = 'Spacing' + ParentColor = False + end + object UnitLabel: TLabel + AnchorSideLeft.Control = xyzt_sizeDrop + AnchorSideTop.Control = DimLabel + Left = 260 + Height = 16 + Top = 30 + Width = 25 + Caption = 'Unit' + ParentColor = False + end end object ReorientSheet: TTabSheet Caption = 'Reorient' - ClientHeight = 336 - ClientWidth = 595 + ClientHeight = 318 + ClientWidth = 589 object Label24: TLabel AnchorSideLeft.Control = Label46 AnchorSideTop.Control = srow_x0Edit @@ -606,18 +642,19 @@ object HdrForm: THdrForm BorderSpacing.Top = 6 Constraints.MinWidth = 260 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'None' 'Scanner Position' 'Coregistrationon' - 'Normalized Tal' - 'Normalized mni152ach' + 'Normalized Talairach' 'Normalized mni152' + 'Normalized other' ) OnSelect = HeaderMagicDropSelect Style = csDropDownList TabOrder = 19 - Text = '0' + Text = 'None' end object SFormDrop: TComboBox AnchorSideLeft.Control = Label47 @@ -632,18 +669,19 @@ object HdrForm: THdrForm BorderSpacing.Top = 6 Constraints.MinWidth = 260 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'None' 'Scanner Position' 'Coregistrationon' - 'Normalized Tal' - 'Normalized mni152ach' + 'Normalized Talairach' 'Normalized mni152' + 'Normalized other' ) OnSelect = HeaderMagicDropSelect Style = csDropDownList TabOrder = 20 - Text = '0' + Text = 'None' end object srow_x0Edit: TFloatSpinEdit AnchorSideLeft.Control = Label24 @@ -1073,15 +1111,15 @@ object HdrForm: THdrForm end object StatSheet: TTabSheet Caption = 'Statistics' - ClientHeight = 320 - ClientWidth = 581 + ClientHeight = 322 + ClientWidth = 593 object IntentLabel: TLabel AnchorSideLeft.Control = StatSheet AnchorSideTop.Control = IntentCodeDrop AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 11 + Top = 8 Width = 53 BorderSpacing.Left = 6 Caption = 'Intention' @@ -1093,7 +1131,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 12 Height = 16 - Top = 40 + Top = 34 Width = 72 BorderSpacing.Left = 6 Caption = 'Parameter 1' @@ -1105,7 +1143,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 12 Height = 16 - Top = 67 + Top = 61 Width = 74 Caption = 'Parameter 2' ParentColor = False @@ -1116,7 +1154,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 12 Height = 16 - Top = 94 + Top = 88 Width = 74 Caption = 'Parameter 3' ParentColor = False @@ -1124,12 +1162,13 @@ object HdrForm: THdrForm object IntentCodeDrop: TComboBox AnchorSideTop.Control = StatSheet Left = 76 - Height = 26 + Height = 20 Top = 6 Width = 218 BorderSpacing.Top = 6 DropDownCount = 44 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Not statistics' 'Correlation coefficient ' @@ -1165,13 +1204,10 @@ object HdrForm: THdrForm 'Points' 'Triangle (mesh)' 'Quaternion' - '' - '' - '' ) Style = csDropDownList TabOrder = 3 - Text = '0' + Text = 'Not statistics' end object intent_p1Edit: TFloatSpinEdit AnchorSideLeft.Control = Intent1Label @@ -1180,7 +1216,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 90 Height = 21 - Top = 38 + Top = 32 Width = 138 BorderSpacing.Left = 6 BorderSpacing.Top = 6 @@ -1196,7 +1232,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 90 Height = 21 - Top = 65 + Top = 59 Width = 138 BorderSpacing.Top = 6 DecimalPlaces = 5 @@ -1211,7 +1247,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 90 Height = 21 - Top = 92 + Top = 86 Width = 138 BorderSpacing.Top = 6 DecimalPlaces = 5 @@ -1326,6 +1362,7 @@ object HdrForm: THdrForm BorderSpacing.Left = 6 BorderSpacing.Top = 6 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Unknown' 'Sequential Increasing (1 2 3 4)' @@ -1337,7 +1374,7 @@ object HdrForm: THdrForm ) Style = csDropDownList TabOrder = 4 - Text = '0' + Text = 'Unknown' end object FreqDimDrop: TComboBox AnchorSideLeft.Control = FreqLabel @@ -1351,6 +1388,7 @@ object HdrForm: THdrForm BorderSpacing.Left = 6 BorderSpacing.Top = 6 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Unknown' 'I' @@ -1359,7 +1397,7 @@ object HdrForm: THdrForm ) Style = csDropDownList TabOrder = 5 - Text = '0' + Text = 'Unknown' end object PhaseDimDrop: TComboBox AnchorSideLeft.Control = FreqDimDrop @@ -1371,6 +1409,7 @@ object HdrForm: THdrForm Width = 215 BorderSpacing.Top = 6 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Unknown' 'I' @@ -1379,7 +1418,7 @@ object HdrForm: THdrForm ) Style = csDropDownList TabOrder = 6 - Text = '0' + Text = 'Unknown' end object SliceDimDrop: TComboBox AnchorSideLeft.Control = FreqDimDrop @@ -1391,6 +1430,7 @@ object HdrForm: THdrForm Width = 215 BorderSpacing.Top = 6 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Unknown' 'I' @@ -1399,7 +1439,7 @@ object HdrForm: THdrForm ) Style = csDropDownList TabOrder = 7 - Text = '0' + Text = 'Unknown' end object slice_startEdit: TSpinEdit AnchorSideLeft.Control = toffsetEdit @@ -1459,15 +1499,15 @@ object HdrForm: THdrForm end object OptionalSheet: TTabSheet Caption = 'Optional' - ClientHeight = 346 - ClientWidth = 587 + ClientHeight = 318 + ClientWidth = 589 object DataLabel: TLabel AnchorSideLeft.Control = IntentStrLabel AnchorSideTop.Control = data_typeEdit AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 35 + Top = 29 Width = 61 Caption = 'Data Type' ParentColor = False @@ -1478,7 +1518,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 8 + Top = 6 Width = 53 BorderSpacing.Left = 6 Caption = 'Intention' @@ -1490,7 +1530,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 224 + Top = 190 Width = 45 Caption = 'Extents' ParentColor = False @@ -1501,7 +1541,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 197 + Top = 167 Width = 81 Caption = 'Session Error' ParentColor = False @@ -1512,7 +1552,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 251 + Top = 213 Width = 80 Caption = 'Regular [114]' ParentColor = False @@ -1523,7 +1563,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 143 + Top = 121 Width = 35 Caption = 'G Min' ParentColor = False @@ -1534,7 +1574,7 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 170 + Top = 144 Width = 38 Caption = 'G Max' ParentColor = False @@ -1545,18 +1585,18 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 116 + Top = 98 Width = 47 Caption = 'Aux File' ParentColor = False end object DBLabel: TLabel AnchorSideLeft.Control = IntentStrLabel - AnchorSideTop.Control = db_ + AnchorSideTop.Control = db_nameEdit AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 89 + Top = 75 Width = 57 Caption = 'DB Name' ParentColor = False @@ -1567,9 +1607,9 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrCenter Left = 6 Height = 16 - Top = 62 - Width = 36 - Caption = 'Notes' + Top = 52 + Width = 69 + Caption = 'Description' ParentColor = False end object intent_nameEdit: TEdit @@ -1578,10 +1618,10 @@ object HdrForm: THdrForm AnchorSideTop.Control = OptionalSheet Left = 93 Height = 21 - Top = 6 + Top = 4 Width = 360 BorderSpacing.Left = 6 - BorderSpacing.Top = 6 + BorderSpacing.Top = 4 MaxLength = 16 TabOrder = 0 Text = 'intent_name' @@ -1592,9 +1632,9 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 93 Height = 21 - Top = 33 + Top = 27 Width = 360 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 MaxLength = 10 TabOrder = 1 Text = 'data_type' @@ -1605,35 +1645,35 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 93 Height = 21 - Top = 60 + Top = 50 Width = 360 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 MaxLength = 80 TabOrder = 2 Text = 'CommentEdit' end - object db_: TEdit + object db_nameEdit: TEdit AnchorSideLeft.Control = intent_nameEdit AnchorSideTop.Control = CommentEdit AnchorSideTop.Side = asrBottom Left = 93 Height = 21 - Top = 87 + Top = 73 Width = 360 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 MaxLength = 18 TabOrder = 3 - Text = 'db_' + Text = 'db_nameEdit' end object aux: TEdit AnchorSideLeft.Control = intent_nameEdit - AnchorSideTop.Control = db_ + AnchorSideTop.Control = db_nameEdit AnchorSideTop.Side = asrBottom Left = 93 Height = 21 - Top = 114 + Top = 96 Width = 360 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 MaxLength = 24 TabOrder = 4 Text = 'aux' @@ -1644,9 +1684,9 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 99 Height = 21 - Top = 168 + Top = 142 Width = 66 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 TabOrder = 6 Value = 1 end @@ -1656,10 +1696,10 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 99 Height = 21 - Top = 141 + Top = 119 Width = 66 BorderSpacing.Left = 6 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 TabOrder = 5 Value = 1 end @@ -1669,9 +1709,9 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 99 Height = 21 - Top = 195 + Top = 165 Width = 66 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 TabOrder = 7 Value = 1 end @@ -1681,9 +1721,9 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 99 Height = 21 - Top = 222 + Top = 188 Width = 66 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 TabOrder = 8 Value = 1 end @@ -1693,9 +1733,9 @@ object HdrForm: THdrForm AnchorSideTop.Side = asrBottom Left = 99 Height = 21 - Top = 249 + Top = 211 Width = 66 - BorderSpacing.Top = 6 + BorderSpacing.Top = 2 MaxValue = 255 TabOrder = 9 Value = 1 @@ -1703,10 +1743,10 @@ object HdrForm: THdrForm end end object StatusBar1: TStatusBar - Left = 0 + Left = 2 Height = 22 - Top = 384 - Width = 601 + Top = 329 + Width = 600 AutoSize = False Panels = < item @@ -1718,8 +1758,8 @@ object HdrForm: THdrForm SimplePanel = False end object HdrMenu: TMainMenu - left = 472 - top = 280 + left = 416 + top = 56 object File1: TMenuItem Caption = '&File' object Save1: TMenuItem @@ -1776,13 +1816,7 @@ object HdrForm: THdrForm OnClose = SaveHdrDlgClose Title = 'Save NIfTI header' Filter = 'NIfTI embedded header (*.nii)|*.nii|NIfTI separate header (*.hdr)|*.hdr' - left = 544 - top = 272 - end - object OpenHdrDlg: TOpenDialog - FilterIndex = 0 - Options = [ofFileMustExist] - left = 456 - top = 72 + left = 416 + top = 112 end end diff --git a/nifti_hdr_view.pas b/nifti_hdr_view.pas index e490fd7..bc7c3eb 100755 --- a/nifti_hdr_view.pas +++ b/nifti_hdr_view.pas @@ -2,16 +2,22 @@ interface {$H+} {$MODE DELPHI} +{$DEFINE MRIcron} + uses LResources, Spin, - {$IFNDEF Unix} ShellAPI, {$ENDIF} - SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, Menus, ComCtrls, Buttons, nifti_hdr, define_types, nifti_types; +{$IFNDEF MRIcron} SimdUtils, {$ENDIF} +{$IFNDEF Unix} ShellAPI, {$ENDIF} + SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math, + + StdCtrls, Menus, ComCtrls, Buttons, nifti_types; type { THdrForm } THdrForm = class(TForm) - OpenHdrDlg: TOpenDialog; + UnitLabel: TLabel; + SpacingLabel: TLabel; + LengthLabel: TLabel; Ymm: TFloatSpinEdit; HdrMenu: TMainMenu; File1: TMenuItem; @@ -24,7 +30,7 @@ THdrForm = class(TForm) intent_nameEdit: TEdit; data_typeEdit: TEdit; CommentEdit: TEdit; - db_: TEdit; + db_nameEdit: TEdit; aux: TEdit; gmax: TSpinEdit; gmin: TSpinEdit; @@ -43,7 +49,7 @@ THdrForm = class(TForm) NotesLabel: TLabel; HeaderMagicDrop: TComboBox; Label21: TLabel; - Label1: TLabel; + DimLabel: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; @@ -152,68 +158,30 @@ THdrForm = class(TForm) procedure SaveHdrDlgClose(Sender: TObject); procedure DimensionSheetContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); - procedure WriteHdrForm (var lHdr: TMRIcroHdr); - procedure ReadHdrDimensionsOnly (var lHdr: TMRIcroHdr); //reads only size dimensions: useful for computing estimated filesize - procedure ReadHdrForm (var lHdr: TMRIcroHdr); //reads entire header + procedure WriteHdrForm (lHdr: TNIFTIhdr; IsNativeEndian: boolean; filename: string); overload; + procedure WriteHdrForm (lHdr: TNIFTIhdr; IsNativeEndian: boolean; filename: string; DisplayDims: TVec3i); overload; + procedure ReadHdrDimensionsOnly (var lHdr: TNIFTIhdr); //reads only size dimensions: useful for computing estimated filesize + procedure ReadHdrForm (var lHdr: TNIFTIhdr); //reads entire header procedure Save1Click(Sender: TObject); procedure TabMenuClick(Sender: TObject); procedure Exit1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure HeaderMagicDropSelect(Sender: TObject); - function OpenAndDisplayHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean; + //function OpenAndDisplayHdr (var lFilename: string; var lHdr: TNIFTIhdr): boolean; private { Private declarations } public { Public declarations } end; - function OpenDialogExecute (lFilter,lCaption: string; lAllowMultiSelect: boolean): boolean; - var HdrForm: THdrForm; implementation -uses nifti_img_view, render,nifti_img; - {$R *.lfm} -function OpenDialogExecute (lFilter,lCaption: string; lAllowMultiSelect: boolean): boolean; -begin - HdrForm.OpenHdrDlg.Filter := lFilter; - {$IFDEF Darwin} - HdrForm.OpenHdrDlg.Filter := ''; - {$ENDIF} - HdrForm.OpenHdrDlg.FilterIndex := 1; - HdrForm.OpenHdrDlg.Title := lCaption; - if lAllowMultiSelect then - HdrForm.OpenHdrDlg.Options := [ofAllowMultiSelect,ofFileMustExist]; - result := HdrForm.OpenHdrDlg.Execute; - HdrForm.OpenHdrDlg.Options := [ofFileMustExist]; -end; - -function THdrForm.OpenAndDisplayHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean; -var lFileDir: string; -begin - FreeImgMemory(lHdr); - result := false; - NIFTIhdr_ClearHdr(lHdr); - if not NIFTIhdr_LoadHdr(lFilename, lHdr) then exit; - WriteHdrForm (lHdr); - lFileDir := extractfiledir(lFilename); - if lFileDir <> gTemplateDir then - OpenHdrDlg.InitialDir := lFileDir; - SaveHdrDlg.InitialDir := lFileDir; - SaveHdrDlg.FileName := lFilename; //make this default file to write - if length(lFilename) < 79 then - StatusBar1.Panels[1].text := lFilename - else - StatusBar1.Panels[1].text := extractfilename(lFilename); - StatusBar1.Panels[0].text := 'Img= '+inttostr(ComputeImageDataBytes(lHdr)); - result := true; -end; - function DropItem2DataType(lItemIndex: integer): integer; //returns NIfTI datatype number begin case lItemIndex of @@ -312,16 +280,22 @@ function DropItem2time_units (lDropItemIndex: byte): integer; //convert ComboBox end; //case end; //func DropItem2time_units +procedure THdrForm.WriteHdrForm (lHdr: TNIFTIhdr; IsNativeEndian: boolean; filename: string; DisplayDims: TVec3i); overload; //writes a header to the various controls +begin + WriteHdrForm (lHdr, IsNativeEndian, filename); + if (DisplayDims.X <> lHdr.dim[1]) or (DisplayDims.Y <> lHdr.dim[2]) or (DisplayDims.Z <> lHdr.dim[3]) then + StatusBar1.Panels[0].text := format('Resliced: %dx%dx%d', [DisplayDims.X,DisplayDims.Y,DisplayDims.Z]) ; + +end; -procedure THdrForm.WriteHdrForm (var lHdr: TMRIcroHdr); //writes a header to the various controls +procedure THdrForm.WriteHdrForm (lHdr: TNIFTIhdr; IsNativeEndian: boolean; filename: string); overload;//writes a header to the various controls var //lCStr: string[80]; lInc: Integer; - s: string; begin - //showmessage(format('%g %g %g', [lHdr.NIFTIhdr.qoffset_x, lHdr.NIFTIhdr.qoffset_y, lHdr.NIFTIhdr.qoffset_z])); - - with lHdr.NIFTIhdr do begin - //numDimEdit.value := dim[0]; + StatusBar1.Panels[0].text := ''; + //caption := 'xx'+inttostr(lHdr.intent_code); + StatusBar1.Panels[1].text := filename; + with lHdr do begin XDim.Value := dim[1]; YDim.Value := dim[2]; ZDim.Value := dim[3]; @@ -339,47 +313,26 @@ procedure THdrForm.WriteHdrForm (var lHdr: TMRIcroHdr); //writes a header to the OffsetEdit.value := round(vox_offset); Scale.value := scl_slope; Intercept.value := scl_inter; - {$IFNDEF FPC} - fTypeDrop.SetItemIndex( DataType2DropItem( datatype)); - if lHdr.NativeEndian then - Endian.SetItemIndex(0) - else - Endian.SetItemIndex(1); - //caption := inttohex(Magic); - if Magic = kNIFTI_MAGIC_EMBEDDED_HDR then - HeaderMagicDrop.SetItemIndex(2) - else if Magic = kNIFTI_MAGIC_SEPARATE_HDR then - HeaderMagicDrop.SetItemIndex(1) - else if Magic = kswapNIFTI_MAGIC_EMBEDDED_HDR then - HeaderMagicDrop.SetItemIndex(2) - else if Magic = kswapNIFTI_MAGIC_SEPARATE_HDR then - HeaderMagicDrop.SetItemIndex(1) - else - HeaderMagicDrop.SetItemIndex(0); - xyzt_sizeDrop.SetItemIndex(xyzt_units and 3); - xyzt_timeDrop.SetItemIndex(time_units2DropItem(xyzt_units)); - {$ELSE} fTypeDrop.ItemIndex := ( DataType2DropItem( datatype)); - if lHdr.DiskDataNativeEndian then - Endian.ItemIndex:=(0) + if IsNativeEndian then + Endian.ItemIndex := 0 + else + Endian.ItemIndex:= 1; + if (Magic = kNIFTI_MAGIC_SEPARATE_HDR) or (Magic = kswapNIFTI_MAGIC_SEPARATE_HDR) then + HeaderMagicDrop.ItemIndex := 1 + else if (Magic = kNIFTI_MAGIC_EMBEDDED_HDR) or (Magic = kswapNIFTI_MAGIC_EMBEDDED_HDR) then + HeaderMagicDrop.ItemIndex := 2 + else if (Magic = kNIFTI2_MAGIC_SEPARATE_HDR) then + HeaderMagicDrop.ItemIndex := 3 + else if (Magic = kNIFTI2_MAGIC_EMBEDDED_HDR) then + HeaderMagicDrop.ItemIndex := 4 else - Endian.ItemIndex:=(1); - if Magic = kNIFTI_MAGIC_EMBEDDED_HDR then - HeaderMagicDrop.ItemIndex:=(2) - else if Magic = kNIFTI_MAGIC_SEPARATE_HDR then - HeaderMagicDrop.ItemIndex:=(1) - else if Magic = kswapNIFTI_MAGIC_EMBEDDED_HDR then - HeaderMagicDrop.ItemIndex:=(2) - else if Magic = kswapNIFTI_MAGIC_SEPARATE_HDR then - HeaderMagicDrop.ItemIndex:=(1) - else - HeaderMagicDrop.ItemIndex:=(0); + HeaderMagicDrop.ItemIndex:=(0); xyzt_sizeDrop.ItemIndex:=(xyzt_units and 3); xyzt_timeDrop.ItemIndex:=(time_units2DropItem(xyzt_units)); - {$ENDIF} CommentEdit.text := descrip; data_typeEdit.text := data_type; - db_.text := db_name; + db_nameEdit.text := db_name; aux.text := aux_file; intent_nameEdit.text := intent_name; ext.value := extents; @@ -426,7 +379,8 @@ procedure THdrForm.WriteHdrForm (var lHdr: TMRIcroHdr); //writes a header to the QFormDrop.ItemIndex:= (qform_code); SFormDrop.ItemIndex :=(sform_code); {$ENDIF} - //showmessage(format('%g %g %g', [lHdr.NIFTIhdr.qoffset_x, lHdr.NIFTIhdr.qoffset_y, lHdr.NIFTIhdr.qoffset_z])); + //caption := format('%d %d', [qform_code, sform_code]); + //showmessage(format('%g %g %g', [lHdr.qoffset_x, lHdr.qoffset_y, lHdr.qoffset_z])); //showmessage(format('%g %g %g', [qoffset_x, qoffset_y, qoffset_z])); quatern_bEdit.value := quatern_b; @@ -462,32 +416,6 @@ procedure THdrForm.WriteHdrForm (var lHdr: TMRIcroHdr); //writes a header to the end; //with lHdr end; -(*procedure ApplySaveDlgFilter (lSaveDlg: TSaveDialog); -var - lLen,lPos,lPipes,lPipesReq: integer; - lExt: string; -begin - lPipesReq := (lSaveDlg.FilterIndex * 2)-1; - if lPipesReq < 1 then exit; - lLen := length(lSaveDlg.Filter); - lPos := 1; - lPipes := 0; - while (lPos < lLen) and (lPipes < lPipesReq) do begin - if lSaveDlg.Filter[lPos] = '|' then - inc(lPipes); - inc(lPos); - end; - if (lPos >= lLen) or (lPipes < lPipesReq) then - exit; - lExt := ''; - while (lPos <= lLen) and (lSaveDlg.Filter[lPos] <> '|') do begin - if lSaveDlg.Filter[lPos] <> '*' then - lExt := lExt + lSaveDlg.Filter[lPos]; - inc(lPos); - end; - if lExt <> '' then - lSaveDlg.Filename := ChangeFileExt(lSaveDlg.Filename,lExt); -end; *) procedure THdrForm.SaveHdrDlgClose(Sender: TObject); begin @@ -505,6 +433,11 @@ procedure THdrForm.DimensionSheetContextPopup(Sender: TObject; MousePos: TPoint; procedure THdrForm.FormShow(Sender: TObject); begin // ImgForm.OnLaunch; + {$IFDEF Darwin} + //HdrForm.BorderStyle:= bsSingle; + //HdrForm.BorderStyle:= bsDialog; + HdrForm.Constraints.MinHeight := 340; + {$ENDIF} end; procedure THdrForm.PageControl1Change(Sender: TObject); @@ -517,11 +450,11 @@ procedure THdrForm.FormHide(Sender: TObject); {$IFDEF Darwin}Application.MainForm.SetFocus;{$ENDIF} end; -procedure THdrForm.ReadHdrDimensionsOnly (var lHdr: TMRIcroHdr); //reads only size dimensions: useful for computing estimated filesize +procedure THdrForm.ReadHdrDimensionsOnly (var lHdr: TNIFTIhdr); //reads only size dimensions: useful for computing estimated filesize var lInc: Integer; begin - with lHdr.NIFTIhdr do begin + with lHdr do begin dim[1] := round(XDim.Value); dim[2] := round(YDim.Value); dim[3] := round(ZDim.Value); @@ -541,14 +474,33 @@ procedure THdrForm.ReadHdrDimensionsOnly (var lHdr: TMRIcroHdr); //reads only si end; //with NIfTIhdr end; //proc ReadHdrDimensionsOnly -procedure THdrForm.ReadHdrForm (var lHdr: TMRIcroHdr); //read the values the user has entered +type + kStr255 = string[255]; + +function getStr(inStr: string; len: integer): kStr255; var - lInc: Integer; + i, n: integer; +begin + result := ''; + for i := 1 to len do + result[i] := chr(0); + //showmessage(format('%d %d', [len, length(inStr)])); + n := min(len, length(inStr)); + if n < 1 then exit; + for i := 1 to n do + result[i] := inStr[i]; +end; + +procedure THdrForm.ReadHdrForm (var lHdr: TNIFTIhdr); //read the values the user has entered +var + i: Integer; + str: kStr255; begin - NIFTIhdr_ClearHdr(lHdr); //important: reset values like first 4 bytes = 348 + NII_Clear(lHdr); //important: reset values like first 4 bytes = 348 ReadHdrDimensionsOnly(lHdr); + //StatusBar1.Panels[0].text := 'ImageData (bytes)= '+inttostr(ComputeImageDataBytes(lHdr)); - with lHdr.NIFTIhdr do begin + with lHdr do begin pixdim[1] := Xmm.Value; pixdim[2] := Ymm.Value; pixdim[3] := Zmm.Value; @@ -564,37 +516,33 @@ procedure THdrForm.ReadHdrForm (var lHdr: TMRIcroHdr); //read the values the use Magic := kNIFTI_MAGIC_SEPARATE_HDR else Magic := 0; //not saed as NIFTI - for lInc := 1 to 80 do - descrip[lInc] := chr(0); - for lInc := 1 to length(CommentEdit.text) do - descrip[lInc] := CommentEdit.text[lInc]; - for lInc := 1 to 10 do - data_type[lInc] := chr(0); - for lInc := 1 to length(data_typeEdit.text) do - data_type[lInc] := data_typeEdit.text[lInc]; - for lInc := 1 to 18 do - db_name[lInc] := chr(0); - for lInc := 1 to length(db_.text) do - db_name[lInc] := db_.text[lInc]; - for lInc := 1 to 24 do - aux_file[lInc] := chr(0); - for lInc := 1 to length(aux.text) do - aux_file[lInc] := aux.text[lInc]; - for lInc := 1 to 16 do - intent_name[lInc] := chr(0); - for lInc := 1 to length(intent_nameEdit.text) do - intent_name[lInc] := intent_nameEdit.text[lInc]; + str := getStr(CommentEdit.text, 80); + for i := 1 to 80 do + descrip[i] := str[i]; + str := getStr(data_typeEdit.text, 10); + for i := 1 to 10 do + data_type[i] := str[i]; + str := getStr(db_nameEdit.text, 18); + for i := 1 to 18 do + db_name[i] := str[i]; + str := getStr(aux.text, 24); + for i := 1 to 24 do + aux_file[i] := str[i]; + str := getStr(intent_nameEdit.text, 16); + for i := 1 to 16 do + intent_name[i] := str[i]; + xyzt_units := xyzt_sizeDrop.ItemIndex; xyzt_units := xyzt_units+ (DropItem2time_units(xyzt_timeDrop.ItemIndex)); - lInc := IntentCodeDrop.ItemIndex; - if (lInc > 0) and (lInc < kNIFTI_LAST_STATCODE) then - lInc := lInc + 1 //intent_codes start from 2 not 1 - else if (lInc >= kNIFTI_LAST_STATCODE) then //add gap in numbers between last stat code and misc codes - lInc := (lInc - kNIFTI_LAST_STATCODE)+kNIFTI_FIRST_NONSTATCODE - else - lInc := 0; //unknown - intent_code := lInc; - intent_p1 := intent_p1Edit.value; + i := IntentCodeDrop.ItemIndex; + if (i > 0) and (i < kNIFTI_LAST_STATCODE) then + i := i + 1 //intent_codes start from 2 not 1 + else if (i >= kNIFTI_LAST_STATCODE) then //add gap in numbers between last stat code and misc codes + i := (i - kNIFTI_LAST_STATCODE)+kNIFTI_FIRST_NONSTATCODE + else + i := 0; //unknown + intent_code := i; + intent_p1 := intent_p1Edit.value; intent_p2 := intent_p2Edit.value; intent_p3 := intent_p3Edit.value; extents:= round(ext.value); @@ -636,12 +584,71 @@ procedure THdrForm.ReadHdrForm (var lHdr: TMRIcroHdr); //read the values the use //zero_intercept := intercept.value; end; -procedure THdrForm.Save1Click(Sender: TObject); +function NIFTIhdr_SaveHdr(var lFilename: string; var lHdr: TNIFTIhdr; lAllowOverwrite, lIsNativeEndian: boolean): boolean; var - lHdr: TMRIcroHdr; - lFilename,lExt: string; + lExt: string; + lOutHdr: TNIFTIhdr; + lF: File; + lOverwrite: boolean; +begin + lOverwrite := false; //will we overwrite existing file? + lExt := upcase(ExtractFileExt(lFilename)); + if (lExt = '.NII') then lHdr.magic := kNIFTI_MAGIC_EMBEDDED_HDR; + if (lExt = '.HDR') then lHdr.magic := kNIFTI_MAGIC_SEPARATE_HDR; + result := false; //assume failure + if lHdr.magic = kNIFTI_MAGIC_EMBEDDED_HDR then begin + + if (lExt = '.GZ') or (lExt = '.NII.GZ') then begin + showmessage('Unable to save .nii.gz headers (first ungzip your image if you wish to edit the header)'); + exit; + end; + lFilename := changefileext(lFilename,'.nii') + end else + lFilename := changefileext(lFilename,'.hdr'); + (*if ((sizeof(TNIFTIhdr))> DiskFree(lFileName)) then begin + ShowMessage('There is not enough free space on the destination disk to save the header. '+kCR+ + lFileName+ kCR+' Bytes Required: '+inttostr(sizeof(TNIFTIhdr)) ); + exit; + end;*) + (*if Fileexists(lFileName) then begin + if lAllowOverwrite then begin + case MessageDlg('Do you wish to modify the existing file '+lFilename+'?', mtConfirmation,[mbYes, mbNo], 0) of { produce the message dialog box } + 6: lOverwrite := true; //6= mrYes, 7=mrNo... not sure what this is for Linux. Hardcoded as we do not include Form values + end;//case + end else + showmessage('Error: the file '+lFileName+' already exists.'); + if not lOverwrite then Exit; + end;*) + if Fileexists(lFileName) and (not lAllowOverwrite) then begin + showmessage('Error: the file '+lFileName+' already exists.'); + exit; + end; + if Fileexists(lFileName) then + lOverwrite := true; + if lHdr.magic = kNIFTI_MAGIC_EMBEDDED_HDR then + if lHdr.vox_offset < sizeof(TNIFTIHdr) then + lHdr.vox_offset := sizeof(TNIFTIHdr); //embedded images MUST start after header + if lHdr.magic = kNIFTI_MAGIC_SEPARATE_HDR then + lHdr.vox_offset := 0; //embedded images MUST start after header + result := true; + move(lHdr, lOutHdr, sizeof(lOutHdr)); + if lIsNativeEndian = false then + NIFTIhdr_SwapBytes (lOutHdr);{swap to big-endianformat} + Filemode := 1; + AssignFile(lF, lFileName); {WIN} + if lOverwrite then //this allows us to modify just the 348byte header of an existing NII header without touching image data + Reset(lF,sizeof(TNIFTIhdr)) + else + Rewrite(lF,sizeof(TNIFTIhdr)); + BlockWrite(lF,lOutHdr, 1 {, NumWritten}); + CloseFile(lF); + Filemode := 2; +end; //func NIFTIhdr_SaveHdr + +procedure THdrForm.Save1Click(Sender: TObject); +var lHdr: TNIFTIhdr; + lFilename, lExt: string; begin - NIFTIhdr_ClearHdr(lHdr); if (HeaderMagicDrop.ItemIndex >= 3) then begin showmessage('Unable to save NIfTI2 headers'); exit; @@ -652,18 +659,18 @@ procedure THdrForm.Save1Click(Sender: TObject); showmessage('Unable to save .nii.gz headers (first ungzip your image if you wish to edit the header)'); exit; end; - NIFTIhdr_ClearHdr(lHdr); //important: reset values like first 4 bytes = 348 + NII_Clear(lHdr); ReadHdrForm (lHdr); + if (lExt <> '.HDR') and (lExt <> '.NII') then begin - if lHdr.NIFTIhdr.magic = kNIFTI_MAGIC_SEPARATE_HDR then + if lHdr.magic = kNIFTI_MAGIC_SEPARATE_HDR then SaveHdrDlg.Filename := SaveHdrDlg.Filename +'.hdr' else SaveHdrDlg.Filename := SaveHdrDlg.Filename +'.nii'; end; lFilename := SaveHdrDlg.Filename; //999 ImgForm.SaveDialog1.InitialDir := extractfiledir(lFilename); - if not NIFTIhdr_SaveHdr (lFilename, lHdr,true) then exit; - OpenHdrDlg.FileName := lFilename; //make this default file to open + if not NIFTIhdr_SaveHdr (lFilename, lHdr, true, HdrForm.Endian.ItemIndex = 0) then exit; StatusBar1.Panels[1].text := 'wrote: '+lFilename; end; @@ -679,16 +686,13 @@ procedure THdrForm.Exit1Click(Sender: TObject); //Quit the program or form procedure THdrForm.FormCreate(Sender: TObject); -var lHdr: TMRIcroHdr; +var lHdr: TNIFTIhdr; + v: TVec3i; begin - //DecimalSeparator := '.'; //important for reading DICOM data: e.g. Germans write '12,00' but DICOM is '12.00' - {$IFNDEF Unix} DragAcceptFiles(Handle, True); //engage drag and drop - {$ENDIF} - NIFTIhdr_ClearHdr(lHdr); - HdrForm.WriteHdrForm (lHdr); //show default header + NII_Clear(lHdr); + v.x := lHdr.dim[1]; v.y := lHdr.dim[2]; v.z := lHdr.dim[3]; + HdrForm.WriteHdrForm (lHdr, true,'', v); //show default header {$IFDEF Darwin} - {$IFNDEF LCLgtk} //only for Carbon compile - //Open1.ShortCut := ShortCut(Word('O'), [ssMeta]); Save1.ShortCut := ShortCut(Word('S'), [ssMeta]); Exit1.ShortCut := ShortCut(Word('W'), [ssMeta]); Dimensions1.ShortCut := ShortCut(Word('A'), [ssMeta]); @@ -698,7 +702,6 @@ procedure THdrForm.FormCreate(Sender: TObject); FunctionalMRI1.ShortCut := ShortCut(Word('E'), [ssMeta]); Optional1.ShortCut := ShortCut(Word('F'), [ssMeta]); {$ENDIF} - {$ENDIF} end; procedure THdrForm.HeaderMagicDropSelect(Sender: TObject); @@ -723,5 +726,4 @@ procedure THdrForm.HeaderMagicDropSelect(Sender: TObject); end; end; - end. diff --git a/nifti_img_view.lfm b/nifti_img_view.lfm index 7881987..ee7183b 100755 --- a/nifti_img_view.lfm +++ b/nifti_img_view.lfm @@ -2243,4 +2243,8 @@ object ImgForm: TImgForm 1970FDAB7AB9F2F57F6152AAD1 } end + object OpenHdrDlg: TOpenDialog + left = 253 + top = 107 + end end diff --git a/nifti_img_view.pas b/nifti_img_view.pas index 2323833..2e1ffbe 100755 --- a/nifti_img_view.pas +++ b/nifti_img_view.pas @@ -69,6 +69,7 @@ TImgForm = class(TForm) dcm2niiMenu: TMenuItem; CheckUpdatesMenu: TMenuItem; Interpolate1: TMenuItem; +OpenHdrDlg: TOpenDialog; VOImaskCustom: TMenuItem; NewWindow1: TMenuItem; ColorBarBtn: TToolButton; @@ -241,6 +242,7 @@ procedure C(Sender: TObject); procedure CropMenuClick(Sender: TObject); procedure ExportasRGBAnalyzeimage1Click(Sender: TObject); procedure FormDropFiles(Sender: TObject; const FileNames: array of String); +function OpenAndDisplayHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean; //procedure DropFilesOSX(Sender: TObject; const FileNames: array of String); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormKeyPress(Sender: TObject; var Key: char); @@ -374,6 +376,7 @@ procedure UpdateColorSchemes; procedure SaveOrCopyImages(lCopy: boolean); function ImgIntensityString(var lHdr: TMRIcroHdr; lVox: integer): string; overload; function ImgIntensityString(var lHdr: TMRIcroHdr; lX,lY,lZ: integer): string; overload; + function OpenDialogExecute (lFilter,lCaption: string; lAllowMultiSelect: boolean): boolean; {$IFDEF LCLCocoa} procedure SetDarkMode; {$ENDIF} @@ -428,6 +431,21 @@ implementation {$ELSE} {$R *.DFM} {$ENDIF} + +function TImgForm.OpenDialogExecute (lFilter,lCaption: string; lAllowMultiSelect: boolean): boolean; +begin + OpenHdrDlg.Filter := lFilter; + {$IFDEF Darwin} + OpenHdrDlg.Filter := ''; + {$ENDIF} + OpenHdrDlg.FilterIndex := 1; + OpenHdrDlg.Title := lCaption; + if lAllowMultiSelect then + OpenHdrDlg.Options := [ofAllowMultiSelect,ofFileMustExist]; + result := OpenHdrDlg.Execute; + OpenHdrDlg.Options := [ofFileMustExist]; +end; + procedure TImgForm.XBarColor; begin ColorDialog1.Color := gBGImg.XBarClr; @@ -884,14 +902,14 @@ procedure TImgForm.ApplyClusterThreshold1Click(Sender: TObject); begin CloseImagesClick(nil); if not OpenDialogExecute(kImgFilter,'Select NIfTI format images to convert',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + lNumberofFiles:= ImgForm.OpenHdrDlg.Files.Count; lClusterSz := ReadIntForm.GetInt('Minimum cluster size [in voxels]: ', 1,32,9999); lThresh := ReadFloatForm.GetFloat('Include voxels with an intensity above: ', 0,2,9999); ProgressBar1.Min := 0; ProgressBar1.Max :=lNumberofFiles; ProgressBar1.Position := 0; for lC:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lC-1]; + lFilename := ImgForm.OpenHdrDlg.Files[lC-1]; ImgForm.OpenAndDisplayImg(lFilename,True); //lFilename := changefileextX(lFilename,'I'+inttostr(round(lThresh))+'C'+inttostr(lClusterSz)+'.nii.gz'); lFilename := changefileprefix(lFilename,'I'+inttostr(round(lThresh))+'C'+inttostr(lClusterSz)); @@ -899,7 +917,7 @@ procedure TImgForm.ApplyClusterThreshold1Click(Sender: TObject); if ImgVaries(gMRIcroOverlay[kBGOverlayNum]) then SaveAsVOIorNIFTIcore (lFilename, gMRIcroOverlay[kBGOverlayNum].ImgBuffer,gMRIcroOverlay[kBGOverlayNum].ImgBufferItems,gMRIcroOverlay[kBGOverlayNum].ImgBufferBPP,1,gMRIcroOverlay[kBGOverlayNum].NiftiHdr) else - showmessage('No clusters survive filter '+ HdrForm.OpenHdrDlg.Files[lC-1]); + showmessage('No clusters survive filter '+ ImgForm.OpenHdrDlg.Files[lC-1]); ProgressBar1.Position := lC; end; if fileexistsEX(lFilename) then @@ -927,20 +945,71 @@ procedure TImgForm.ExportasRGBAnalyzeimage1Click(Sender: TObject); gBGImg.Mirror := lFlip; end; +function isNifti(fnm: string): boolean; +var + lExt: string; +begin + result := true; + lExt := uppercase(extractfileext(fnm)); + if (lExt = '.NII') or (lExt = '.HDR') or (lExt = '.VOI') then exit; + if (lExt = '.GZ') then begin + lExt := uppercase(extractfileext(changefileext(fnm,''))); + if (lExt = '.NII') then exit; + end; + result := false; +end; + +function isDICOM(fnm: string): boolean; +var + f: file; + sz: integer; + magic: array [0..3] of char; //signature of DICOM = 'DICM' +begin + if (isNifti(fnm)) then + exit(false); + result := true; + if DirectoryExists(fnm) then exit; + AssignFile(f, fnm); + FileMode := fmOpenRead; + Reset(f,1); + sz := FileSize(f); + if sz < 256 then begin + CloseFile(f); + exit(false); + end; + Seek(f, 128); + magic[0] := 'x'; //just to hide compiler warning + blockread(f, magic[0], sizeof(magic)); + //showmessage(magic); //will report DICM for DICOM images, but not DICOM meta objects + if (magic[0] <> 'D') or (magic[1] <> 'I') or (magic[2] <> 'C') or (magic[3] <> 'M') then + result := false; +end; + procedure TImgForm.FormDropFiles(Sender: TObject; const FileNames: array of String); var - lFilename: string; + fnm: string; ss: TShiftState; begin ss:=getKeyshiftstate; if length(FileNames) < 1 then exit; - lFilename := Filenames[0]; + fnm := Filenames[0]; + if isDICOM(fnm) then begin //part-10 compliant DICOM images should have "DICM" signature, but this is missing for some DICOM meta data + //if (not isNifti(Filenames[0])) then begin + //printf('>drop:'+fnm); + fnm := dcm2Nifti(dcm2niiForm.getCurrentDcm2niix, fnm); + //printf('>got:'+fnm); + if fnm = '' then exit; + OpenAndDisplayImg(fnm,true); + if fnm <> Filenames[0] then + deletefile(fnm); + exit; + end; if (ssMeta in ss) or (ssCtrl in ss) then begin - LoadOverlay(lFilename); + LoadOverlay(fnm); exit; end; - OpenAndDisplayImg(lFilename,true); + OpenAndDisplayImg(fnm,true); end; procedure TImgForm.FormKeyDown(Sender: TObject; var Key: Word; @@ -1090,12 +1159,12 @@ procedure TImgForm.NIIVOIClick(Sender: TObject); begin CloseImagesClick(nil); if not OpenDialogExecute(kImgFilter {10/2007},'Select NIfTI format images to convert',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + lNumberofFiles:= ImgForm.OpenHdrDlg.Files.Count; ProgressBar1.Min := 0; ProgressBar1.Max :=lNumberofFiles; ProgressBar1.Position := 0; for lC:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lC-1]; + lFilename := ImgForm.OpenHdrDlg.Files[lC-1]; ImgForm.OpenAndDisplayImg(lFilename,True); lFilename := changefileextx(lFilename,'.voi'); ////Xversion 10/2007 - removes .nii.gz not just gz //SaveAsVOIorNIFTIcore (lFilename, lByteP, lVoxels, 1, gMRIcroOverlay[kBGOverlayNum].NiftiHdr); @@ -1171,6 +1240,28 @@ function RescaleImg( lRescaleIntercept,lRescaleSlope: double): boolean; end; +function TImgForm.OpenAndDisplayHdr (var lFilename: string; var lHdr: TMRIcroHdr): boolean; +var lFileDir: string; +begin + FreeImgMemory(lHdr); + result := false; + NIFTIhdr_ClearHdr(lHdr); + if not NIFTIhdr_LoadHdr(lFilename, lHdr) then exit; + HdrForm.WriteHdrForm(lHdr.NIFTIhdr, lHdr.DiskDataNativeEndian, lFilename); + lFileDir := extractfiledir(lFilename); + if lFileDir <> gTemplateDir then + OpenHdrDlg.InitialDir := lFileDir; + HdrForm.SaveHdrDlg.InitialDir := lFileDir; + HdrForm.SaveHdrDlg.FileName := lFilename; //make this default file to write + if length(lFilename) < 79 then + HdrForm.StatusBar1.Panels[1].text := lFilename + else + HdrForm.StatusBar1.Panels[1].text := extractfilename(lFilename); + HdrForm.StatusBar1.Panels[0].text := 'Img= '+inttostr(ComputeImageDataBytes(lHdr)); + result := true; +end; + + procedure TImgForm.RescaleMenuClick(Sender: TObject); var ldTE,lScale,lTE1,lTE2: double; //lStr: string; @@ -1180,7 +1271,7 @@ procedure TImgForm.RescaleMenuClick(Sender: TObject); exit; end; if gBGImg.Resliced then begin - if not HdrForm.OpenAndDisplayHdr(gMRIcroOverlay[kBGOverlayNum].HdrFileName,gMRIcroOverlay[kBGOverlayNum]) then exit; + if not OpenAndDisplayHdr(gMRIcroOverlay[kBGOverlayNum].HdrFileName,gMRIcroOverlay[kBGOverlayNum]) then exit; if not OpenImg(gBGImg,gMRIcroOverlay[0],true,false,false,false,false) then exit; end; if (gMRIcroOverlay[kBGOverlayNum].GlMinUnscaledS < 0) or (gMRIcroOverlay[kBGOverlayNum].GlMaxUnscaledS > 4096) then begin @@ -1489,7 +1580,7 @@ function TImgForm.OpenAndDisplayImg(var lFilename: string; lAdd2MRU: boolean): b {$ENDIF} if (DirectoryExists(lFilename)) then exit; if (FSize(lFilename)) < 348 then exit; //to small to be a header or DICOM image - if not HdrForm.OpenAndDisplayHdr(lFilename,gMRIcroOverlay[kBGOverlayNum]) then exit; + if not OpenAndDisplayHdr(lFilename,gMRIcroOverlay[kBGOverlayNum]) then exit; //if (ssShift in KeyDataToShiftState(vk_Shift)) then begin @@ -1584,7 +1675,7 @@ procedure TImgForm.DisplayHdrClick(Sender: TObject); setThemeMode(HdrForm, gBGImg.DarkMode); {$ENDIF} HdrForm.SaveHdrDlg.Filename := gMRIcroOverlay[lLayer].HdrFilename; - HdrForm.WriteHdrForm (gMRIcroOverlay[lLayer]); + HdrForm.WriteHdrForm (gMRIcroOverlay[lLayer].NIFTIhdr, gMRIcroOverlay[lLayer].DiskDataNativeEndian, gMRIcroOverlay[lLayer].HdrFilename); //HdrForm.ShowModal; HdrForm.Show; //HdrForm.BringToFront; @@ -1597,7 +1688,7 @@ procedure TImgForm.Open1Click(Sender: TObject); begin CloseImagesClick(nil); if not OpenDialogExecute(kImgFilterPlusAny,'Select background image',false) then exit; - lFilename := HdrForm.OpenHdrDlg.Filename; + lFilename := OpenHdrDlg.Filename; OpenAndDisplayImg(lFilename,True); end; @@ -2684,7 +2775,7 @@ procedure TImgForm.CloseImagesClick(Sender: TObject); procedure TImgForm.OverlayOpenCore (var lFilename: string; lOverlayNum: integer); begin - if not HdrForm.OpenAndDisplayHdr(lFilename,gMRIcroOverlay[lOverlayNum]) then exit; + if not OpenAndDisplayHdr(lFilename,gMRIcroOverlay[lOverlayNum]) then exit; //if not OpenImg(gBGImg,gMRIcroOverlay[lOverlayNum],false,false,false) then exit; //if (ssShift in KeyDataToShiftState(vk_Shift)) then begin // if not OpenImg(gBGImg,gMRIcroOverlay[lOverlayNum],false,false,false,not gBGImg.ResliceOnLoad,false) then exit; @@ -3074,12 +3165,12 @@ procedure TImgForm.BatchROImean1Click(Sender: TObject); FreeImgMemory(gMRIcroOverlay[lInc]); UpdateLayerMenu; if not OpenDialogExecute(kImgFilter,'Select images you wish to analyze',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + lNumberofFiles:= OpenHdrDlg.Files.Count; if lNumberofFiles < 1 then exit; TextForm.MemoT.Lines.Clear; for lInc:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lInc-1]; + lFilename := OpenHdrDlg.Files[lInc-1]; OverlayOpenCore ( lFilename, 2); ShowDescriptive(2,true); //LayerDrop.SetItemIndex(LayerDrop.Items.Count-1); @@ -3118,10 +3209,10 @@ procedure TImgForm.OverlayOpenClick(Sender: TObject); exit; end; if not OpenDialogExecute(kImgFilter,'Select overlay image[s]',true) then exit; - if HdrForm.OpenHdrDlg.Files.Count < 1 then + if OpenHdrDlg.Files.Count < 1 then exit; - for lInc := 1 to HdrForm.OpenHdrDlg.Files.Count do begin //vcx - lFilename := HdrForm.OpenHdrDlg.Files[lInc-1]; + for lInc := 1 to OpenHdrDlg.Files.Count do begin //vcx + lFilename := OpenHdrDlg.Files[lInc-1]; LoadOverlayIncludingRGB(lFilename); {$IFNDEF FPC} LayerDrop.SetItemIndex(LayerDrop.Items.Count-1); @@ -3428,7 +3519,7 @@ procedure TImgForm.OpenVOICore(var lFilename : string); ImgForm.RefreshImagesTimer.Enabled := true; exit; end; - if not HdrForm.OpenAndDisplayHdr(lFilename,gMRIcroOverlay[kVOIOverlayNum]) then exit; + if not OpenAndDisplayHdr(lFilename,gMRIcroOverlay[kVOIOverlayNum]) then exit; isOverlaySmooth := gBGImg.OverlaySmooth; gBGImg.OverlaySmooth := false; if not OpenImg(gBGImg,gMRIcroOverlay[kVOIOverlayNum],false,true,false,gBGImg.ResliceOnLoad,false) then begin @@ -3450,7 +3541,7 @@ procedure TImgForm.OpenVOIClick(Sender: TObject); exit; end; if not OpenDialogExecute(kVOIFilter,'Select Volume of Interest drawing',false) then exit; - lFilename := HdrForm.OpenHdrDlg.Filename; + lFilename := OpenHdrDlg.Filename; OpenVOICore(lFilename); end;//OpenVOIClick @@ -4286,7 +4377,7 @@ procedure TImgForm.CreateOverlap(Sender: TObject); exit; end; if not OpenDialogExecute(kVOIFilter,'Select VOIs you wish to combine',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + lNumberofFiles:= OpenHdrDlg.Files.Count; if lNumberofFiles < 2 then begin Showmessage('Error: This function is designed to overlay MULTIPLE images. You selected less than two images.'); exit; @@ -4297,10 +4388,10 @@ procedure TImgForm.CreateOverlap(Sender: TObject); getmem(lOverlapBuffer,gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems); fillchar(lOverlapBuffer^,gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems,0); for lC:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lC-1]; + lFilename := OpenHdrDlg.Files[lC-1]; lExt := UpCaseExt(lFileName); gBGImg.VOIchanged := false; - if not HdrForm.OpenAndDisplayHdr(lFilename,gMRIcroOverlay[lOverlay]) then exit; + if not OpenAndDisplayHdr(lFilename,gMRIcroOverlay[lOverlay]) then exit; if not OpenImg(gBGImg,gMRIcroOverlay[lOverlay],false,false,false,gBGImg.ResliceOnLoad,false) then exit; ProgressBar1.Position := lC; for lPos := 1 to gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems do @@ -4349,8 +4440,8 @@ procedure TImgForm.Chisquare1Click(Sender: TObject); end else begin if not OpenDialogExecute(kImgFilter,'Select NEGATIVE overlap image',false) then exit; end; - lFilename := HdrForm.OpenHdrDlg.Filename; - if not HdrForm.OpenAndDisplayHdr(lFilename,gMRIcroOverlay[lLoop]) then exit; + lFilename := OpenHdrDlg.Filename; + if not OpenAndDisplayHdr(lFilename,gMRIcroOverlay[lLoop]) then exit; if not OpenImg(gBGImg,gMRIcroOverlay[lLoop],false,false,true,gBGImg.ResliceOnLoad,false) then exit; lTotal[lLoop] := round(gMRIcroOverlay[lLoop].NIFTIhdr.glmax); if (gMRIcroOverlay[lLoop].NIFTIhdr.intent_code <> kNIFTI_INTENT_ESTIMATE) then @@ -4457,19 +4548,19 @@ procedure TImgForm.ROIVOI1Click(Sender: TObject); exit; end; if gBGImg.Resliced then begin - if not HdrForm.OpenAndDisplayHdr(gMRIcroOverlay[kBGOverlayNum].HdrFileName,gMRIcroOverlay[kBGOverlayNum]) then exit; + if not OpenAndDisplayHdr(gMRIcroOverlay[kBGOverlayNum].HdrFileName,gMRIcroOverlay[kBGOverlayNum]) then exit; if not OpenImg(gBGImg,gMRIcroOverlay[0],true,false,false,false,false) then exit; end; showmessage('Warning: the currently open background image must have the dimensions (size, space between slices, etc) as the image used when creating the ROIs.'); if gMRIcroOverlay[kVOIOverlayNum].ScrnBufferItems > 0 then CloseVOIClick(nil); if not OpenDialogExecute('MRIcro ROI (.roi)|*.roi','Select MRIcro format ROIs to convert',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + lNumberofFiles:= OpenHdrDlg.Files.Count; ProgressBar1.Min := 0; ProgressBar1.Max :=lNumberofFiles; ProgressBar1.Position := 0; for lC:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lC-1]; + lFilename := OpenHdrDlg.Files[lC-1]; OpenMRIcroROI (lFileName); lFilename := changefileextX(lFilename,'.voi'); SaveAsVOIorNIFTIcore (lFilename, gMRIcroOverlay[kVOIOverlayNum].ScrnBuffer,gMRIcroOverlay[kVOIOverlayNum].ScrnBufferItems, 1,1,gMRIcroOverlay[kBGOverlayNum].NiftiHdr); @@ -5335,12 +5426,12 @@ procedure TImgForm.VOI2NIIClick(Sender: TObject); begin CloseImagesClick(nil); if not OpenDialogExecute('VOI Drawings (.VOI)|*.VOI','Select VOI format images to convert',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + lNumberofFiles:= OpenHdrDlg.Files.Count; ProgressBar1.Min := 0; ProgressBar1.Max :=lNumberofFiles; ProgressBar1.Position := 0; for lC:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lC-1]; + lFilename := OpenHdrDlg.Files[lC-1]; OpenAndDisplayImg(lFilename,True); lFilename := changefileextx(lFilename,'.nii'); //SaveAsVOIorNIFTIcore (lFilename, lByteP, lVoxels, 1, gMRIcroOverlay[kBGOverlayNum].NiftiHdr); @@ -5502,12 +5593,12 @@ procedure TImgForm.MirrorNII1Click(Sender: TObject); Showmessage('WARNING: This will flip the images in the Left-Right dimension: this has serious consequences'); CloseImagesClick(nil); if not OpenDialogExecute(kImgFilter,'Select NIfTI format images to convert',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + lNumberofFiles:= OpenHdrDlg.Files.Count; ProgressBar1.Min := 0; ProgressBar1.Max :=lNumberofFiles; ProgressBar1.Position := 0; for lC:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lC-1]; + lFilename := OpenHdrDlg.Files[lC-1]; ImgForm.OpenAndDisplayImg(lFilename,True); lFilename := changefileextX(lFilename,'lr.nii.gz'); //zap diff --git a/npm/.DS_Store b/npm/.DS_Store new file mode 100755 index 0000000..95855bb Binary files /dev/null and b/npm/.DS_Store differ diff --git a/npm/npm.ico b/npm/npm.ico old mode 100644 new mode 100755 diff --git a/npm/npm.or b/npm/npm.or old mode 100644 new mode 100755 diff --git a/npm/rng.pas b/npm/rng.pas old mode 100644 new mode 100755 diff --git a/nsappkitext.pas b/nsappkitext.pas old mode 100644 new mode 100755 diff --git a/reslice_fsl.pas b/reslice_fsl.pas index 7700c8e..27104f4 100755 --- a/reslice_fsl.pas +++ b/reslice_fsl.pas @@ -20,16 +20,16 @@ procedure ResliceFSL; lStrings : TStringList; begin ImgForm.CloseImagesClick(nil); - if not OpenDialogExecute(kImgFilter,'Select source image[s]',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select source image[s]',true) then exit; + lNumberofFiles:= ImgForm.OpenHdrDlg.Files.Count; if lNumberofFiles < 1 then exit; lStrings := TStringList.Create; - lStrings.AddStrings(HdrForm.OpenHdrDlg.Files); - if not OpenDialogExecute('FSL (*.mat)|*.mat','Select FSL source-to-target matrix',false) then goto 666; - lSrc2TargetMatName := HdrForm.OpenHdrDlg.Filename; - if not OpenDialogExecute(kImgFilter,'Select target image (source image will be warped to this)',false) then goto 666; - lTargetImgName := HdrForm.OpenHdrDlg.Filename; + lStrings.AddStrings(ImgForm.OpenHdrDlg.Files); + if not ImgForm.OpenDialogExecute('FSL (*.mat)|*.mat','Select FSL source-to-target matrix',false) then goto 666; + lSrc2TargetMatName := ImgForm.OpenHdrDlg.Filename; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select target image (source image will be warped to this)',false) then goto 666; + lTargetImgName := ImgForm.OpenHdrDlg.Filename; TextForm.MemoT.Lines.Clear; for lInc:= 1 to lNumberofFiles do begin diff --git a/statclustertable.pas b/statclustertable.pas index 8ab69ff..4cc2cbf 100755 --- a/statclustertable.pas +++ b/statclustertable.pas @@ -287,11 +287,11 @@ procedure BatchCluster; lMinClusterSz := ReadIntForm.GetInt('Minimum cluster size [in voxels]: ', 1,4,9999); lThresh := ReadFloatForm.GetFloat('Please enter statistical threshold. ', -9999,2.3,9999); lTemplateName := ''; - if OpenDialogExecute(kImgFilter,'Select anatomical template (optional)',false) then begin - lTemplateName := HdrForm.OpenHdrDlg.Filename; + if ImgForm.OpenDialogExecute(kImgFilter,'Select anatomical template (optional)',false) then begin + lTemplateName := ImgForm.OpenHdrDlg.Filename; end; - if not OpenDialogExecute(kImgFilter,'Select statistical maps',true) then exit; - lNumberofFiles:= HdrForm.OpenHdrDlg.Files.Count; + if not ImgForm.OpenDialogExecute(kImgFilter,'Select statistical maps',true) then exit; + lNumberofFiles:= ImgForm.OpenHdrDlg.Files.Count; if lNumberofFiles < 1 then exit; if not fileexists(lTemplateName) then @@ -300,7 +300,7 @@ procedure BatchCluster; lPref := gBGImg.ResliceOnLoad; gBGImg.ResliceOnLoad := false; for lInc:= 1 to lNumberofFiles do begin - lFilename := HdrForm.OpenHdrDlg.Files[lInc-1]; + lFilename := ImgForm.OpenHdrDlg.Files[lInc-1]; ImgForm.OpenAndDisplayImg(lFilename,false); if lTemplateName <> '' then @@ -311,4 +311,4 @@ procedure BatchCluster; TextForm.Show; end; -end. \ No newline at end of file +end.