diff --git a/_lazwin.bat b/_lazwin.bat index c4e479d..72a73ee 100755 --- a/_lazwin.bat +++ b/_lazwin.bat @@ -8,18 +8,18 @@ copy /Y .\common\gui.inc .\common\isgui.inc #cd c:\pas\mricron\niftiview7 # C:\PROGRA~2\BORLAND\DELPHI7\BIN\dcc32 -UC:\pas\d7\rx275d7\Units;C:\PROGRA~2\PngComponents\Source -B mricron.dpr # c:\strip c:\pas\mricron\niftiview7\mricron.exe -c:\lazarus\lazbuild mricron.lpr -c:\lazarus\fpc\3.0.0\bin\x86_64-win64\strip mricron.exe -copy /Y mricron.exe c:\mricron +d:\lazarus\lazbuild mricron.lpr +d:\lazarus\fpc\3.0.4\bin\x86_64-win64\strip mricron.exe +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 c:\pas\wincron.zip c:\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.zip c:\pas\mricron REM copy c:\pas\srccron.zip Y:\mcbi\MCBI\CRNL\sw\mricron\source.zip diff --git a/_lazwin_old.bat b/_lazwin_old.bat deleted file mode 100755 index 58b2532..0000000 --- a/_lazwin_old.bat +++ /dev/null @@ -1,52 +0,0 @@ -del c:\mricron\*.ini - -call _clean.bat -copy /Y .\common\notgui.inc .\common\isgui.inc - -cd .\dcm2nii -c:\lazarus\lazbuild dcm2nii.lpr -c:\lazarus\fpc\3.0.0\bin\x86_64-win64\strip dcm2nii.exe -#C:\PROGRA~2\BORLAND\DELPHI7\BIN\dcc32 -CC -B dcm2nii.dpr -# c:\strip dcm2nii.exe -###copy /Y dcm2nii.exe c:\mricron -cd .. - -call _clean.bat -copy /Y .\common\gui.inc .\common\isgui.inc - -cd .\npm -# C:\PROGRA~2\BORLAND\DELPHI7\BIN\dcc32 -U..\delphionly -B npm.dpr -# c:\strip npm.exe -c:\lazarus\lazbuild npm.lpr -c:\lazarus\fpc\3.0.0\bin\x86_64-win64\strip npm.exe -#####copy /Y npm.exe c:\mricron -cd .. - -cd .\dcm2nii -# C:\PROGRA~2\BORLAND\DELPHI7\BIN\dcc32 -U..\delphionly;C:\pas\d7\rx275d7\Units -B dcm2niigui.dpr -# c:\strip dcm2niigui.exe -c:\lazarus\lazbuild dcm2niigui.lpr -c:\lazarus\fpc\3.0.0\bin\x86_64-win64\strip dcm2niigui.exe -###copy /Y dcm2niigui.exe c:\mricron -cd .. - - - -#cd c:\pas\mricron\niftiview7 -# C:\PROGRA~2\BORLAND\DELPHI7\BIN\dcc32 -UC:\pas\d7\rx275d7\Units;C:\PROGRA~2\PngComponents\Source -B mricron.dpr -# c:\strip c:\pas\mricron\niftiview7\mricron.exe -c:\lazarus\lazbuild mricron.lpr -c:\lazarus\fpc\3.0.0\bin\x86_64-win64\strip mricron.exe -copy /Y mricron.exe c:\mricron - -call _clean.bat - -REM compress MRIcron -c:\Progra~1\7-Zip\7z a -tzip c:\pas\wincron.zip c:\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\srccron.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 1047471..0a6bbd4 100755 --- a/_osx.command +++ b/_osx.command @@ -3,12 +3,14 @@ # to build your own version you typically run # lazbuild -B filename.lpr -#compile dcm2niix -cd ~/dcm2niix/console -g++ -O3 -dead_strip -I. main_console.cpp nii_foreign.cpp nii_dicom.cpp nifti1_io_core.cpp nii_ortho.cpp nii_dicom_batch.cpp jpg_0XC3.cpp ujpeg.cpp -o dcm2niix -I/usr/local/lib -I/usr/local/include/openjpeg-2.1 /usr/local/lib/libopenjp2.a -cp dcm2niix /Users/rorden/Documents/mricron/MRIcron/dcm2niix -cp dcm2niix /Users/rorden/Documents/mricron/MRIcron/MRIcron.app/Contents/Resources/dcm2niix - +: <<'SKIPDCM2NIIX' + #compile dcm2niix + #warning: recent versions of macOS do not include libstdc++ + cd ~/dcm2niix/console + g++ -O3 -dead_strip -I. main_console.cpp nii_foreign.cpp nii_dicom.cpp nifti1_io_core.cpp nii_ortho.cpp nii_dicom_batch.cpp jpg_0XC3.cpp ujpeg.cpp -o dcm2niix -I/usr/local/lib -I/usr/local/include/openjpeg-2.1 /usr/local/lib/libopenjp2.a + cp dcm2niix /Users/rorden/Documents/mricron/MRIcron/dcm2niix + cp dcm2niix /Users/rorden/Documents/mricron/MRIcron/MRIcron.app/Contents/Resources/dcm2niix +SKIPDCM2NIIX cd /Users/rorden/Documents/pas/mricron @@ -29,7 +31,6 @@ chmod 777 ./_xclean.bat /Users/rorden/lazarus/lazbuild ./dcm2nii/dcm2niigui.lpr --cpu=x86_64 --ws=cocoa --compiler="/usr/local/lib/fpc/3.1.1/ppcx64" strip ./dcm2nii/dcm2niigui cp ./dcm2nii/dcm2niigui /Users/rorden/Documents/mricron/MRIcron/dcm2niigui.app/Contents/MacOS/dcm2niigui - SKIPDCM2NII : <<'SKIPNPM' /Users/rorden/lazarus/lazbuild ./npm/npm.lpr --cpu=x86_64 --ws=cocoa --compiler="/usr/local/lib/fpc/3.1.1/ppcx64" @@ -51,7 +52,7 @@ SKIPNPM strip ./mricron -cp ./mricron /Users/rorden/Documents/mricron/MRIcron/mricron.app/Contents/MacOS/mricron +cp ./mricron /Users/rorden/Documents/mricron/MRIcron/MRIcron.app/Contents/MacOS/MRIcron awk '{gsub(/Active="MacOS"/,"Active=\"Default\"");}1' mricron.lps > mricron.tmp && mv mricron.tmp mricron.lps diff --git a/_osx_dcm2niigui.command b/_osx_dcm2niigui_old.command similarity index 100% rename from _osx_dcm2niigui.command rename to _osx_dcm2niigui_old.command diff --git a/_osx_old.command b/_osx_old.command deleted file mode 100755 index 70e1b02..0000000 --- a/_osx_old.command +++ /dev/null @@ -1,57 +0,0 @@ -#!/bin/sh -#This script builds a distribution on Chris Rorden's personal computer. -# to build your own version you typically run -# lazbuild -B filename.lpr - -cd /Users/rorden/Documents/pas/mricron - -chmod 777 ./_xclean.bat -./_xclean.bat -cp ./common/notgui.inc ./common/isgui.inc -#lazbuild ./dcm2nii/dcm2nii.lpr --cpu=x86_64 --compiler="/usr/local/bin/ppcx64" -#Current FPC 3.0.0 can not compile on OSX 10.11 El Capitan, so use 3.1.1 -lazbuild ./dcm2nii.lpr --cpu=x86_64 --ws=cocoa --compiler="/usr/local/lib/fpc/3.1.1/ppcx64" - -cp ./dcm2nii/dcm2nii /Users/rorden/Documents/mricron/dcm2nii64 - -# lazbuild -B ./dcm2nii/dcm2nii.lpr -lazbuild -B dcm2nii.lpr --ws=cocoa --cpu=x86_64 --os=darwin --compiler=/usr/local/bin/ppcx64 -cp ./dcm2nii/dcm2nii /Users/rorden/Documents/mricron/dcm2nii - -./_xclean.bat -cp ./common/gui.inc ./common/isgui.inc - -#compile MRIcron 64 -#lazbuild ./mricron.lpr --cpu=x86_64 --ws=cocoa --compiler="/usr/local/bin/ppcx64" -#Current FPC 3.0.0 can not compile on OSX 10.11 El Capitan, so use 3.1.1 -lazbuild ./mricron.lpr --cpu=x86_64 --ws=cocoa --compiler="/usr/local/lib/fpc/3.1.1/ppcx64" -strip ./mricron -cp ./mricron /Users/rorden/Documents/mricron/mricron64.app/Contents/MacOS/mricron - - -lazbuild ./npm/npm.lpr --cpu=x86_64 --ws=cocoa --compiler="/usr/local/lib/fpc/3.1.1/ppcx64" -strip ./npm/npm -cp ./npm/npm /Users/rorden/Documents/mricron/npm64.app/Contents/MacOS/npm - -# lazbuild -B ./mricron.lpr --ws=carbon -lazbuild -B ./npm/npm.lpr --ws=carbon -lazbuild -B ./dcm2nii/dcm2niigui.lpr --ws=carbon -lazbuild -B ./mricron.lpr --ws=carbon -#lazbuild -B ./dcm2nii/dcm2niigui.lpr --ws=cocoa --cpu=x86_64 --os=darwin --compiler=/usr/local/bin/ppcx64 - -strip ./mricron -strip ./npm/npm -strip ./dcm2nii/dcm2niigui - -cp ./mricron /Users/rorden/Documents/mricron/mricron.app/Contents/MacOS/mricron -cp ./npm/npm /Users/rorden/Documents/mricron/npm.app/Contents/MacOS/npm -cp ./dcm2nii/dcm2niigui /Users/rorden/Documents/mricron/dcm2niigui.app/Contents/MacOS/dcm2niigui - -./_xclean.bat - -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 - diff --git a/btn/pastedpic_08032008_133503.png b/btn/pastedpic_08032008_133503.png deleted file mode 100755 index 380f280..0000000 Binary files a/btn/pastedpic_08032008_133503.png and /dev/null differ diff --git a/common/backup/define_types.pas.bak b/common/backup/define_types.pas.bak new file mode 100755 index 0000000..09167fe --- /dev/null +++ b/common/backup/define_types.pas.bak @@ -0,0 +1,1456 @@ +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 new file mode 100755 index 0000000..81a78ec --- /dev/null +++ b/common/backup/nifti_hdr.pas.bak @@ -0,0 +1,1279 @@ +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 f7fb0e4..2582b1d 100755 --- a/common/define_types.pas +++ b/common/define_types.pas @@ -20,7 +20,7 @@ interface {$IFDEF GUI} forms,userdir, dialogs{$ELSE}dialogsx{$ENDIF}; const //kMRIcronVersDate = '3MAY2016'; - kVers = 'v1.0.20181114'; + kVers = 'v1.0.20190410'; {$IFDEF LCLCocoa} kMRIcronAPI = 'Cocoa'; {$ELSE} @@ -124,6 +124,12 @@ interface 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; diff --git a/common/nifti_hdr.pas b/common/nifti_hdr.pas index 93ebf0a..b4a524c 100755 --- a/common/nifti_hdr.pas +++ b/common/nifti_hdr.pas @@ -232,19 +232,121 @@ procedure ReportMatrix (lStr: string;lM:TMatrix); 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.NIFTIhdr,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); + ReportMatrix('>Matrix appears bogus',lm); end else begin for lRow := 1 to 3 do begin {3/2008} for lCol := 1 to 4 do begin @@ -533,88 +635,7 @@ procedure nifti_mat44_to_quatern( lR :TMatrix; //fx(qb,qc,qd); 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 ): boolean; -var lR :TMatrix; -begin - - result := false; - if (lHdr.qform_code <= kNIFTI_XFORM_UNKNOWN) or (lHdr.qform_code > kNIFTI_XFORM_MNI_152) then - exit; - 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; {procedure ReportMatrix (lM:TMatrix); var lStr: string; diff --git a/dcm2nii.lfm b/dcm2nii.lfm old mode 100755 new mode 100644 index 510d8f8..b82565e --- a/dcm2nii.lfm +++ b/dcm2nii.lfm @@ -1,241 +1,369 @@ object dcm2niiForm: Tdcm2niiForm - Left = 385 - Height = 352 - Top = 165 - Width = 772 + Left = 315 + Height = 525 + Top = 253 + Width = 965 + ActiveControl = SelectFilesBtn AllowDropFiles = True - Caption = 'dcm2niix' - ClientHeight = 352 - ClientWidth = 772 - Constraints.MinHeight = 120 - Constraints.MinWidth = 640 - Menu = MainMenu1 + Caption = 'dcm2niix DICOM to NIfTI conversion' + ClientHeight = 525 + ClientWidth = 965 + Constraints.MinHeight = 440 + Constraints.MinWidth = 600 OnClose = FormClose - OnCreate = FormCreate OnDropFiles = FormDropFiles - OnResize = FormResize OnShow = FormShow Position = poScreenCenter LCLVersion = '2.1.0.0' object Panel1: TPanel Left = 0 - Height = 31 + Height = 507 Top = 0 - Width = 772 - Align = alTop - AutoSize = True - BorderWidth = 2 - ClientHeight = 31 - ClientWidth = 772 - ParentFont = False + Width = 340 + Align = alLeft + ClientHeight = 507 + ClientWidth = 340 + Constraints.MinHeight = 380 TabOrder = 0 - object compressCheck: TCheckBox - AnchorSideLeft.Control = Label2 - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 70 - Height = 18 - Top = 6 - Width = 22 - BorderSpacing.Left = 2 - Checked = True - OnClick = compressCheckClick - ParentFont = False - ParentBidiMode = False - State = cbChecked + object GeneralGroup: TGroupBox + Left = 1 + Height = 215 + Top = 1 + Width = 338 + Align = alTop + AutoSize = True + Caption = 'General' + ClientHeight = 197 + ClientWidth = 330 TabOrder = 0 + object BidsLabel: TLabel + AnchorSideLeft.Control = OutNameLabel + AnchorSideTop.Control = FormatDrop + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 16 + Top = 157 + Width = 126 + BorderSpacing.Top = 4 + Caption = 'Create BIDS Sidecar:' + ParentColor = False + end + object BidsDrop: TComboBox + AnchorSideLeft.Control = OutNameLabel + AnchorSideTop.Control = BidsLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 20 + Top = 177 + Width = 326 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + ItemHeight = 26 + ItemIndex = 1 + Items.Strings = ( + 'None' + 'Yes, Anonymized' + 'Yes, with Personal Identifiers' + ) + OnChange = UpdateCommand + Style = csDropDownList + TabOrder = 3 + Text = 'Yes, Anonymized' + end + object FormatDrop: TComboBox + AnchorSideLeft.Control = OutNameLabel + AnchorSideTop.Control = FormatLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 20 + Top = 133 + Width = 326 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + ItemHeight = 26 + ItemIndex = 1 + Items.Strings = ( + 'Uncompressed NIfTI (.nii)' + 'Compressed NIfTI (.nii.gz)' + 'Uncompressed NRRD (.nrrd)' + 'Compressed NRRD (.nhdr/.raw.gz)' + ) + OnChange = UpdateCommand + Style = csDropDownList + TabOrder = 2 + Text = 'Compressed NIfTI (.nii.gz)' + end + object FormatLabel: TLabel + AnchorSideLeft.Control = OutNameLabel + AnchorSideTop.Control = OutDirDrop + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 16 + Top = 113 + Width = 92 + BorderSpacing.Top = 4 + Caption = 'Output Format:' + ParentColor = False + end + object OutDirDrop: TComboBox + AnchorSideLeft.Control = OutNameLabel + AnchorSideTop.Control = OutDirLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 4 + Height = 20 + Top = 89 + Width = 326 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Top = 4 + BorderSpacing.Right = 5 + ItemHeight = 26 + ItemIndex = 0 + Items.Strings = ( + 'Save NIfTI images to the same folder as DICOM' + 'Select custom folder ...' + '/usr/rorden' + ) + OnChange = OutDirDropChange + Style = csDropDownList + TabOrder = 1 + Text = 'Save NIfTI images to the same folder as DICOM' + end + object OutDirLabel: TLabel + AnchorSideLeft.Control = OutNameLabel + AnchorSideTop.Control = OutNameExampleLabel + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 16 + Top = 69 + Width = 105 + BorderSpacing.Top = 4 + Caption = 'Output Directory:' + ParentColor = False + end + object OutNameExampleLabel: TLabel + AnchorSideLeft.Control = OutNameEdit + AnchorSideTop.Control = OutNameEdit + AnchorSideTop.Side = asrBottom + Left = 12 + Height = 16 + Top = 49 + Width = 132 + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + Caption = 'Example: 4_T1mprage' + ParentColor = False + end + object OutNameEdit: TEdit + AnchorSideLeft.Control = OutNameLabel + AnchorSideTop.Control = OutNameLabel + AnchorSideTop.Side = asrBottom + AnchorSideRight.Side = asrBottom + Left = 8 + 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 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + OnChange = UpdateCommand + ParentShowHint = False + ShowHint = True + TabOrder = 0 + Text = '%f_%p_%t_%s' + end + object OutNameLabel: TLabel + Left = 4 + Height = 16 + Top = 4 + Width = 104 + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + Caption = 'Output Filename:' + ParentColor = False + end end - object outnameLabel: TLabel - AnchorSideLeft.Control = bidsCheck - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 231 - Height = 16 - Top = 7 - Width = 81 - BorderSpacing.Left = 4 - Caption = 'Output Name' - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - end - object outnameEdit: TEdit - AnchorSideLeft.Control = outnameLabel - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 314 - Height = 21 - Hint = 'Name for NIfTI images. Special characters are %f (Folder name) %i (ID) %n (patient Name) %p (Protocol name) %s (Series number) %t (Time)' - Top = 5 - Width = 176 - BorderSpacing.Left = 2 - OnKeyUp = outnameEditKeyUp - ParentFont = False - ParentShowHint = False - ShowHint = True + object AdvancedGroup: TGroupBox + Left = 1 + Height = 128 + Top = 216 + Width = 338 + Align = alTop + AutoSize = True + Caption = 'Advanced' + ClientHeight = 110 + ClientWidth = 330 TabOrder = 1 - Text = 'outnameEdit' + object IgnoreCheck: TCheckBox + Left = 4 + Height = 18 + Hint = 'Do not convert derived, localizer and 2D images.'#10 + Top = 4 + Width = 193 + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + Caption = 'Ignore Derived and 2D Images' + OnChange = UpdateCommand + ParentShowHint = False + ShowHint = True + TabOrder = 0 + end + object LosslessScaleCheck: TCheckBox + AnchorSideLeft.Control = IgnoreCheck + AnchorSideTop.Control = IgnoreCheck + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 18 + Hint = 'Losslessly scale 16-bit integers to use full dynamic range. This can preserve precision for subsequent transforms.'#10 + Top = 26 + Width = 145 + BorderSpacing.Top = 4 + Caption = 'Scale Dynamic Range' + OnChange = UpdateCommand + ParentShowHint = False + ShowHint = True + TabOrder = 1 + end + object MergeCheck: 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 + Top = 48 + Width = 140 + BorderSpacing.Top = 4 + Caption = 'Always Merge Series' + OnChange = UpdateCommand + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end + object PhilipsPreciseCheck: TCheckBox + AnchorSideLeft.Control = IgnoreCheck + AnchorSideTop.Control = MergeCheck + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 18 + Hint = 'Use Philips precise float scaling (not display) scaling.'#10 + Top = 70 + Width = 149 + BorderSpacing.Top = 4 + Caption = 'Precise Philips Scaling' + OnChange = UpdateCommand + ParentShowHint = False + ShowHint = True + TabOrder = 3 + end + object CropCheck: TCheckBox + AnchorSideLeft.Control = IgnoreCheck + AnchorSideTop.Control = PhilipsPreciseCheck + AnchorSideTop.Side = asrBottom + Left = 4 + Height = 18 + Hint = 'Remove excess neck from anatomical (e.g. T1) scans. This can improve spatial registration.' + Top = 92 + Width = 114 + BorderSpacing.Top = 4 + Caption = 'Crop 3D Images' + OnChange = UpdateCommand + ParentShowHint = False + ShowHint = True + TabOrder = 4 + end end - object Label2: TLabel + object UpdateBtn: TButton AnchorSideLeft.Control = Panel1 - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 7 - Height = 16 - Hint = 'Set whether NIfTI images are compressed (.nii.gz) or not (.nii)' - Top = 7 - Width = 61 - BorderSpacing.Left = 4 - Caption = 'Compress' - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - end - object outputFolderLabel: TLabel - AnchorSideLeft.Control = outnameEdit - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 494 - Height = 16 - Top = 7 - Width = 81 - BorderSpacing.Left = 4 - Caption = 'Output folder' - ParentColor = False - ParentFont = False - end - object outputFolderName: TButton - AnchorSideLeft.Control = outputFolderLabel - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 577 + AnchorSideTop.Control = AdvancedGroup + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 5 Height = 25 - Hint = 'NIfTI files will be saved to this folder. Press this button and click Cancel if you want files NIfTI images saved to same folder as DICOM input' - Top = 3 - Width = 180 - BorderSpacing.Left = 2 - Caption = 'input folder' - OnClick = outputFolderNameClick - ParentFont = False - ParentShowHint = False - ShowHint = True + Top = 348 + Width = 330 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 4 + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + Caption = 'Check for Updates' + OnClick = UpdateBtnClick TabOrder = 2 end - object VerboseLabel: TLabel - AnchorSideLeft.Control = compressCheck - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 96 - Height = 16 - Hint = 'Set whether NIfTI images are compressed (.nii.gz) or not (.nii)' - Top = 7 - Width = 50 + object ResetBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = UpdateBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 5 + Height = 25 + Top = 377 + Width = 330 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Left = 4 - Caption = 'Verbose' - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True - end - object verboseCheck: TCheckBox - AnchorSideLeft.Control = VerboseLabel - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 148 - Height = 18 - Top = 6 - Width = 22 - BorderSpacing.Left = 2 - Checked = True - OnClick = compressCheckClick - ParentFont = False - ParentBidiMode = False - State = cbChecked + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + Caption = 'Reset Defaults' + OnClick = ResetBtnClick TabOrder = 3 end - object bidsCheck: TCheckBox - AnchorSideLeft.Control = BIDSLabel - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 205 - Height = 18 - Top = 6 - Width = 22 - BorderSpacing.Left = 2 - OnClick = compressCheckClick - ParentFont = False - ParentBidiMode = False - TabOrder = 4 - end - object BIDSLabel: TLabel - AnchorSideLeft.Control = verboseCheck - AnchorSideLeft.Side = asrBottom - AnchorSideTop.Control = Panel1 - AnchorSideTop.Side = asrCenter - Left = 174 - Height = 16 - Hint = 'Create Brain Imaging Data Structure file' - Top = 7 - Width = 29 + object SelectFilesBtn: TButton + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = ResetBtn + AnchorSideTop.Side = asrBottom + AnchorSideRight.Control = Panel1 + AnchorSideRight.Side = asrBottom + Left = 5 + Height = 20 + Top = 406 + Width = 330 + Anchors = [akTop, akLeft, akRight] + AutoSize = True BorderSpacing.Left = 4 - Caption = 'BIDS' - ParentColor = False - ParentFont = False - ParentShowHint = False - ShowHint = True + BorderSpacing.Top = 4 + BorderSpacing.Right = 4 + Caption = 'Select Files To Convert...' + OnClick = SelectFilesBtnClick + TabOrder = 4 end end - object Memo1: TMemo + object StatusBar1: TStatusBar Left = 0 - Height = 321 - Top = 31 - Width = 772 + Height = 18 + Top = 507 + Width = 965 + Panels = <> + end + object OutputMemo: TMemo + Left = 343 + Height = 501 + Top = 3 + Width = 619 Align = alClient - Lines.Strings = ( ) - ParentFont = False - ScrollBars = ssAutoVertical - TabOrder = 1 + BorderSpacing.Around = 3 + Lines.Strings = ( + 'To convert images, either drag and drop folders or press the ''Select Files'' button' + ) + ReadOnly = True + ScrollBars = ssAutoBoth + TabOrder = 2 + TabStop = False + WordWrap = False end - object MainMenu1: TMainMenu - left = 24 - top = 48 - object FileMenu: TMenuItem - Caption = 'File' - object DicomMenu: TMenuItem - Caption = 'DICOM to NIfTI...' - OnClick = DicomMenuClick - end - object ParRecMenu: TMenuItem - Caption = 'PAR/REC to NIfTI...' - OnClick = ParRecMenuClick - end - object ResetMenu: TMenuItem - Caption = 'Reset defaults' - OnClick = ResetMenuClick - end - end - object EditMenu: TMenuItem - Caption = 'Edit' - object CopyMenu: TMenuItem - Caption = 'Copy' - OnClick = CopyMenuClick - end - end + object OutputDirDialog: TSelectDirectoryDialog + left = 272 + top = 240 end - object OpenDialog1: TOpenDialog - Filter = 'Philips research (*.par)|*.PAR;*.par' - Options = [ofAllowMultiSelect, ofEnableSizing, ofViewDetail] - left = 96 - top = 48 + object InputDirDialog: TSelectDirectoryDialog + left = 272 + top = 296 end end diff --git a/dcm2nii.pas b/dcm2nii.pas old mode 100755 new mode 100644 index 9135d79..bcfa7da --- a/dcm2nii.pas +++ b/dcm2nii.pas @@ -1,588 +1,577 @@ unit dcm2nii; - {$IFDEF FPC} {$mode delphi}{$H+} {$ENDIF} +{$mode objfpc}{$H+} +{$IFDEF Darwin} + {$modeswitch objectivec1} +{$ENDIF} + interface + uses - LazUTF8, LazFileUtils, - {$IFDEF FPC} - FileUtil, Process,LResources, - {$IFDEF UNIX} LCLIntf, {$ENDIF} - {$ELSE} - Windows, FileCtrl, shellAPI, Messages, - {$ENDIF} - {$IFNDEF UNIX} Registry, {$ENDIF} - {$IFDEF Darwin} userdir, {$ENDIF} - // - Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, - StdCtrls, Menus; + {$IFDEF Darwin} CocoaAll, MacOSAll, {$ENDIF} + strutils, Process, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, + lclintf, IniFiles, ComCtrls, Types; type + { Tdcm2niiForm } + Tdcm2niiForm = class(TForm) - compressCheck: TCheckBox; - MainMenu1: TMainMenu; - FileMenu: TMenuItem; - EditMenu: TMenuItem; - CopyMenu: TMenuItem; - DicomMenu: TMenuItem; - ResetMenu: TMenuItem; - ParRecMenu: TMenuItem; - outputFolderName: TButton; - //compressCheck: TCheckBox; - Label2: TLabel; - outputFolderLabel: TLabel; - outnameLabel: TLabel; - Memo1: TMemo; + BidsDrop: TComboBox; + BidsLabel: TLabel; + UpdateBtn: TButton; + CropCheck: TCheckBox; + FormatDrop: TComboBox; + FormatLabel: TLabel; + GeneralGroup: TGroupBox; + AdvancedGroup: TGroupBox; + IgnoreCheck: TCheckBox; + LosslessScaleCheck: TCheckBox; + MergeCheck: TCheckBox; + OutDirDrop: TComboBox; + OutDirLabel: TLabel; + OutNameEdit: TEdit; + OutNameExampleLabel: TLabel; + OutNameLabel: TLabel; + OutputDirDialog: TSelectDirectoryDialog; + InputDirDialog: TSelectDirectoryDialog; + PhilipsPreciseCheck: TCheckBox; + SelectFilesBtn: TButton; + ResetBtn: TButton; + OutputMemo: TMemo; Panel1: TPanel; - OpenDialog1: TOpenDialog; - outnameEdit: TEdit; - VerboseCheck: TCheckBox; - //bidsCheck: TCheckBox; - VerboseLabel: TLabel; - BIDSLabel: TLabel; - bidsCheck: TCheckBox; - //BIDSLabel: TLabel; - //verboseCheck: TCheckBox; - //VerboseLabel: TLabel; - procedure compressCheckClick(Sender: TObject); - procedure DicomMenuClick(Sender: TObject); - procedure FormResize(Sender: TObject); - procedure FormShow(Sender: TObject); - function getOutputFolder: string; - procedure outnameEditKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); - procedure ParRecMenuClick(Sender: TObject); - procedure ProcessFile(infilename: string); + StatusBar1: TStatusBar; procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); - procedure FormCreate(Sender: TObject); + procedure ConvertDicomDir(DirName: string); procedure FormDropFiles(Sender: TObject; const FileNames: array of String); - procedure CopyMenuClick(Sender: TObject); - procedure outputFolderNameClick(Sender: TObject); - procedure ResetMenuClick(Sender: TObject); - procedure RunCmd (lCmd: string; isDemo: boolean; out line1: string); - function getExeName : string; //return path for command line tool - procedure readIni (ForceReset: boolean); //load preferences - procedure writeIni; //save preferences - function FindDicom2niixPath(const Executable: string): string; - // procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; + procedure FormShow(Sender: TObject); + procedure OutDirDropChange(Sender: TObject); + procedure ResetBtnClick(Sender: TObject); + procedure SelectFilesBtnClick(Sender: TObject); + procedure ShowPrefs; + procedure ReadPrefs; + function RunCmd (lCmd: string; isDemo: boolean): string; + procedure UpdateBtnClick(Sender: TObject); + procedure UpdateCommand(Sender: TObject); + function TerminalCommand: string; + function getCustomDcm2niix(): string; + procedure setCustomDcm2niix(fnm: string); + //procedure findCustomDcm2niix(); + procedure UpdateDialog(versionMsg: string); + private - { private declarations } - {$IFNDEF FPC} procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; {$ENDIF} + public - { public declarations } + end; var dcm2niiForm: Tdcm2niiForm; implementation - {$IFDEF FPC} - {$R *.lfm} - {$ELSE} - {$R *.dfm} - {$ENDIF} -// - {$IFDEF CPU64} - const kExeName = 'dcm2niix'; - {$ELSE} - {$IFDEF Linux} - const kExeName = 'dcm2niix32'; - {$ELSE} - const kExeName = 'dcm2niix'; - {$ENDIF} - {$ENDIF} - - var - isAppDoneInitializing : boolean = false; - -{$IFDEF FPC} -function Tdcm2niiForm.FindDicom2niixPath(const Executable: string): string; -//function FindDicom2niixPath(const Executable: string): string; +{$R *.lfm} +const kExeName = 'dcm2niix'; + {$IFDEF Unix} + kDemoInputDir = ' "/home/user/DicomDir"'; + {$ELSE} + kDemoInputDir = ' "c:\DicomDir"'; + {$ENDIF} +Type +TPrefs = record + UseOutDir, Ignore, LosslessScale,Merge,PhilipsPrecise, Crop: boolean; + Bids,Format: integer; + OutDir,OutName: String; +end; var - s: string; + gPrefs: TPrefs; + gCustomDcm2niix : string = ''; + +(*procedure Tdcm2niiForm.findCustomDcm2niix(); +const + kStr = 'Find the dcm2niix executable (latest at https://github.com/rordenlab/dcm2niix/releases).'; +var + openDialog : TOpenDialog; begin - {$IFDEF Darwin} - result := AppDir + kExeName; - if fileexists(result) then exit; - {$ENDIF} - result := FindDefaultExecutablePath(kExeName); - if result = '' then - result := FindDefaultExecutablePath(ExtractFilePath(paramstr(0))+'Resources'+pathdelim+kExeName); - if result = '' then - result := FindDefaultExecutablePath(ExtractFilePath (paramstr(0)) +kExeName); - if result = '' then - result := FindDefaultExecutablePath(kExeName); - {$IFDEF Unix} - if (result = '') and (fileexists('/usr/local/bin/'+kExeName)) then - result := '/usr/local/bin/'+kExeName; - {$ENDIF} - //Env:=GetEnvironmentVariableUTF8('PATH'); - //if result = '' then - // showmessage('mango:'+GetEnvironmentVariableUTF8('HOME')); + if fileexists(gCustomDcm2niix) then + showmessage(kStr + ' Currently using "'+gCustomDcm2niix+'".') + else + showmessage(kStr); + openDialog := TOpenDialog.Create(self); + openDialog.InitialDir := GetCurrentDir; + openDialog.Options := [ofFileMustExist]; + if openDialog.Execute then + gCustomDcm2niix := openDialog.FileName; + openDialog.Free; +end;*) + +{$IFDEF Darwin} +function ResourceDir (): string; +begin + result := NSBundle.mainBundle.resourcePath.UTF8String; end; {$ELSE} -function Tdcm2niiForm.FindDicom2niixPath(const Executable: string): string; +function ResourceDir (): string; begin - result := extractfilepath(paramstr(0))+kExeName+'.exe'; + result := extractfilepath(paramstr(0))+'Resources'; end; {$ENDIF} -function Tdcm2niiForm.getExeName : string; -var - lF: string; +function getDefaultDcm2niix(): string; begin - result := FindDicom2niixPath(kExeName); - if not fileexists(result) then begin - lF := ExtractFilePath (paramstr(0)); - result := lF+kExeName; - if not fileexists(result) then begin - Memo1.Lines.Clear; - memo1.Lines.Add('Error: unable to find executable '+kExeName+' in path'); - memo1.Lines.Add(' Solution: copy '+kExeName+' to '+lF); - result := ''; - end; //not in same folder as GUI - end; //not in path - {$IFNDEF UNIX} //strip .exe for Windows - result := ChangeFileExt(result, ''); - {$ENDIF} -end; //exeName() - -{$IFDEF UNIX} -function iniName : string; -begin - result := GetEnvironmentVariable ('HOME')+PathDelim+'.dcm2nii.ini'; + {$IFDEF UNIX} + result := ResourceDir + pathdelim + kExeName; + {$ELSE} + result := ResourceDir + pathdelim + kExeName+'.exe'; + {$ENDIF} end; -procedure Tdcm2niiForm.writeIni; -var - iniFile : TextFile; - begin - AssignFile(iniFile, iniName); - ReWrite(iniFile); - if (compressCheck.checked) then - WriteLn(iniFile, 'isGZ=1') - else - WriteLn(iniFile, 'isGZ=0'); - if (bidsCheck.checked) then - WriteLn(iniFile, 'isBIDS=1') - else - WriteLn(iniFile, 'isBIDS=0'); - WriteLn(iniFile, 'filename='+outnameEdit.caption); - CloseFile(iniFile); -end; //writeIni +function Tdcm2niiForm.getCustomDcm2niix(): string; +begin + if (gCustomDcm2niix = '') or (not fileexists(gCustomDcm2niix)) then + gCustomDcm2niix := getDefaultDcm2niix(); + result := gCustomDcm2niix; +end; -procedure Tdcm2niiForm.readIni (ForceReset: boolean); -var - fileData, rowData : TStringList; - row, i: integer; - opts_isGz, opts_isBids: boolean; - opts_filename: string; +procedure Tdcm2niiForm.setCustomDcm2niix(fnm: string); begin - opts_isGz := true; - opts_isBids := true; - //opts_outdir := ''; - opts_filename := '%t_%p_%s'; - if FileExists( iniName) and (not (ForceReset )) then begin - fileData := TStringList.Create; - fileData.LoadFromFile(iniName); // Load from Testing.txt file - if (fileData.Count > 0) then begin - rowData := TStringList.Create; - rowData.Delimiter := '='; - for row := 0 to (fileData.Count-1) do begin //for each row of file - rowData.DelimitedText:=fileData[row]; - if ((rowData.Count > 1) and (CompareText(rowData[0] ,'isGZ')= 0)) then - opts_isGz := (CompareText(rowData[1],'1') = 0); - if ((rowData.Count > 1) and (CompareText(rowData[0] ,'isBIDS')= 0)) then - opts_isBids := (CompareText(rowData[1],'1') = 0); - if ((rowData.Count > 1) and (CompareText(rowData[0] ,'filename')= 0)) then begin - opts_filename := ''; - if (rowData.Count > 2) then - for i := 1 to (rowData.Count-2) do - opts_filename := opts_filename+ rowData[i]+' '; - opts_filename := opts_filename+ rowData[rowData.Count-1]; - end; - end; - rowData.Free; - end; - fileData.Free; - end else - memo1.Lines.Add('Using default settings'); - compressCheck.Checked := opts_isGz; - bidsCheck.Checked := opts_isBids; - outnameEdit.Caption := opts_filename; - //getExeName; -end; //readIni() -{$ELSE} -//For Windows we save preferences in the registry to ensure user has write access -procedure Tdcm2niiForm.writeIni; -var - ARegistry: TRegistry; + gCustomDcm2niix := fnm; +end; + +function SetDefaultPrefs(): TPrefs; begin - ARegistry := TRegistry.Create; - ARegistry.RootKey := HKEY_CURRENT_USER;//HKEY_LOCAL_MACHINE; - if ARegistry.OpenKey ('\Software\dcm2nii',true) then begin - ARegistry.WriteBool('isGZ', compressCheck.Checked ); - ARegistry.WriteBool('isBIDS', bidsCheck.Checked ); - ARegistry.WriteString('filename', outnameEdit.text ); + with result do begin + Ignore := false; + LosslessScale := false; + Merge := false; + PhilipsPrecise := true; + Crop := false; + UseOutDir := false; + Bids := 1; + Format := 1; + OutDir := GetUserDir; + OutName := '%f_%p_%t_%s'; end; - ARegistry.Free; -end; //writeIni() +end; -procedure Tdcm2niiForm.readIni (ForceReset: boolean); -var - ARegistry: TRegistry; - opts_isGz, opts_isBids: boolean; - opts_filename: string; +procedure Tdcm2niiForm.ShowPrefs; begin - opts_isBids := true; - opts_isGz := true; - opts_filename := '%t_%p_%s'; - if not ForceReset then begin - ARegistry := TRegistry.Create; - ARegistry.RootKey := HKEY_CURRENT_USER;//HKEY_LOCAL_MACHINE; - if ARegistry.OpenKey ('\Software\dcm2nii',true) then begin - if ARegistry.ValueExists( 'isGZ' ) then - opts_isGz := ARegistry.ReadBool( 'isGZ' ); - if ARegistry.ValueExists( 'isBIDS' ) then - opts_isBids := ARegistry.ReadBool( 'isBIDS' ); - if ARegistry.ValueExists( 'isGZ' ) then - opts_filename := ARegistry.ReadString( 'filename' ); - end; - ARegistry.Free; + with gPrefs do begin + IgnoreCheck.Checked := Ignore; + LosslessScaleCheck.Checked := LosslessScale; + MergeCheck.Checked := Merge; + PhilipsPreciseCheck.Checked := PhilipsPrecise; + CropCheck.Checked := Crop; + if (UseOutDir) then + OutDirDrop.ItemIndex := 2 + else + OutDirDrop.ItemIndex:= 0; + OutDirDrop.Items[2] := OutDir; + FormatDrop.ItemIndex := Format; + OutNameEdit.Text:= OutName; + BidsDrop.ItemIndex := Bids; end; - bidsCheck.Checked := opts_isBids; - compressCheck.Checked := opts_isGz; - outnameEdit.text := opts_filename; - //getExeName; -end; //readIni() -{$ENDIF} +end; -{$IFDEF FPC} -procedure Tdcm2niiForm.RunCmd (lCmd: string; isDemo: boolean; out line1: string); -//http://wiki.freepascal.org/Executing_External_Programs -var - OutputLines: TStringList; - MemStream: TMemoryStream; - OurProcess: TProcess; - NumBytes: LongInt; - BytesRead: LongInt; -const - READ_BYTES = 2048; +procedure Tdcm2niiForm.ReadPrefs; begin - line1 := ''; - if (not isAppDoneInitializing) then exit; - if (getExeName = '') then exit; - Memo1.Lines.Clear; - dcm2niiForm.refresh; Memo1.refresh; Memo1.invalidate; - MemStream := TMemoryStream.Create; - BytesRead := 0; - OurProcess := TProcess.Create(nil); - {$IFDEF UNIX} - OurProcess.Environment.Add(GetEnvironmentVariable('PATH')); - {$ENDIF} - OurProcess.CommandLine := lCmd; - // We cannot use poWaitOnExit here since we don't - // know the size of the output. On Linux the size of the - // output pipe is 2 kB; if the output data is more, we - // need to read the data. This isn't possible since we are - // waiting. So we get a deadlock here if we use poWaitOnExit. - OurProcess.Options := [poUsePipes, poNoConsole]; - OurProcess.Execute; - while True do begin - // make sure we have room - MemStream.SetSize(BytesRead + READ_BYTES); - // try reading it - NumBytes := OurProcess.Output.Read((MemStream.Memory + BytesRead)^, READ_BYTES); - if NumBytes > 0 // All read() calls will block, except the final one. - then begin - Inc(BytesRead, NumBytes); - end else - BREAK // Program has finished execution. - end; - MemStream.SetSize(BytesRead); - OutputLines := TStringList.Create; - OutputLines.LoadFromStream(MemStream); - if OutputLines.Count > 0 then begin - Line1 := OutputLines[0]; - //skip if line is "Compression will be faster with 'pigz'" - if (pos('Compression', Line1) = 1) and (OutputLines.Count > 0) then - Line1 := OutputLines[1]; - end; - Memo1.Lines.AddStrings(OutputLines); - if isDemo then - Memo1.Lines.Add(lCmd+' "MyDicomFolder"') - else - Memo1.Lines.Add(lCmd); - OutputLines.Free; - OurProcess.Free; - MemStream.Free; + with gPrefs do begin + Ignore := IgnoreCheck.Checked; + LosslessScale := LosslessScaleCheck.Checked; + Merge := MergeCheck.Checked; + PhilipsPrecise := PhilipsPreciseCheck.Checked; + Crop := CropCheck.Checked; + UseOutDir := (OutDirDrop.ItemIndex = 2); + OutDir := OutDirDrop.Items[2]; + Format := FormatDrop.ItemIndex; + OutName := OutNameEdit.Text; + Bids := BidsDrop.ItemIndex; + end; end; -{$ELSE} //if FPC else Delphi -procedure Tdcm2niiForm.RunCmd (lCmd: string; isDemo: boolean); -const - ReadBuffer = 2400; - var - Security : TSecurityAttributes; - ReadPipe,WritePipe : THandle; - start : TStartUpInfo; - ProcessInfo : TProcessInformation; - Buffer : Pchar; - BytesRead : DWord; - Apprunning : DWord; - begin - if (not isAppDoneInitializing) then exit; - if (getExeName = '') then exit; - Memo1.Lines.Clear; - With Security do begin - nlength := SizeOf(TSecurityAttributes) ; - binherithandle := true; - lpsecuritydescriptor := nil; - end; - if Createpipe (ReadPipe, WritePipe, - @Security, 0) then begin - Buffer := AllocMem(ReadBuffer + 1) ; - FillChar(Start,Sizeof(Start),#0) ; - start.cb := SizeOf(start) ; - start.hStdOutput := WritePipe; - start.hStdInput := ReadPipe; - start.dwFlags := STARTF_USESTDHANDLES + - STARTF_USESHOWWINDOW; - start.wShowWindow := SW_HIDE; - - if CreateProcess(nil, - PChar(lCmd), - @Security, - @Security, - true, - NORMAL_PRIORITY_CLASS, - nil, - nil, - start, - ProcessInfo) - then - begin - repeat - Apprunning := WaitForSingleObject - (ProcessInfo.hProcess,100) ; - Application.ProcessMessages; - until (Apprunning <> WAIT_TIMEOUT) ; - Repeat - BytesRead := 0; - ReadFile(ReadPipe,Buffer[0], -ReadBuffer,BytesRead,nil) ; - Buffer[BytesRead]:= #0; - OemToAnsi(Buffer,Buffer) ; - Memo1.Text := Memo1.text + String(Buffer) ; -if isDemo then - Memo1.Lines.Add(lCmd+' "MyDicomFolder"') - else - Memo1.Lines.Add(lCmd); - until (BytesRead < ReadBuffer) ; - end; - FreeMem(Buffer) ; - CloseHandle(ProcessInfo.hProcess) ; - CloseHandle(ProcessInfo.hThread) ; - CloseHandle(ReadPipe) ; - CloseHandle(WritePipe) ; - end; - end; -{$ENDIF} -function Tdcm2niiForm.getOutputFolder: string; +function IniName: string; begin - if (outputFolderName.Tag > 0) then - result := outputFolderName.Caption - else - result := ''; -end; //getOutputFolder + result := GetUserDir; + if result = '' then exit; + result := result + '.'+ChangeFileExt(ExtractFileName(ParamStr(0)),'')+'_dcm.ini'; +end; -procedure Tdcm2niiForm.ProcessFile(infilename: string); +procedure IniInt(lRead: boolean; lIniFile: TIniFile; lIdent: string; var lValue: integer); +//read or write an integer value to the initialization file var - cmd, outputFolder, inFolder, line1: string; + lStr: string; begin - inFolder := infilename; - (*if isTGZ(inFolder) then begin - infolder := deTGZ(infolder); - if infolder = '' then exit; //error - end;*) - cmd := '"'+getExeName +'" '; - if bidsCheck.checked then - cmd := cmd + '-b y ' - else - cmd := cmd + '-b n '; - if compressCheck.checked then - cmd := cmd + '-z y ' - else - cmd := cmd + '-z n '; - if verboseCheck.checked then - cmd := cmd + '-v y '; - outputFolder := getOutputFolder; - if length(outputFolder) > 0 then - cmd := cmd + '-o '+outputFolder+' '; - cmd := cmd + '-f "'+outnameEdit.Text+'" '; - if length(inFolder) > 0 then - cmd := cmd +'"'+inFolder+'"'; - //Caption := inttostr(length(inFolder)); - RunCmd(cmd, length(inFolder) = 0, line1); -end; //ProcessFile() - -procedure Tdcm2niiForm.outnameEditKeyUp(Sender: TObject; var Key: Word; - Shift: TShiftState); + if not lRead then begin + lIniFile.WriteString('INT',lIdent,IntToStr(lValue)); + exit; + end; + lStr := lIniFile.ReadString('INT',lIdent, ''); + if length(lStr) > 0 then + lValue := StrToInt(lStr); +end; //IniInt + +function Bool2Char (lBool: boolean): char; +begin + if lBool then + result := '1' + else + result := '0'; +end; + +function Char2Bool (lChar: char): boolean; begin - ProcessFile(''); -end; //outnameEditKeyUp() + if lChar = '1' then + result := true + else + result := false; +end; -procedure Tdcm2niiForm.ParRecMenuClick(Sender: TObject); +procedure IniBool(lRead: boolean; lIniFile: TIniFile; lIdent: string; var lValue: boolean); +//read or write a boolean value to the initialization file var - lI: integer; + lStr: string; begin - if not OpenDialog1.execute then exit; - //ProcessFile(OpenDialog1.filename); - if OpenDialog1.Files.count < 1 then exit; - for lI := 0 to (OpenDialog1.Files.count-1) do - ProcessFile(OpenDialog1.Files[lI]); -end; //ParRecMenuClick() - -{$IFDEF FPC} -function getDirPrompt (lDefault: string): string; + if not lRead then begin + lIniFile.WriteString('BOOL',lIdent,Bool2Char(lValue)); + exit; + end; + lStr := lIniFile.ReadString('BOOL',lIdent, ''); + if length(lStr) > 0 then + lValue := Char2Bool(lStr[1]); +end; //IniBool + +procedure IniStr(lRead: boolean; lIniFile: TIniFile; lIdent: string; var lValue: string); +//read or write a string value to the initialization file begin - result := lDefault; // Set the starting directory - chdir(result); //start search from default dir... - if SelectDirectory(result, [sdAllowCreate,sdPerformCreate,sdPrompt], 0) then - chdir(result) - else - result := ''; -end; //getDirPrompt() -{$ELSE} -function DirExists(Name: string): Boolean; -{$IFDEF WIN32} + if not lRead then begin + lIniFile.WriteString('STR',lIdent,lValue); + exit; + end; + lValue := lIniFile.ReadString('STR',lIdent, ''); +end; //IniStr + +function IniFile(lRead: boolean; var lPrefs: TPrefs): boolean; +//Read or write initialization variables to disk var - Code: Integer; + lFilename: string; + lIniFile: TIniFile; begin - Code := GetFileAttributes(PChar(Name)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); + if (lRead) then + lPrefs := SetDefaultPrefs + else + dcm2niiForm.ReadPrefs; + lFilename := IniName; + if lFilename = '' then exit(true); + if (lRead) and (not Fileexists(lFilename)) then + exit(false); + {$IFDEF UNIX}if (lRead) then writeln('Loading preferences '+lFilename);{$ENDIF} + lIniFile := TIniFile.Create(lFilename); + 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); + IniInt(lRead,lIniFile, 'Bids', lPrefs.Bids); + IniInt(lRead,lIniFile, 'Format', lPrefs.Format); + IniStr(lRead, lIniFile, 'OutDir', lPrefs.OutDir); + IniStr(lRead, lIniFile, 'OutName', lPrefs.OutName ); + lIniFile.Free; + exit(true); end; -{$ELSE} -var - SR: TSearchRec; + +function Tdcm2niiForm.TerminalCommand: string; begin - if Name[Length(Name)] = '\' then Dec(Name[0]); - if (Length(Name) = 2) and (Name[2] = ':') then - Name := Name + '\*.*'; - Result := FindFirst(Name, faDirectory, SR) = 0; - Result := Result and (SR.Attr and faDirectory <> 0); + result := ''; + if OutNameEdit.Text <> '' then + 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 PhilipsPreciseCheck.Checked then + result := result + ' -p y' + else + result := result + ' -p n'; + if CropCheck.Checked then result := result + ' -x y'; + if odd(FormatDrop.ItemIndex) then + result := result + ' -z y' + else + result := result + ' -z n'; + if (FormatDrop.ItemIndex > 1) then + result := result + ' -e y'; + if BidsDrop.ItemIndex = 0 then + result := result + ' -b n'; + if BidsDrop.ItemIndex = 2 then + result := result + ' -ba n'; + if OutDirDrop.ItemIndex > 1 then + result := result + ' -o "'+OutDirDrop.Items[OutDirDrop.ItemIndex]+'"'; end; -{$ENDIF} -function getDirPrompt (lDefault: string): string; +procedure Tdcm2niiForm.UpdateCommand(Sender: TObject); var - opts: TSelectDirOpts; + cmd: string; begin - result := lDefault; // Set the starting directory - if direxists(result) then - chdir(result); //start search from default dir... - if SelectDirectory(result, opts, 0) then - chdir(result) - else - result := ''; -end; //getDirPrompt() -{$ENDIF} -procedure Tdcm2niiForm.DicomMenuClick(Sender: TObject); -var - dir: string; -begin - dir := getDirPrompt(''); - ProcessFile( dir); -end; //DicomMenuClick() + cmd := TerminalCommand(); + StatusBar1.SimpleText:= kExeName+cmd+kDemoInputDir; + OutNameExampleLabel.Caption:= RunCmd(TerminalCommand,true); +end; -procedure Tdcm2niiForm.compressCheckClick(Sender: TObject); +procedure Tdcm2niiForm.ResetBtnClick(Sender: TObject); begin - ProcessFile(''); + gPrefs := SetDefaultPrefs(); + ShowPrefs; + UpdateCommand(Sender); end; -procedure Tdcm2niiForm.FormResize(Sender: TObject); +procedure Tdcm2niiForm.SelectFilesBtnClick(Sender: TObject); begin - outputFolderName.width := dcm2niiForm.Width-outputFolderName.left-2; -end; //FormResize() + if not InputDirDialog.Execute then exit; + ConvertDicomDir(InputDirDialog.Filename); +end; procedure Tdcm2niiForm.FormShow(Sender: TObject); begin - ProcessFile(''); + {$IFNDEF UNIX} + UpdateBtn.Caption := 'Set Executable Path'; + {$ENDIF} + IniFile(true, gPrefs); + ShowPrefs; + UpdateCommand(Sender); + InputDirDialog.InitialDir := GetUserDir; end; -procedure Tdcm2niiForm.FormDropFiles(Sender: TObject; const FileNames: array of String); +procedure Tdcm2niiForm.OutDirDropChange(Sender: TObject); begin - ProcessFile( FileNames[0]); -end; //FormDropFiles() - -{$IFNDEF FPC} -procedure Tdcm2niiForm.WMDropFiles(var Msg: TWMDropFiles); //implement drag and drop -var CFileName: array[0..MAX_PATH] of Char; -begin - try - if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then begin - ProcessFile(CFilename); - Msg.Result := 0; - end; - finally - DragFinish(Msg.Drop); + if OutDirDrop.ItemIndex <> 1 then begin + UpdateCommand(Sender); + exit; end; -end;//Proc WMDropFiles -{$ENDIF} + if not DirectoryExists(gPrefs.OutDir) then + gPrefs.OutDir := GetUserDir; + OutputDirDialog.InitialDir := gPrefs.OutDir; + if OutputDirDialog.Execute then + gPrefs.OutDir := OutputDirDialog.FileName; + OutDirDrop.Items[2] := gPrefs.OutDir; + OutDirDrop.ItemIndex := 2; + UpdateCommand(Sender); +end; -procedure Tdcm2niiForm.CopyMenuClick(Sender: TObject); +procedure Tdcm2niiForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); begin - Memo1.SelectAll; - Memo1.CopyToClipboard; -end; //CopyMenuClick() + IniFile(false, gPrefs); +end; -procedure Tdcm2niiForm.outputFolderNameClick(Sender: TObject); +procedure Tdcm2niiForm.ConvertDicomDir(DirName: string); var - lDir : string; + cmd: string; begin - if (outputFolderName.Tag > 0) then //start search from prior location - lDir := outputFolderName.Caption - else - lDir := ''; - lDir := getDirPrompt(lDir); - outputFolderName.Tag := length(lDir); - if length(lDir) > 0 then - outputFolderName.Caption := lDir - else - outputFolderName.Caption := 'input folder'; -end; //outputFolderNameClick() + cmd := TerminalCommand()+' "'+DirName+'"'; + RunCmd(cmd,false); +end; -procedure Tdcm2niiForm.ResetMenuClick(Sender: TObject); +procedure Tdcm2niiForm.FormDropFiles(Sender: TObject; + const FileNames: array of String); begin - isAppDoneInitializing := false; - readIni(true); - isAppDoneInitializing := true; - ProcessFile(''); + ConvertDicomDir( FileNames[0]); end; -procedure Tdcm2niiForm.FormCreate(Sender: TObject); +function Tdcm2niiForm.RunCmd (lCmd: string; isDemo: boolean): string; +//http://wiki.freepascal.org/Executing_External_Programs +const + kKeyStr = 'Example output filename: '; +var + OutputLines: TStringList; + MemStream: TMemoryStream; + OurProcess: TProcess; + NumBytes: LongInt; + i: integer; + exe: string; +const + READ_BYTES_BIG = 32768; + +begin + result := ''; //EXIT_FAILURE + //if (not isAppDoneInitializing) then exit; + exe := getCustomDcm2niix(); + if not fileexists(exe) then begin + OutputMemo.Lines.Clear; + OutputMemo.Lines.Add('Error: unable to find '+exe); + exit; + end; + OutputMemo.Lines.Clear; + if isDemo then + OutputMemo.Lines.Add(exe+lCmd+kDemoInputDir) + else + OutputMemo.Lines.Add(exe+lCmd); + MemStream := TMemoryStream.Create; + //BytesRead := 0; + OurProcess := TProcess.Create(nil); + {$IFDEF UNIX} + OurProcess.Environment.Add(GetEnvironmentVariable('PATH')); + {$ENDIF} + OurProcess.CommandLine := exe+lCmd; + OurProcess.Options := [poUsePipes, poNoConsole]; + OurProcess.Execute; + OutputLines := TStringList.Create; + MemStream.SetSize(READ_BYTES_BIG); + dcm2niiForm.Refresh; + while True do begin + NumBytes := OurProcess.Output.Read((MemStream.Memory)^, READ_BYTES_BIG); + if NumBytes > 0 then begin + MemStream.SetSize(NumBytes); + OutputLines.LoadFromStream(MemStream); + if (isDemo) and (result = '') and (OutputLines.Count > 0) then begin + for i := 0 to OutputLines.Count - 1 do begin + if PosEx(kKeyStr,OutputLines[i]) > 0 then begin + result := OutputLines[i]; + Delete(result, 1, length(kKeyStr)); + end; + end; + end; + OutputMemo.Lines.AddStrings(OutputLines); + MemStream.SetSize(READ_BYTES_BIG); + MemStream.Position:=0; + dcm2niiForm.Refresh; + Application.ProcessMessages; + Sleep(15); + end else + BREAK; // Program has finished execution. + end; + if isDemo then begin + OutputMemo.Lines.Add(''); + OutputMemo.Lines.Add('Drop files/folders to convert here'); + + end; + dcm2niiForm.Refresh; + OutputLines.Free; + OurProcess.Free; + MemStream.Free; +end; + +procedure Tdcm2niiForm.UpdateDialog(versionMsg: string); +const + kURL = 'https://github.com/rordenlab/dcm2niix/releases'; +var + PrefForm: TForm; + openDialog : TOpenDialog; + UrlBtn,OkBtn,UseDefaultBtn, CustomBtn: TButton; + promptLabel: TLabel; + defaultDcm2niix, currentDcm2niix: string; + isSetCustomPath,isGotoURL, isCurrentAlsoDefault: boolean; begin - readIni(false); - {$IFDEF FPC} - application.ShowButtonGlyphs:= sbgNever; - {$ELSE}//Delphi specific - DragAcceptFiles(dcm2niiForm.Handle, True); - {$ENDIF} - isAppDoneInitializing := true; - //ProcessFile(''); -end; //FormCreate() + PrefForm:=TForm.Create(nil); + //PrefForm.SetBounds(100, 100, 512, 212); + PrefForm.AutoSize := True; + PrefForm.BorderWidth := 8; + PrefForm.Caption:='dcm2niix Settings'; + PrefForm.Position := poScreenCenter; + PrefForm.BorderStyle := bsDialog; + //Possible situations: + // if getDefaultDcm2niix is not set but exists + //label + promptLabel:=TLabel.create(PrefForm); + currentDcm2niix := getCustomDcm2niix(); + defaultDcm2niix := getDefaultDcm2niix(); + 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]) + else + promptLabel.Caption:= 'Unable to find dcm2niix'; + end else + promptLabel.Caption:= versionMsg; + promptLabel.AutoSize := true; + promptLabel.AnchorSide[akTop].Side := asrTop; + promptLabel.AnchorSide[akTop].Control := PrefForm; + promptLabel.BorderSpacing.Top := 6; + promptLabel.AnchorSide[akLeft].Side := asrLeft; + promptLabel.AnchorSide[akLeft].Control := PrefForm; + promptLabel.BorderSpacing.Left := 6; + promptLabel.Parent:=PrefForm; + //UrlBtn Btn + UrlBtn:=TButton.create(PrefForm); + UrlBtn.Caption:='Visit '+kURL; + UrlBtn.AutoSize := true; + UrlBtn.AnchorSide[akTop].Side := asrBottom; + UrlBtn.AnchorSide[akTop].Control := promptLabel; + UrlBtn.BorderSpacing.Top := 6; + UrlBtn.AnchorSide[akLeft].Side := asrLeft; + UrlBtn.AnchorSide[akLeft].Control := PrefForm; + UrlBtn.BorderSpacing.Left := 6; + UrlBtn.Parent:=PrefForm; + UrlBtn.ModalResult:= mrCancel; + //CustomBtn + CustomBtn:=TButton.create(PrefForm); + CustomBtn.Caption:='Select custom dcm2niix path'; + CustomBtn.AutoSize := true; + CustomBtn.AnchorSide[akTop].Side := asrBottom; + CustomBtn.BorderSpacing.Top := 6; + CustomBtn.AnchorSide[akLeft].Side := asrLeft; + CustomBtn.AnchorSide[akLeft].Control := PrefForm; + CustomBtn.BorderSpacing.Left := 6; + CustomBtn.Parent:=PrefForm; + CustomBtn.ModalResult:= mrIgnore; + //UseDefaultBtn + if not isCurrentAlsoDefault then begin + UseDefaultBtn:=TButton.create(PrefForm); + //UseDefaultBtn.Caption:= format('Reset default "%s"', [defaultDcm2niix]); + UseDefaultBtn.Caption:= 'Reset default dcm2niix path'; + UseDefaultBtn.AutoSize := true; + UseDefaultBtn.AnchorSide[akTop].Side := asrBottom; + UseDefaultBtn.AnchorSide[akTop].Control := UrlBtn; + UseDefaultBtn.BorderSpacing.Top := 6; + UseDefaultBtn.AnchorSide[akLeft].Side := asrLeft; + UseDefaultBtn.AnchorSide[akLeft].Control := PrefForm; + UseDefaultBtn.BorderSpacing.Left := 6; + UseDefaultBtn.Parent:=PrefForm; + UseDefaultBtn.ModalResult:= mrAbort; + CustomBtn.AnchorSide[akTop].Control := UseDefaultBtn; + end else + CustomBtn.AnchorSide[akTop].Control := UrlBtn; + //OK button + OkBtn:=TButton.create(PrefForm); + OkBtn.Caption:='OK'; + OkBtn.AutoSize := true; + OkBtn.AnchorSide[akTop].Side := asrBottom; + OkBtn.AnchorSide[akTop].Control := CustomBtn; + OkBtn.BorderSpacing.Top := 6; + OkBtn.AnchorSide[akLeft].Side := asrRight; + OkBtn.AnchorSide[akLeft].Control := UrlBtn; + OkBtn.BorderSpacing.Left := 6; + OkBtn.Parent:=PrefForm; + OkBtn.ModalResult:= mrOK; + //Display form + PrefForm.ActiveControl := OkBtn; + PrefForm.ShowModal; + isGotoURL := (PrefForm.ModalResult = mrCancel); + if (PrefForm.ModalResult = mrAbort) then //isResetDefault + gCustomDcm2niix := defaultDcm2niix; + isSetCustomPath := (PrefForm.ModalResult = mrIgnore); + FreeAndNil(PrefForm); + if (isGotoURL) then + OpenURL(kURL); //uses lclintf + if isSetCustomPath then begin + openDialog := TOpenDialog.Create(self); + openDialog.Title := 'Find dcm2niix executable'; + openDialog.InitialDir := GetCurrentDir; + openDialog.Options := [ofFileMustExist]; + if openDialog.Execute then + gCustomDcm2niix := openDialog.FileName; + openDialog.Free; + end; +end; //GetFloat() -procedure Tdcm2niiForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); +procedure Tdcm2niiForm.UpdateBtnClick(Sender: TObject); begin - writeIni; - {$IFNDEF FPC} - DragAcceptFiles(dcm2niiForm.Handle, False); - {$ENDIF} -end; //FormClose() - -initialization - //{$IFDEF FPC} - // {$I dcm2nii.lrs} - // {$ENDIF} + {$IFDEF UNIX} + RunCmd(' -u', false); + if OutputMemo.Lines.Count > 2 then + UpdateDialog(OutputMemo.Lines[2]) + else + {$ENDIF} + UpdateDialog(''); +end; + end. diff --git a/dcm2nii.svg b/dcm2nii/dcm2nii.svg similarity index 100% rename from dcm2nii.svg rename to dcm2nii/dcm2nii.svg diff --git a/dcm2nii_old/dcm2nii.lfm b/dcm2nii_old/dcm2nii.lfm new file mode 100755 index 0000000..77d304f --- /dev/null +++ b/dcm2nii_old/dcm2nii.lfm @@ -0,0 +1,242 @@ +object dcm2niiForm: Tdcm2niiForm + Left = 385 + Height = 352 + Top = 165 + Width = 772 + AllowDropFiles = True + Caption = 'dcm2niix' + ClientHeight = 352 + ClientWidth = 772 + Constraints.MinHeight = 120 + Constraints.MinWidth = 640 + Menu = MainMenu1 + OnClose = FormClose + OnCreate = FormCreate + OnDropFiles = FormDropFiles + OnResize = FormResize + OnShow = FormShow + Position = poScreenCenter + LCLVersion = '2.1.0.0' + object Panel1: TPanel + Left = 0 + Height = 31 + Top = 0 + Width = 772 + Align = alTop + AutoSize = True + BorderWidth = 2 + ClientHeight = 31 + ClientWidth = 772 + ParentFont = False + TabOrder = 0 + object compressCheck: TCheckBox + AnchorSideLeft.Control = Label2 + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 70 + Height = 18 + Top = 6 + Width = 22 + BorderSpacing.Left = 2 + Checked = True + OnClick = compressCheckClick + ParentFont = False + ParentBidiMode = False + State = cbChecked + TabOrder = 0 + end + object outnameLabel: TLabel + AnchorSideLeft.Control = bidsCheck + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 231 + Height = 16 + Top = 7 + Width = 81 + BorderSpacing.Left = 4 + Caption = 'Output Name' + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object outnameEdit: TEdit + AnchorSideLeft.Control = outnameLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 314 + Height = 21 + Hint = 'Name for NIfTI images. Special characters are %f (Folder name) %i (ID) %n (patient Name) %p (Protocol name) %s (Series number) %t (Time)' + Top = 5 + Width = 176 + BorderSpacing.Left = 2 + OnKeyUp = outnameEditKeyUp + ParentFont = False + ParentShowHint = False + ShowHint = True + TabOrder = 1 + Text = 'outnameEdit' + end + object Label2: TLabel + AnchorSideLeft.Control = Panel1 + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 7 + Height = 16 + Hint = 'Set whether NIfTI images are compressed (.nii.gz) or not (.nii)' + Top = 7 + Width = 61 + BorderSpacing.Left = 4 + Caption = 'Compress' + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object outputFolderLabel: TLabel + AnchorSideLeft.Control = outnameEdit + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 494 + Height = 16 + Top = 7 + Width = 81 + BorderSpacing.Left = 4 + Caption = 'Output folder' + ParentColor = False + ParentFont = False + end + object outputFolderName: TButton + AnchorSideLeft.Control = outputFolderLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 577 + Height = 25 + Hint = 'NIfTI files will be saved to this folder. Press this button and click Cancel if you want files NIfTI images saved to same folder as DICOM input' + Top = 3 + Width = 180 + BorderSpacing.Left = 2 + Caption = 'input folder' + OnClick = outputFolderNameClick + ParentFont = False + ParentShowHint = False + ShowHint = True + TabOrder = 2 + end + object VerboseLabel: TLabel + AnchorSideLeft.Control = compressCheck + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 96 + Height = 16 + Hint = 'Set whether NIfTI images are compressed (.nii.gz) or not (.nii)' + Top = 7 + Width = 50 + BorderSpacing.Left = 4 + Caption = 'Verbose' + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + object verboseCheck: TCheckBox + AnchorSideLeft.Control = VerboseLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 148 + Height = 18 + Top = 6 + Width = 22 + BorderSpacing.Left = 2 + Checked = True + OnClick = compressCheckClick + ParentFont = False + ParentBidiMode = False + State = cbChecked + TabOrder = 3 + end + object bidsCheck: TCheckBox + AnchorSideLeft.Control = BIDSLabel + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 205 + Height = 18 + Top = 6 + Width = 22 + BorderSpacing.Left = 2 + OnClick = compressCheckClick + ParentFont = False + ParentBidiMode = False + TabOrder = 4 + end + object BIDSLabel: TLabel + AnchorSideLeft.Control = verboseCheck + AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Panel1 + AnchorSideTop.Side = asrCenter + Left = 174 + Height = 16 + Hint = 'Create Brain Imaging Data Structure file' + Top = 7 + Width = 29 + BorderSpacing.Left = 4 + Caption = 'BIDS' + ParentColor = False + ParentFont = False + ParentShowHint = False + ShowHint = True + end + end + object Memo1: TMemo + Left = 0 + Height = 321 + Top = 31 + Width = 772 + Align = alClient + Lines.Strings = ( ) + ReadOnly = True + ParentFont = False + ScrollBars = ssAutoVertical + TabOrder = 1 + end + object MainMenu1: TMainMenu + left = 24 + top = 48 + object FileMenu: TMenuItem + Caption = 'File' + object DicomMenu: TMenuItem + Caption = 'DICOM to NIfTI...' + OnClick = DicomMenuClick + end + object ParRecMenu: TMenuItem + Caption = 'PAR/REC to NIfTI...' + OnClick = ParRecMenuClick + end + object ResetMenu: TMenuItem + Caption = 'Reset defaults' + OnClick = ResetMenuClick + end + end + object EditMenu: TMenuItem + Caption = 'Edit' + object CopyMenu: TMenuItem + Caption = 'Copy' + OnClick = CopyMenuClick + end + end + end + object OpenDialog1: TOpenDialog + Filter = 'Philips research (*.par)|*.PAR;*.par' + Options = [ofAllowMultiSelect, ofEnableSizing, ofViewDetail] + left = 96 + top = 48 + end +end diff --git a/dcm2nii_old/dcm2nii.pas b/dcm2nii_old/dcm2nii.pas new file mode 100755 index 0000000..d410d29 --- /dev/null +++ b/dcm2nii_old/dcm2nii.pas @@ -0,0 +1,591 @@ +unit dcm2nii; + + {$IFDEF FPC} {$mode delphi}{$H+} {$ENDIF} +interface +uses + LazUTF8, LazFileUtils, + {$IFDEF FPC} + FileUtil, Process,LResources, + {$IFDEF UNIX} LCLIntf, {$ENDIF} + {$ELSE} + Windows, FileCtrl, shellAPI, Messages, + {$ENDIF} + {$IFNDEF UNIX} Registry, {$ENDIF} + {$IFDEF Darwin} userdir, {$ENDIF} + // + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, + StdCtrls, Menus; + +type + { Tdcm2niiForm } + Tdcm2niiForm = class(TForm) + compressCheck: TCheckBox; + MainMenu1: TMainMenu; + FileMenu: TMenuItem; + EditMenu: TMenuItem; + CopyMenu: TMenuItem; + DicomMenu: TMenuItem; + ResetMenu: TMenuItem; + ParRecMenu: TMenuItem; + outputFolderName: TButton; + //compressCheck: TCheckBox; + Label2: TLabel; + outputFolderLabel: TLabel; + outnameLabel: TLabel; + Memo1: TMemo; + Panel1: TPanel; + OpenDialog1: TOpenDialog; + outnameEdit: TEdit; + VerboseCheck: TCheckBox; + //bidsCheck: TCheckBox; + VerboseLabel: TLabel; + BIDSLabel: TLabel; + bidsCheck: TCheckBox; + //BIDSLabel: TLabel; + //verboseCheck: TCheckBox; + //VerboseLabel: TLabel; + procedure compressCheckClick(Sender: TObject); + procedure DicomMenuClick(Sender: TObject); + procedure FormResize(Sender: TObject); + procedure FormShow(Sender: TObject); + function getOutputFolder: string; + procedure outnameEditKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); + procedure ParRecMenuClick(Sender: TObject); + procedure ProcessFile(infilename: string); + procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); + procedure FormCreate(Sender: TObject); + procedure FormDropFiles(Sender: TObject; const FileNames: array of String); + procedure CopyMenuClick(Sender: TObject); + procedure outputFolderNameClick(Sender: TObject); + procedure ResetMenuClick(Sender: TObject); + procedure RunCmd (lCmd: string; isDemo: boolean; out line1: string); + function getExeName : string; //return path for command line tool + procedure readIni (ForceReset: boolean); //load preferences + procedure writeIni; //save preferences + function FindDicom2niixPath(const Executable: string): string; + // procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; + private + { private declarations } + {$IFNDEF FPC} procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES; {$ENDIF} + public + { public declarations } + end; + +var + dcm2niiForm: Tdcm2niiForm; + +implementation + {$IFDEF FPC} + {$R *.lfm} + {$ELSE} + {$R *.dfm} + {$ENDIF} +// + {$IFDEF CPU64} + const kExeName = 'dcm2niix'; + {$ELSE} + {$IFDEF Linux} + const kExeName = 'dcm2niix32'; + {$ELSE} + const kExeName = 'dcm2niix'; + {$ENDIF} + {$ENDIF} + + var + isAppDoneInitializing : boolean = false; + +{$IFDEF FPC} +function Tdcm2niiForm.FindDicom2niixPath(const Executable: string): string; +//function FindDicom2niixPath(const Executable: string): string; +var + s: string; +begin + {$IFDEF Darwin} + result := AppDir + kExeName; + if fileexists(result) then exit; + {$ENDIF} + result := FindDefaultExecutablePath(kExeName); + if result = '' then + result := FindDefaultExecutablePath(ExtractFilePath(paramstr(0))+'Resources'+pathdelim+kExeName); + if result = '' then + result := FindDefaultExecutablePath(ExtractFilePath (paramstr(0)) +kExeName); + if result = '' then + result := FindDefaultExecutablePath(kExeName); + {$IFDEF Unix} + if (result = '') and (fileexists('/usr/local/bin/'+kExeName)) then + result := '/usr/local/bin/'+kExeName; + {$ENDIF} + //Env:=GetEnvironmentVariableUTF8('PATH'); + //if result = '' then + // showmessage('mango:'+GetEnvironmentVariableUTF8('HOME')); +end; +{$ELSE} +function Tdcm2niiForm.FindDicom2niixPath(const Executable: string): string; +begin + result := extractfilepath(paramstr(0))+kExeName+'.exe'; +end; +{$ENDIF} + +function Tdcm2niiForm.getExeName : string; +var + lF: string; +begin + result := FindDicom2niixPath(kExeName); + if not fileexists(result) then begin + lF := ExtractFilePath (paramstr(0)); + result := lF+kExeName; + if not fileexists(result) then begin + Memo1.Lines.Clear; + memo1.Lines.Add('Error: unable to find executable '+kExeName+' in path'); + memo1.Lines.Add(' Solution: copy '+kExeName+' to '+lF); + result := ''; + end; //not in same folder as GUI + end; //not in path + {$IFNDEF UNIX} //strip .exe for Windows + result := ChangeFileExt(result, ''); + {$ENDIF} +end; //exeName() + +{$IFDEF UNIX} +function iniName : string; +begin + result := GetEnvironmentVariable ('HOME')+PathDelim+'.dcm2nii.ini'; +end; + +procedure Tdcm2niiForm.writeIni; +var + iniFile : TextFile; + begin + AssignFile(iniFile, iniName); + ReWrite(iniFile); + if (compressCheck.checked) then + WriteLn(iniFile, 'isGZ=1') + else + WriteLn(iniFile, 'isGZ=0'); + if (bidsCheck.checked) then + WriteLn(iniFile, 'isBIDS=1') + else + WriteLn(iniFile, 'isBIDS=0'); + WriteLn(iniFile, 'filename='+outnameEdit.caption); + CloseFile(iniFile); +end; //writeIni + +procedure Tdcm2niiForm.readIni (ForceReset: boolean); +var + fileData, rowData : TStringList; + row, i: integer; + opts_isGz, opts_isBids: boolean; + opts_filename: string; +begin + opts_isGz := true; + opts_isBids := true; + //opts_outdir := ''; + opts_filename := '%t_%p_%s'; + if FileExists( iniName) and (not (ForceReset )) then begin + fileData := TStringList.Create; + fileData.LoadFromFile(iniName); // Load from Testing.txt file + if (fileData.Count > 0) then begin + rowData := TStringList.Create; + rowData.Delimiter := '='; + for row := 0 to (fileData.Count-1) do begin //for each row of file + rowData.DelimitedText:=fileData[row]; + if ((rowData.Count > 1) and (CompareText(rowData[0] ,'isGZ')= 0)) then + opts_isGz := (CompareText(rowData[1],'1') = 0); + if ((rowData.Count > 1) and (CompareText(rowData[0] ,'isBIDS')= 0)) then + opts_isBids := (CompareText(rowData[1],'1') = 0); + if ((rowData.Count > 1) and (CompareText(rowData[0] ,'filename')= 0)) then begin + opts_filename := ''; + if (rowData.Count > 2) then + for i := 1 to (rowData.Count-2) do + opts_filename := opts_filename+ rowData[i]+' '; + opts_filename := opts_filename+ rowData[rowData.Count-1]; + end; + end; + rowData.Free; + end; + fileData.Free; + end else + memo1.Lines.Add('Using default settings'); + compressCheck.Checked := opts_isGz; + bidsCheck.Checked := opts_isBids; + outnameEdit.Caption := opts_filename; + //getExeName; +end; //readIni() +{$ELSE} +//For Windows we save preferences in the registry to ensure user has write access +procedure Tdcm2niiForm.writeIni; +var + ARegistry: TRegistry; +begin + ARegistry := TRegistry.Create; + ARegistry.RootKey := HKEY_CURRENT_USER;//HKEY_LOCAL_MACHINE; + if ARegistry.OpenKey ('\Software\dcm2nii',true) then begin + ARegistry.WriteBool('isGZ', compressCheck.Checked ); + ARegistry.WriteBool('isBIDS', bidsCheck.Checked ); + ARegistry.WriteString('filename', outnameEdit.text ); + end; + ARegistry.Free; +end; //writeIni() + +procedure Tdcm2niiForm.readIni (ForceReset: boolean); +var + ARegistry: TRegistry; + opts_isGz, opts_isBids: boolean; + opts_filename: string; +begin + opts_isBids := true; + opts_isGz := true; + opts_filename := '%t_%p_%s'; + if not ForceReset then begin + ARegistry := TRegistry.Create; + ARegistry.RootKey := HKEY_CURRENT_USER;//HKEY_LOCAL_MACHINE; + if ARegistry.OpenKey ('\Software\dcm2nii',true) then begin + if ARegistry.ValueExists( 'isGZ' ) then + opts_isGz := ARegistry.ReadBool( 'isGZ' ); + if ARegistry.ValueExists( 'isBIDS' ) then + opts_isBids := ARegistry.ReadBool( 'isBIDS' ); + if ARegistry.ValueExists( 'isGZ' ) then + opts_filename := ARegistry.ReadString( 'filename' ); + end; + ARegistry.Free; + end; + bidsCheck.Checked := opts_isBids; + compressCheck.Checked := opts_isGz; + outnameEdit.text := opts_filename; + //getExeName; +end; //readIni() +{$ENDIF} + +{$IFDEF FPC} +procedure Tdcm2niiForm.RunCmd (lCmd: string; isDemo: boolean; out line1: string); +//http://wiki.freepascal.org/Executing_External_Programs +var + OutputLines: TStringList; + MemStream: TMemoryStream; + OurProcess: TProcess; + NumBytes: LongInt; + BytesRead: LongInt; +const + READ_BYTES = 2048; +begin + line1 := ''; + if (not isAppDoneInitializing) then exit; + if (getExeName = '') then exit; + Memo1.Lines.Clear; + dcm2niiForm.refresh; Memo1.refresh; Memo1.invalidate; + MemStream := TMemoryStream.Create; + BytesRead := 0; + OurProcess := TProcess.Create(nil); + {$IFDEF UNIX} + OurProcess.Environment.Add(GetEnvironmentVariable('PATH')); + {$ENDIF} + OurProcess.CommandLine := lCmd; + // We cannot use poWaitOnExit here since we don't + // know the size of the output. On Linux the size of the + // output pipe is 2 kB; if the output data is more, we + // need to read the data. This isn't possible since we are + // waiting. So we get a deadlock here if we use poWaitOnExit. + OurProcess.Options := [poUsePipes, poNoConsole]; + OurProcess.Execute; + while True do begin + // make sure we have room + MemStream.SetSize(BytesRead + READ_BYTES); + // try reading it + NumBytes := OurProcess.Output.Read((MemStream.Memory + BytesRead)^, READ_BYTES); + if NumBytes > 0 // All read() calls will block, except the final one. + then begin + Inc(BytesRead, NumBytes); + end else + BREAK // Program has finished execution. + end; + MemStream.SetSize(BytesRead); + OutputLines := TStringList.Create; + OutputLines.LoadFromStream(MemStream); + if OutputLines.Count > 0 then begin + Line1 := OutputLines[0]; + //skip if line is "Compression will be faster with 'pigz'" + if (pos('Compression', Line1) = 1) and (OutputLines.Count > 0) then + Line1 := OutputLines[1]; + end; + Memo1.Lines.AddStrings(OutputLines); + if isDemo then begin + Memo1.Lines.Add(lCmd+' "MyDicomFolder"'); + Memo1.Lines.Add(''); + Memo1.Lines.Add(''); + Memo1.Lines.Add(' Drop DICOM folders here to convert'); + end else + Memo1.Lines.Add(lCmd); + OutputLines.Free; + OurProcess.Free; + MemStream.Free; +end; +{$ELSE} //if FPC else Delphi +procedure Tdcm2niiForm.RunCmd (lCmd: string; isDemo: boolean); +const + ReadBuffer = 2400; + var + Security : TSecurityAttributes; + ReadPipe,WritePipe : THandle; + start : TStartUpInfo; + ProcessInfo : TProcessInformation; + Buffer : Pchar; + BytesRead : DWord; + Apprunning : DWord; + begin + if (not isAppDoneInitializing) then exit; + if (getExeName = '') then exit; + Memo1.Lines.Clear; + With Security do begin + nlength := SizeOf(TSecurityAttributes) ; + binherithandle := true; + lpsecuritydescriptor := nil; + end; + if Createpipe (ReadPipe, WritePipe, + @Security, 0) then begin + Buffer := AllocMem(ReadBuffer + 1) ; + FillChar(Start,Sizeof(Start),#0) ; + start.cb := SizeOf(start) ; + start.hStdOutput := WritePipe; + start.hStdInput := ReadPipe; + start.dwFlags := STARTF_USESTDHANDLES + + STARTF_USESHOWWINDOW; + start.wShowWindow := SW_HIDE; + + if CreateProcess(nil, + PChar(lCmd), + @Security, + @Security, + true, + NORMAL_PRIORITY_CLASS, + nil, + nil, + start, + ProcessInfo) + then + begin + repeat + Apprunning := WaitForSingleObject + (ProcessInfo.hProcess,100) ; + Application.ProcessMessages; + until (Apprunning <> WAIT_TIMEOUT) ; + Repeat + BytesRead := 0; + ReadFile(ReadPipe,Buffer[0], +ReadBuffer,BytesRead,nil) ; + Buffer[BytesRead]:= #0; + OemToAnsi(Buffer,Buffer) ; + Memo1.Text := Memo1.text + String(Buffer) ; +if isDemo then + Memo1.Lines.Add(lCmd+' "MyDicomFolder"') + else + Memo1.Lines.Add(lCmd); + until (BytesRead < ReadBuffer) ; + end; + FreeMem(Buffer) ; + CloseHandle(ProcessInfo.hProcess) ; + CloseHandle(ProcessInfo.hThread) ; + CloseHandle(ReadPipe) ; + CloseHandle(WritePipe) ; + end; + end; +{$ENDIF} + +function Tdcm2niiForm.getOutputFolder: string; +begin + if (outputFolderName.Tag > 0) then + result := outputFolderName.Caption + else + result := ''; +end; //getOutputFolder + +procedure Tdcm2niiForm.ProcessFile(infilename: string); +var + cmd, outputFolder, inFolder, line1: string; +begin + inFolder := infilename; + (*if isTGZ(inFolder) then begin + infolder := deTGZ(infolder); + if infolder = '' then exit; //error + end;*) + cmd := '"'+getExeName +'" '; + if bidsCheck.checked then + cmd := cmd + '-b y ' + else + cmd := cmd + '-b n '; + if compressCheck.checked then + cmd := cmd + '-z y ' + else + cmd := cmd + '-z n '; + if verboseCheck.checked then + cmd := cmd + '-v y '; + outputFolder := getOutputFolder; + if length(outputFolder) > 0 then + cmd := cmd + '-o '+outputFolder+' '; + cmd := cmd + '-f "'+outnameEdit.Text+'" '; + if length(inFolder) > 0 then + cmd := cmd +'"'+inFolder+'"'; + //Caption := inttostr(length(inFolder)); + RunCmd(cmd, length(inFolder) = 0, line1); +end; //ProcessFile() + +procedure Tdcm2niiForm.outnameEditKeyUp(Sender: TObject; var Key: Word; + Shift: TShiftState); +begin + ProcessFile(''); +end; //outnameEditKeyUp() + +procedure Tdcm2niiForm.ParRecMenuClick(Sender: TObject); +var + lI: integer; +begin + if not OpenDialog1.execute then exit; + //ProcessFile(OpenDialog1.filename); + if OpenDialog1.Files.count < 1 then exit; + for lI := 0 to (OpenDialog1.Files.count-1) do + ProcessFile(OpenDialog1.Files[lI]); +end; //ParRecMenuClick() + +{$IFDEF FPC} +function getDirPrompt (lDefault: string): string; +begin + result := lDefault; // Set the starting directory + chdir(result); //start search from default dir... + if SelectDirectory(result, [sdAllowCreate,sdPerformCreate,sdPrompt], 0) then + chdir(result) + else + result := ''; +end; //getDirPrompt() +{$ELSE} +function DirExists(Name: string): Boolean; +{$IFDEF WIN32} +var + Code: Integer; +begin + Code := GetFileAttributes(PChar(Name)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; +{$ELSE} +var + SR: TSearchRec; +begin + if Name[Length(Name)] = '\' then Dec(Name[0]); + if (Length(Name) = 2) and (Name[2] = ':') then + Name := Name + '\*.*'; + Result := FindFirst(Name, faDirectory, SR) = 0; + Result := Result and (SR.Attr and faDirectory <> 0); +end; +{$ENDIF} + +function getDirPrompt (lDefault: string): string; +var + opts: TSelectDirOpts; +begin + result := lDefault; // Set the starting directory + if direxists(result) then + chdir(result); //start search from default dir... + if SelectDirectory(result, opts, 0) then + chdir(result) + else + result := ''; +end; //getDirPrompt() +{$ENDIF} +procedure Tdcm2niiForm.DicomMenuClick(Sender: TObject); +var + dir: string; +begin + dir := getDirPrompt(''); + ProcessFile( dir); +end; //DicomMenuClick() + +procedure Tdcm2niiForm.compressCheckClick(Sender: TObject); +begin + ProcessFile(''); +end; + +procedure Tdcm2niiForm.FormResize(Sender: TObject); +begin + outputFolderName.width := dcm2niiForm.Width-outputFolderName.left-2; +end; //FormResize() + +procedure Tdcm2niiForm.FormShow(Sender: TObject); +begin + ProcessFile(''); +end; + +procedure Tdcm2niiForm.FormDropFiles(Sender: TObject; const FileNames: array of String); +begin + ProcessFile( FileNames[0]); +end; //FormDropFiles() + +{$IFNDEF FPC} +procedure Tdcm2niiForm.WMDropFiles(var Msg: TWMDropFiles); //implement drag and drop +var CFileName: array[0..MAX_PATH] of Char; +begin + try + if DragQueryFile(Msg.Drop, 0, CFileName, MAX_PATH) > 0 then begin + ProcessFile(CFilename); + Msg.Result := 0; + end; + finally + DragFinish(Msg.Drop); + end; +end;//Proc WMDropFiles +{$ENDIF} + +procedure Tdcm2niiForm.CopyMenuClick(Sender: TObject); +begin + Memo1.SelectAll; + Memo1.CopyToClipboard; +end; //CopyMenuClick() + +procedure Tdcm2niiForm.outputFolderNameClick(Sender: TObject); +var + lDir : string; +begin + if (outputFolderName.Tag > 0) then //start search from prior location + lDir := outputFolderName.Caption + else + lDir := ''; + lDir := getDirPrompt(lDir); + outputFolderName.Tag := length(lDir); + if length(lDir) > 0 then + outputFolderName.Caption := lDir + else + outputFolderName.Caption := 'input folder'; +end; //outputFolderNameClick() + +procedure Tdcm2niiForm.ResetMenuClick(Sender: TObject); +begin + isAppDoneInitializing := false; + readIni(true); + isAppDoneInitializing := true; + ProcessFile(''); +end; + +procedure Tdcm2niiForm.FormCreate(Sender: TObject); +begin + readIni(false); + {$IFDEF FPC} + application.ShowButtonGlyphs:= sbgNever; + {$ELSE}//Delphi specific + DragAcceptFiles(dcm2niiForm.Handle, True); + {$ENDIF} + isAppDoneInitializing := true; + //ProcessFile(''); +end; //FormCreate() + +procedure Tdcm2niiForm.FormClose(Sender: TObject; var CloseAction: TCloseAction); +begin + writeIni; + {$IFNDEF FPC} + DragAcceptFiles(dcm2niiForm.Handle, False); + {$ENDIF} +end; //FormClose() + +initialization + //{$IFDEF FPC} + // {$I dcm2nii.lrs} + // {$ENDIF} +end. + diff --git a/mricron.lpi b/mricron.lpi index c52f2e7..0cc3e94 100755 --- a/mricron.lpi +++ b/mricron.lpi @@ -1,10 +1,12 @@ - + + + + - <Scaled Value="True"/> <ResourceType Value="res"/> @@ -266,6 +268,7 @@ <Linking> <Debugging> <GenerateDebugInfo Value="False"/> + <UseLineInfoUnit Value="False"/> <StripSymbols Value="True"/> </Debugging> <LinkSmart Value="True"/> diff --git a/mricron.lps b/mricron.lps index 3577bea..fa6527d 100644 --- a/mricron.lps +++ b/mricron.lps @@ -1,9 +1,9 @@ <?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectSession> - <Version Value="11"/> + <Version Value="12"/> <BuildModes Active="Default"/> - <Units Count="80"> + <Units Count="75"> <Unit0> <Filename Value="mricron.lpr"/> <IsPartOfProject Value="True"/> @@ -20,11 +20,12 @@ <ComponentName Value="HdrForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <EditorIndex Value="-1"/> + <EditorIndex Value="2"/> <WindowIndex Value="1"/> - <TopLine Value="662"/> - <CursorPos X="33" Y="684"/> + <TopLine Value="172"/> + <CursorPos Y="182"/> <UsageCount Value="200"/> + <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit1> <Unit2> @@ -35,8 +36,8 @@ <ResourceBaseClass Value="Form"/> <EditorIndex Value="6"/> <WindowIndex Value="1"/> - <TopLine Value="39"/> - <CursorPos X="25" Y="61"/> + <TopLine Value="40"/> + <CursorPos X="58" Y="53"/> <UsageCount Value="200"/> <Loaded Value="True"/> <LoadedDesigner Value="True"/> @@ -61,12 +62,14 @@ <ComponentName Value="RenderForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <EditorIndex Value="3"/> + <IsVisibleTab Value="True"/> + <EditorIndex Value="1"/> <WindowIndex Value="1"/> - <TopLine Value="596"/> - <CursorPos X="22" Y="608"/> + <TopLine Value="818"/> + <CursorPos X="54" Y="847"/> <UsageCount Value="200"/> <Loaded Value="True"/> + <LoadedDesigner Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit4> <Unit5> @@ -88,8 +91,8 @@ <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> <WindowIndex Value="1"/> - <TopLine Value="5069"/> - <CursorPos X="55" Y="5071"/> + <TopLine Value="1844"/> + <CursorPos X="73" Y="1872"/> <UsageCount Value="200"/> <Loaded Value="True"/> <LoadedDesigner Value="True"/> @@ -153,13 +156,11 @@ <ComponentName Value="ReadIntForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <EditorIndex Value="12"/> + <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="35"/> <CursorPos Y="40"/> <UsageCount Value="200"/> - <Loaded Value="True"/> - <LoadedDesigner Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit11> <Unit12> @@ -182,12 +183,11 @@ <ComponentName Value="BETForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <EditorIndex Value="4"/> + <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="165"/> <CursorPos X="14" Y="180"/> <UsageCount Value="200"/> - <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit13> <Unit14> @@ -196,12 +196,11 @@ <ComponentName Value="MNIForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <EditorIndex Value="10"/> + <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="8"/> <CursorPos X="73" Y="12"/> <UsageCount Value="200"/> - <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit14> <Unit15> @@ -222,11 +221,9 @@ <ComponentName Value="PrefForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <IsVisibleTab Value="True"/> - <EditorIndex Value="1"/> + <EditorIndex Value="4"/> <WindowIndex Value="1"/> - <TopLine Value="134"/> - <CursorPos X="14" Y="155"/> + <CursorPos X="69" Y="6"/> <UsageCount Value="200"/> <Loaded Value="True"/> <LoadedDesigner Value="True"/> @@ -277,12 +274,11 @@ <ComponentName Value="AnatForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <EditorIndex Value="5"/> + <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="97"/> <CursorPos X="3" Y="99"/> <UsageCount Value="200"/> - <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit20> <Unit21> @@ -312,8 +308,8 @@ <IsPartOfProject Value="True"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> - <TopLine Value="226"/> - <CursorPos X="26" Y="250"/> + <TopLine Value="33"/> + <CursorPos X="61" Y="37"/> <UsageCount Value="200"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit24> @@ -323,27 +319,27 @@ <ComponentName Value="dcm2niiForm"/> <HasResources Value="True"/> <ResourceBaseClass Value="Form"/> - <EditorIndex Value="9"/> + <EditorIndex Value="7"/> <WindowIndex Value="1"/> - <TopLine Value="99"/> - <CursorPos X="95" Y="110"/> - <UsageCount Value="98"/> + <CursorPos X="12" Y="13"/> + <UsageCount Value="129"/> <Loaded Value="True"/> + <LoadedDesigner Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit25> <Unit26> <Filename Value="define_types.pas"/> <TopLine Value="410"/> <CursorPos X="23" Y="420"/> - <UsageCount Value="65"/> + <UsageCount Value="62"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit26> <Unit27> <Filename Value="nifti_img.pas"/> - <EditorIndex Value="11"/> + <EditorIndex Value="5"/> <WindowIndex Value="1"/> - <TopLine Value="5575"/> - <CursorPos X="39" Y="5581"/> + <TopLine Value="5942"/> + <CursorPos X="113" Y="5962"/> <UsageCount Value="101"/> <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> @@ -354,7 +350,7 @@ <HasResources Value="True"/> <TopLine Value="83"/> <CursorPos X="47" Y="93"/> - <UsageCount Value="164"/> + <UsageCount Value="161"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit28> <Unit29> @@ -362,34 +358,34 @@ <ComponentName Value="DesignForm"/> <HasResources Value="True"/> <CursorPos X="45" Y="167"/> - <UsageCount Value="164"/> + <UsageCount Value="161"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit29> <Unit30> <Filename Value="logistic.pas"/> <TopLine Value="1075"/> <CursorPos Y="1100"/> - <UsageCount Value="4"/> + <UsageCount Value="1"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit30> <Unit31> <Filename Value="nifti_hdr.pas"/> <TopLine Value="172"/> <CursorPos X="5" Y="188"/> - <UsageCount Value="57"/> + <UsageCount Value="54"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit31> <Unit32> <Filename Value="gzio2.pas"/> <TopLine Value="278"/> <CursorPos X="11" Y="282"/> - <UsageCount Value="9"/> + <UsageCount Value="6"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit32> <Unit33> <Filename Value="ugraphics.pas"/> <CursorPos X="15"/> - <UsageCount Value="57"/> + <UsageCount Value="54"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit33> <Unit34> @@ -397,7 +393,7 @@ <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <CursorPos X="26" Y="3"/> - <UsageCount Value="31"/> + <UsageCount Value="28"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit34> <Unit35> @@ -406,25 +402,26 @@ <WindowIndex Value="1"/> <TopLine Value="844"/> <CursorPos X="29" Y="854"/> - <UsageCount Value="82"/> + <UsageCount Value="79"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit35> <Unit36> <Filename Value="common/nifti_hdr.pas"/> - <EditorIndex Value="-1"/> + <EditorIndex Value="3"/> <WindowIndex Value="1"/> - <TopLine Value="1142"/> - <CursorPos X="26" Y="1164"/> - <UsageCount Value="64"/> + <TopLine Value="8"/> + <CursorPos X="34" Y="27"/> + <UsageCount Value="79"/> + <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit36> <Unit37> <Filename Value="common/define_types.pas"/> - <EditorIndex Value="7"/> + <EditorIndex Value="8"/> <WindowIndex Value="1"/> - <TopLine Value="12"/> - <CursorPos X="15" Y="19"/> - <UsageCount Value="102"/> + <TopLine Value="6"/> + <CursorPos X="28" Y="23"/> + <UsageCount Value="101"/> <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit37> @@ -434,23 +431,24 @@ <WindowIndex Value="1"/> <TopLine Value="402"/> <CursorPos X="26" Y="415"/> - <UsageCount Value="23"/> + <UsageCount Value="20"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit38> <Unit39> <Filename Value="common/gzio2.pas"/> <TopLine Value="111"/> <CursorPos X="81" Y="119"/> - <UsageCount Value="12"/> + <UsageCount Value="9"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit39> <Unit40> <Filename Value="common/nifti_types.pas"/> - <EditorIndex Value="-1"/> + <EditorIndex Value="9"/> <WindowIndex Value="1"/> - <TopLine Value="107"/> - <CursorPos Y="116"/> - <UsageCount Value="99"/> + <TopLine Value="45"/> + <CursorPos X="9" Y="70"/> + <UsageCount Value="107"/> + <Loaded Value="True"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit40> <Unit41> @@ -458,7 +456,7 @@ <WindowIndex Value="1"/> <TopLine Value="886"/> <CursorPos X="7" Y="886"/> - <UsageCount Value="12"/> + <UsageCount Value="9"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit41> <Unit42> @@ -467,7 +465,7 @@ <WindowIndex Value="1"/> <TopLine Value="2527"/> <CursorPos Y="2536"/> - <UsageCount Value="3"/> + <UsageCount Value="10"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit42> <Unit43> @@ -475,7 +473,7 @@ <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <CursorPos X="65" Y="21"/> - <UsageCount Value="47"/> + <UsageCount Value="44"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit43> <Unit44> @@ -484,7 +482,7 @@ <WindowIndex Value="1"/> <TopLine Value="256"/> <CursorPos X="32" Y="272"/> - <UsageCount Value="46"/> + <UsageCount Value="43"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit44> <Unit45> @@ -493,7 +491,7 @@ <WindowIndex Value="1"/> <TopLine Value="165"/> <CursorPos X="42" Y="176"/> - <UsageCount Value="46"/> + <UsageCount Value="43"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit45> <Unit46> @@ -503,242 +501,198 @@ <ResourceBaseClass Value="Form"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> - <UsageCount Value="27"/> + <UsageCount Value="24"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit46> <Unit47> - <Filename Value="/Developer/lazarus/lcl/interfaces/cocoa/cocoawsmenus.pas"/> + <Filename Value="reslice_img.pas"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> - <CursorPos X="16" Y="29"/> + <CursorPos X="34" Y="8"/> <UsageCount Value="2"/> <DefaultSyntaxHighlighter Value="Delphi"/> </Unit47> <Unit48> - <Filename Value="../raycast/shaderu.pas"/> - <EditorIndex Value="-1"/> - <WindowIndex Value="1"/> - <TopLine Value="113"/> - <CursorPos X="19" Y="127"/> - <UsageCount Value="1"/> - <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit48> - <Unit49> - <Filename Value="../raycast/shaderui.pas"/> - <EditorIndex Value="-1"/> - <WindowIndex Value="1"/> - <TopLine Value="277"/> - <CursorPos X="24" Y="300"/> - <UsageCount Value="1"/> - <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit49> - <Unit50> - <Filename Value="reslice_img.pas"/> - <EditorIndex Value="-1"/> - <WindowIndex Value="1"/> - <CursorPos X="34" Y="8"/> - <UsageCount Value="5"/> - <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit50> - <Unit51> <Filename Value="common/dialogsx.pas"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <CursorPos X="6" Y="9"/> - <UsageCount Value="3"/> + <UsageCount Value="10"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit51> - <Unit52> + </Unit48> + <Unit49> <Filename Value="/Developer/lazarus/lcl/dialogs.pp"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="21"/> <CursorPos X="3" Y="38"/> - <UsageCount Value="3"/> - <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit52> - <Unit53> - <Filename Value="batch.pas"/> - <EditorIndex Value="-1"/> - <WindowIndex Value="1"/> - <TopLine Value="148"/> - <CursorPos X="32" Y="160"/> - <UsageCount Value="2"/> - <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit53> - <Unit54> - <Filename Value="yokesharemem.pas"/> - <EditorIndex Value="-1"/> - <WindowIndex Value="1"/> - <TopLine Value="104"/> - <CursorPos X="22" Y="124"/> - <UsageCount Value="2"/> + <UsageCount Value="10"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit54> - <Unit55> + </Unit49> + <Unit50> <Filename Value="dilate.pas"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <CursorPos Y="4"/> - <UsageCount Value="23"/> + <UsageCount Value="20"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit55> - <Unit56> + </Unit50> + <Unit51> <Filename Value="uscaledpi.pas"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="40"/> <CursorPos Y="50"/> - <UsageCount Value="16"/> + <UsageCount Value="13"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit56> - <Unit57> + </Unit51> + <Unit52> <Filename Value="../../lazarus/lcl/interfaces/cocoa/cocoawinapi.inc"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="1277"/> <CursorPos X="13" Y="1280"/> - <UsageCount Value="5"/> + <UsageCount Value="2"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit57> - <Unit58> + </Unit52> + <Unit53> <Filename Value="../../lazarus/lcl/interfaces/cocoa/cocoawinapih.inc"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="168"/> <CursorPos X="82" Y="187"/> - <UsageCount Value="5"/> + <UsageCount Value="2"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit58> - <Unit59> + </Unit53> + <Unit54> <Filename Value="../../lazarus/lcl/interfaces/cocoa/cocoagdiobjects.pas"/> <UnitName Value="CocoaGDIObjects"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="38"/> <CursorPos X="16" Y="52"/> - <UsageCount Value="5"/> + <UsageCount Value="2"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit59> - <Unit60> + </Unit54> + <Unit55> <Filename Value="common/userdir.pas"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <CursorPos X="13"/> - <UsageCount Value="8"/> + <UsageCount Value="5"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit60> - <Unit61> + </Unit55> + <Unit56> <Filename Value="../../lazarus/lcl/interfaces/cocoa/cocoawsmenus.pas"/> <UnitName Value="CocoaWSMenus"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="15"/> <CursorPos X="56" Y="21"/> - <UsageCount Value="5"/> + <UsageCount Value="2"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit61> - <Unit62> + </Unit56> + <Unit57> <Filename Value="dcm2nii.lfm"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> - <UsageCount Value="5"/> + <UsageCount Value="2"/> <DefaultSyntaxHighlighter Value="LFM"/> - </Unit62> - <Unit63> + </Unit57> + <Unit58> <Filename Value="../../lazarus/components/lazutils/fileutil.pas"/> <UnitName Value="FileUtil"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="50"/> <CursorPos X="10" Y="67"/> - <UsageCount Value="9"/> + <UsageCount Value="6"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit63> - <Unit64> + </Unit58> + <Unit59> <Filename Value="../../lazarus/components/lazutils/fileutil.inc"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="651"/> <CursorPos X="36" Y="659"/> - <UsageCount Value="9"/> + <UsageCount Value="6"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit64> - <Unit65> + </Unit59> + <Unit60> <Filename Value="../../lazarus/components/lazutils/lazutf8.pas"/> <UnitName Value="LazUTF8"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="382"/> <CursorPos X="58" Y="393"/> - <UsageCount Value="9"/> + <UsageCount Value="6"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit65> - <Unit66> + </Unit60> + <Unit61> <Filename Value="/usr/local/share/fpcsrc/rtl/objpas/sysutils/osutilsh.inc"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="51"/> <CursorPos X="46" Y="68"/> - <UsageCount Value="9"/> - </Unit66> - <Unit67> + <UsageCount Value="6"/> + </Unit61> + <Unit62> <Filename Value="/lazarus/lcl/interfaces/cocoa/cocoa_extra.pas"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="8"/> <CursorPos X="2" Y="18"/> - <UsageCount Value="6"/> + <UsageCount Value="3"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit67> - <Unit68> + </Unit62> + <Unit63> <Filename Value="../../lazarus/lcl/interfaces/carbon/carbonproc.pp"/> <UnitName Value="CarbonProc"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="549"/> <CursorPos X="13" Y="563"/> - <UsageCount Value="7"/> + <UsageCount Value="4"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit68> - <Unit69> + </Unit63> + <Unit64> <Filename Value="../../lazarus/lcl/include/wincontrol.inc"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="7402"/> <CursorPos Y="7414"/> - <UsageCount Value="13"/> + <UsageCount Value="10"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit69> - <Unit70> + </Unit64> + <Unit65> <Filename Value="../../lazarus/ide/keymapping.pp"/> <UnitName Value="KeyMapping"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="534"/> <CursorPos X="20" Y="552"/> - <UsageCount Value="6"/> + <UsageCount Value="3"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit70> - <Unit71> + </Unit65> + <Unit66> <Filename Value="../../Downloads/cocoa_minimal/unit2.pas"/> <UnitName Value="Unit2"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> - <UsageCount Value="7"/> + <UsageCount Value="4"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit71> - <Unit72> + </Unit66> + <Unit67> <Filename Value="/lazarus/lcl/interfaces/carbon/carbonproc.pp"/> <UnitName Value="CarbonProc"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="554"/> <CursorPos X="72" Y="565"/> - <UsageCount Value="14"/> + <UsageCount Value="11"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit72> - <Unit73> + </Unit67> + <Unit68> <Filename Value="nifti_img_view.lfm"/> <ComponentName Value="ImgForm"/> <HasResources Value="True"/> @@ -746,184 +700,182 @@ <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <CursorPos X="27" Y="6"/> - <UsageCount Value="12"/> + <UsageCount Value="9"/> <DefaultSyntaxHighlighter Value="LFM"/> - </Unit73> - <Unit74> + </Unit68> + <Unit69> <Filename Value="stat.pas"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <CursorPos X="24" Y="7"/> - <UsageCount Value="12"/> + <UsageCount Value="9"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit74> - <Unit75> + </Unit69> + <Unit70> <Filename Value="rgb/rgbroutines.pas"/> <UnitName Value="RGBRoutines"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="49"/> <CursorPos X="84" Y="76"/> - <UsageCount Value="17"/> + <UsageCount Value="14"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit75> - <Unit76> + </Unit70> + <Unit71> <Filename Value="../../../lazarus/lcl/controls.pp"/> <UnitName Value="Controls"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="4228"/> <CursorPos Y="4244"/> - <UsageCount Value="9"/> - </Unit76> - <Unit77> + <UsageCount Value="6"/> + </Unit71> + <Unit72> <Filename Value="statclustertable.pas"/> <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <TopLine Value="280"/> <CursorPos X="42" Y="291"/> - <UsageCount Value="12"/> + <UsageCount Value="9"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit77> - <Unit78> + </Unit72> + <Unit73> <Filename Value="dcm_load.pas"/> - <EditorIndex Value="8"/> + <EditorIndex Value="-1"/> <WindowIndex Value="1"/> <CursorPos X="19" Y="12"/> - <UsageCount Value="13"/> - <Loaded Value="True"/> + <UsageCount Value="10"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit78> - <Unit79> + </Unit73> + <Unit74> <Filename Value="nsappkitext.pas"/> - <EditorIndex Value="2"/> + <EditorIndex Value="-1"/> <WindowIndex Value="1"/> - <CursorPos X="17"/> - <UsageCount Value="10"/> - <Loaded Value="True"/> + <CursorPos X="13" Y="11"/> + <UsageCount Value="7"/> <DefaultSyntaxHighlighter Value="Delphi"/> - </Unit79> + </Unit74> </Units> <JumpHistory Count="30" HistoryIndex="29"> <Position1> - <Filename Value="bet.pas"/> - <Caret Line="221" Column="34" TopLine="199"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="5488" Column="26" TopLine="5460"/> </Position1> <Position2> - <Filename Value="bet.pas"/> - <Caret Line="130" Column="16" TopLine="120"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="882" Column="16" TopLine="865"/> </Position2> <Position3> - <Filename Value="bet.pas"/> - <Caret Line="156" Column="16" TopLine="137"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="1245" Column="12" TopLine="1233"/> </Position3> <Position4> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="871" Column="10" TopLine="869"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="84" Column="27" TopLine="66"/> </Position4> <Position5> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="3270" Column="26" TopLine="3259"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="1037" Column="21" TopLine="1009"/> </Position5> <Position6> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="3280" Column="20" TopLine="3261"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="1999" Column="27" TopLine="1971"/> </Position6> <Position7> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="4232" Column="22" TopLine="4219"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="2134" Column="27" TopLine="2106"/> </Position7> <Position8> <Filename Value="nifti_img.pas"/> - <Caret Line="70" Column="31" TopLine="58"/> + <Caret Line="2154" Column="19" TopLine="2126"/> </Position8> <Position9> <Filename Value="nifti_img.pas"/> - <Caret Line="3847" Column="23" TopLine="3828"/> + <Caret Line="2161" Column="27" TopLine="2133"/> </Position9> <Position10> <Filename Value="nifti_img.pas"/> - <Caret Line="3876" Column="61" TopLine="3873"/> + <Caret Line="2180" Column="21" TopLine="2152"/> </Position10> <Position11> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="4226" Column="19" TopLine="4219"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="2182" Column="21" TopLine="2154"/> </Position11> <Position12> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="293" Column="26" TopLine="283"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="2185" Column="29" TopLine="2157"/> </Position12> <Position13> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="332" Column="29" TopLine="314"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="2405" Column="23" TopLine="2379"/> </Position13> <Position14> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="2495" Column="34" TopLine="2487"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="83" Column="31" TopLine="66"/> </Position14> <Position15> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="2133" Column="59" TopLine="2122"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="1037" Column="25" TopLine="1009"/> </Position15> <Position16> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="2121" Column="32" TopLine="2106"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="2134" Column="31" TopLine="2106"/> </Position16> <Position17> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="3209" Column="66" TopLine="3190"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="2185" Column="36" TopLine="2166"/> </Position17> <Position18> - <Filename Value="nifti_img_view.pas"/> - <Caret Line="2117" Column="35" TopLine="2106"/> + <Filename Value="nifti_img.pas"/> + <Caret Line="2176" Column="32" TopLine="2159"/> </Position18> <Position19> <Filename Value="nifti_img_view.pas"/> - <Caret Line="3209" Column="66" TopLine="3190"/> + <Caret Line="1247" Column="12" TopLine="1235"/> </Position19> <Position20> - <Filename Value="nifti_img.pas"/> - <Caret Line="6" Column="110"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="3558" TopLine="3555"/> </Position20> <Position21> <Filename Value="nifti_img.pas"/> - <Caret Line="5584" Column="12" TopLine="5573"/> + <Caret Line="2113" Column="55" TopLine="2112"/> </Position21> <Position22> - <Filename Value="nifti_img.pas"/> - <Caret Line="5581" Column="32" TopLine="5575"/> + <Filename Value="about.pas"/> + <Caret Line="53" Column="58" TopLine="40"/> </Position22> <Position23> - <Filename Value="ReadInt.pas"/> - <Caret Line="53" Column="43" TopLine="35"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="1304" Column="23" TopLine="1297"/> </Position23> <Position24> <Filename Value="nifti_img_view.pas"/> - <Caret Line="2117" Column="4" TopLine="2106"/> + <Caret Line="1873" Column="19" TopLine="1857"/> </Position24> <Position25> <Filename Value="nifti_img_view.pas"/> - <Caret Line="3939" TopLine="3939"/> + <Caret Line="3236" Column="22" TopLine="3207"/> </Position25> <Position26> - <Filename Value="common/define_types.pas"/> - <Caret Line="19" Column="15" TopLine="12"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="407" Column="18" TopLine="390"/> </Position26> <Position27> - <Filename Value="render.pas"/> - <Caret Line="608" Column="22" TopLine="596"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="840" Column="31" TopLine="812"/> </Position27> <Position28> - <Filename Value="prefs.pas"/> - <Caret Line="153" Column="31" TopLine="137"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="864" Column="31" TopLine="836"/> </Position28> <Position29> - <Filename Value="prefs.pas"/> - <Caret Line="11" Column="29"/> + <Filename Value="render.pas"/> + <Caret Line="602" Column="119" TopLine="596"/> </Position29> <Position30> - <Filename Value="prefs.pas"/> - <Caret Line="19" Column="13"/> + <Filename Value="nifti_img_view.pas"/> + <Caret Line="1836" Column="36" TopLine="1817"/> </Position30> </JumpHistory> <RunParams> diff --git a/mricron.res b/mricron.res index 3643ce4..8f7718a 100755 Binary files a/mricron.res and b/mricron.res differ diff --git a/nifti_img.pas b/nifti_img.pas index 42d4df5..fd0e251 100755 --- a/nifti_img.pas +++ b/nifti_img.pas @@ -2115,7 +2115,6 @@ procedure SaveAsVOIorNIFTIinnercore (var lFilename: string; var lImgBuffer: Byte lBuff^[lC] := 0; lC := lImgOffset+1; //move(lImgBuffer^[1],lBuff[lC],lImgBufferItems*lImgBufferBPP); - move(lImgBuffer^,lBuff^[lC],lImgBufferItems*lImgBufferBPP); if (lExt='.NII') then begin Filemode := 1; @@ -2131,6 +2130,17 @@ procedure SaveAsVOIorNIFTIinnercore (var lFilename: string; var lImgBuffer: Byte freemem(lBuff); end; +function gz2niigz (fnm: string): string; //img.gz -> img.nii.gz +var + lExt: string; +begin + lExt := uppercase(extractfileext(fnm)); + if (lExt = '.GZ') then + result := changefileextX(fnm,'.nii.gz') + else + result := fnm; +end; + procedure SaveAsVOIorNIFTIcoreOrtho (var lFilename: string; var lImgBuffer: ByteP; lImgBufferItems, lImgBufferBPP,lnVol: integer; var lNiftiHdr: TNIFTIHdr); var lISize: integer; @@ -2138,6 +2148,7 @@ procedure SaveAsVOIorNIFTIcoreOrtho (var lFilename: string; var lImgBuffer: Byte begin if not gBGImg.UseReorientHdr then exit; + lFilename := gz2niigz(lFilename); lTempHdr.NIFTIhdr := lNIftIHdr; lISize := (lImgBufferItems*lImgBufferBPP); GetMem(lTempHdr.ImgBufferUnaligned ,lISize + 16); @@ -2164,6 +2175,7 @@ procedure SaveAsVOIorNIFTIcore (var lFilename: string; var lImgBuffer: ByteP; lI begin //10/2007 - scl_slope; //lExt := UpCaseExt(lFileName); + lFilename := gz2niigz(lFilename); if DiskFreeEx(lFilename) < (kImgOffset+(lImgBufferItems*lImgBufferBPP)) then begin case MessageDlg('Very little space on the selected drive. Attempt to save to this disk?', mtConfirmation, [mbYes, mbCancel], 0) of @@ -2441,7 +2453,7 @@ procedure SetBGImgDefaults (var lBGImg: TBGImg); BGTransPct := 0; LicenseID := 0; DarkMode := false; - ShowDraw := false; + ShowDraw := false; ResliceOnLoad := false; OrthoReslice := true; Prompt4DVolume := true; @@ -3782,7 +3794,7 @@ procedure Balance (var lHdr: TMRIcroHdr); lBlackAutoBal := 2; lWHiteAUtoBal := kHistoBins; end; - lHdr.AutoBalMaxUnscaled := ((lWhiteAutoBal/kHistoBins)*(lHdr.GlMaxUnscaledS-lHdr.GlMinUnscaledS))+lHdr.GlMinUnscaledS; + lHdr.AutoBalMaxUnscaled := ((lWhiteAutoBal/kHistoBins)*(lHdr.GlMaxUnscaledS-lHdr.GlMinUnscaledS))+lHdr.GlMinUnscaledS; lHdr.AutoBalMinUnscaled := ((lBlackAutoBal/kHistoBins)*(lHdr.GlMaxUnscaledS-lHdr.GlMinUnscaledS))+lHdr.GlMinUnscaledS; //only apply rounding if there is a large difference - e.g. if range is 0..1 then rounding will hurt if (lHdr.ImgBufferBPP < 4) and ((lHdr.AutoBalMaxUnscaled-lHdr.AutoBalMinUnscaled) > 50) then begin //round integer values @@ -5506,6 +5518,7 @@ function OpenImg(var lBackgroundImg: TBGImg; var lImg2Load: TMRIcroHdr; lLoadBac lW: Wordp; lFName,lParseName: String; F: file; + l8Buf : int8p; l16Buf : SmallIntP; l32Buf,l32TempBuf : SingleP; l64Buf : DoubleP; @@ -5608,11 +5621,11 @@ function OpenImg(var lBackgroundImg: TBGImg; var lImg2Load: TMRIcroHdr; lLoadBac Seek (F,lOffset + (lMultiImgSz *(lVol-1)) ); case lDataType of - kDT_SIGNED_SHORT,kDT_UINT16: lImg2Load.ImgBufferBPP := 2; + kDT_INT8,kDT_UNSIGNED_CHAR : lImg2Load.ImgBufferBPP := 1; + kDT_SIGNED_SHORT,kDT_UINT16: lImg2Load.ImgBufferBPP := 2; kDT_SIGNED_INT,kDT_FLOAT, kDT_UINT32: lImg2Load.ImgBufferBPP := 4; kDT_DOUBLE: lImg2Load.ImgBufferBPP := 8; - kDT_UNSIGNED_CHAR : lImg2Load.ImgBufferBPP := 1; - kDT_RGB: lImg2Load.ImgBufferBPP := 1;//rgb + kDT_RGB: lImg2Load.ImgBufferBPP := 1;//rgb else begin showmessage('Unable to read this image format '+inttostr(lDataType)); goto 456; @@ -5657,6 +5670,13 @@ function OpenImg(var lBackgroundImg: TBGImg; var lImg2Load: TMRIcroHdr; lLoadBac //Next: prepare image : byte swap, check for special.. case lDataType of kDT_RGB: ParseRGB(lImg2Load);//RGB + kDT_INT8: begin //int8 -> uint8 + l8Buf := int8p(lImg2Load.ImgBuffer ); + for lInc := 1 to lImgSamples do + lImg2Load.ImgBuffer^[lInc] := l8Buf[lInc] + 128;; + lImg2Load.NIFTIhdr.scl_inter := lImg2Load.NIFTIhdr.scl_inter - (128*lImg2Load.NIFTIhdr.scl_slope); + lImg2Load.NIFTIhdr.datatype:= kDT_UINT8; + end; {$IFDEF UINT16ASFLOAT} kDT_UINT16: begin //showmessage(format('%d ', [12])); @@ -5821,13 +5841,12 @@ function OpenImg(var lBackgroundImg: TBGImg; var lImg2Load: TMRIcroHdr; lLoadBac 1: begin FindImgMinMax8 (lImg2Load, lMini,lMaxi); lImg2Load.GlMaxUnscaledS := lMaxI; - lImg2Load.GlMinUnscaledS := lMinI;; + lImg2Load.GlMinUnscaledS := lMinI; end; 2: begin FindImgMinMax16 (lImg2Load, lMini,lMaxi); lImg2Load.GlMaxUnscaledS := lMaxI; lImg2Load.GlMinUnscaledS := lMinI; - end; 4: FindImgMinMax32 (lImg2Load,lImg2Load.GlMinUnscaledS,lImg2Load.GlMaxUnscaledS); @@ -5939,6 +5958,15 @@ function OpenImg(var lBackgroundImg: TBGImg; var lImg2Load: TMRIcroHdr; lLoadBac end; lParseName := parsefilename(extractfilename(lImg2Load.HdrFileName)); + + if (lImg2Load.NIFTIhdr.cal_min < lImg2Load.NIFTIhdr.cal_max) and (lImg2Load.NIFTIhdr.cal_min > lImg2Load.GlMinUnscaledS) and (lImg2Load.NIFTIhdr.cal_max < lImg2Load.GlMaxUnscaledS) then begin + lImg2Load.WindowScaledMin := lImg2Load.NIFTIhdr.cal_min; + lImg2Load.WindowScaledMax := lImg2Load.NIFTIhdr.cal_max; + + lImg2Load.AutoBalMinUnscaled := lImg2Load.WindowScaledMin; + lImg2Load.AutoBalMaxUnscaled := lImg2Load.WindowScaledMax; + end; + if (lParsename = 'ch2bet') or (lParseName = 'ch2better') then begin lImg2Load.WindowScaledMin := 45; lImg2Load.WindowScaledMax := 120; diff --git a/nifti_img_view.lfm b/nifti_img_view.lfm index 1c2165e..7881987 100755 --- a/nifti_img_view.lfm +++ b/nifti_img_view.lfm @@ -1,7 +1,7 @@ object ImgForm: TImgForm Left = 145 Height = 480 - Top = 158 + Top = 121 Width = 1135 ActiveControl = ControlPanel AllowDropFiles = True @@ -16,6 +16,7 @@ object ImgForm: TImgForm OnDropFiles = FormDropFiles OnKeyDown = FormKeyDown OnKeyPress = FormKeyPress + OnMouseWheel = FormMouseWheel OnResize = FormResize OnShow = FormShow Position = poScreenCenter @@ -27,7 +28,6 @@ object ImgForm: TImgForm Top = 0 Width = 1135 Align = alTop - AutoSize = True BevelOuter = bvNone BorderWidth = 1 ClientHeight = 38 @@ -401,6 +401,7 @@ object ImgForm: TImgForm BorderSpacing.Left = 6 DropDownCount = 12 ItemHeight = 26 + ItemIndex = 0 Items.Strings = ( 'Fit' 'Int' @@ -421,7 +422,7 @@ object ImgForm: TImgForm ShowHint = True Style = csDropDownList TabOrder = 0 - Text = '0' + Text = 'Fit' end object XViewEdit: TSpinEdit AnchorSideLeft.Control = LabelX @@ -522,9 +523,10 @@ object ImgForm: TImgForm Height = 426 Top = 0 Width = 1135 - HorzScrollBar.Page = 584 - VertScrollBar.Page = 190 + HorzScrollBar.Page = 583 + VertScrollBar.Page = 189 Align = alClient + AutoSize = True BorderStyle = bsNone ClientHeight = 426 ClientWidth = 1135 @@ -534,12 +536,13 @@ object ImgForm: TImgForm ParentFont = False TabOrder = 0 OnClick = ImgPanelClick + OnMouseWheel = TriplePanelMouseWheel object PGImageCor: TImage Tag = 2 Cursor = crCross - Left = 1 + Left = 0 Height = 12 - Top = 1 + Top = 0 Width = 12 AutoSize = True OnDblClick = PGImageCorDblClick @@ -551,9 +554,9 @@ object ImgForm: TImgForm object PGImageSag: TImage Tag = 3 Cursor = crCross - Left = 24 + Left = 23 Height = 12 - Top = 1 + Top = 0 Width = 12 AutoSize = True OnDblClick = PGImageCorDblClick @@ -565,9 +568,9 @@ object ImgForm: TImgForm object PGImageAx: TImage Tag = 1 Cursor = crCross - Left = 572 + Left = 571 Height = 12 - Top = 178 + Top = 177 Width = 12 AutoSize = True OnDblClick = PGImageCorDblClick @@ -579,8 +582,8 @@ object ImgForm: TImgForm end end object MainMenu1: TMainMenu - left = 112 - top = 212 + left = 152 + top = 128 object AppleMenu: TMenuItem Caption = '' Visible = False @@ -644,6 +647,13 @@ object ImgForm: TImgForm OnClick = Undo1Click end end + object ImportMenu: TMenuItem + Caption = 'Import' + object dcm2niiMenu: TMenuItem + Caption = 'Convert DICOM to NIfTI' + OnClick = dcm2niiMenuClick + end + end object OverlayMenu: TMenuItem Caption = '&Overlay' object OverlayOpen: TMenuItem @@ -1181,13 +1191,6 @@ object ImgForm: TImgForm OnClick = Header1Click end end - object ImportMenu: TMenuItem - Caption = 'Import' - object dcm2niiMenu: TMenuItem - Caption = 'Convert DICOM to NIfTI' - OnClick = dcm2niiMenuClick - end - end object Help1: TMenuItem Caption = '&Help' object Preferences1: TMenuItem diff --git a/nifti_img_view.pas b/nifti_img_view.pas index 19fa4f5..2323833 100755 --- a/nifti_img_view.pas +++ b/nifti_img_view.pas @@ -26,7 +26,7 @@ interface define_types, Spin, Buttons, nifti_hdr, nifti_hdr_view, nifti_img, voismooth, IniFiles, ReadInt, stat, Distr, bet, mni, prefs, CropEdges,nifti_types, draw_interpolate_slices, -userdir, graphx, GraphType, IntfGraphics, landmarks,fastsmooth, nii_label, dcm2nii, ImgList;//registry +userdir, graphx, GraphType, IntfGraphics, landmarks,fastsmooth, nii_label, dcm2nii, ImgList, Types;//registry type @@ -214,6 +214,8 @@ TImgForm = class(TForm) procedure dcm2niiMenuClick(Sender: TObject); procedure DilateVOI1Click(Sender: TObject); procedure Extract1Click(Sender: TObject); + procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure GetWidthForPPI(Sender: TCustomImageList; AImageWidth, APPI: Integer; var AResultWidth: Integer); procedure Interpolate1Click(Sender: TObject); @@ -259,6 +261,8 @@ procedure SaveasNIfTI1Click(Sender: TObject); procedure SaveDialog1Close(Sender: TObject); procedure ToolBar2Click(Sender: TObject); procedure ToolPanelClick(Sender: TObject); +procedure TriplePanelMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); procedure UpdateColorSchemes; procedure UpdateTemplates; procedure UpdateMRU; @@ -623,6 +627,7 @@ procedure TImgForm.WriteIniFile; lIniFile.WriteString('STR', 'FSLOUTPUTTYPE',gBGImg.FSLOUTPUTTYPE); //Booleans lIniFile.WriteString('BOOL', 'LoadUInt16asFloat32',Bool2Char(gBGImg.LoadUInt16asFloat32)); + lIniFile.WriteString('BOOL', 'DarkMode',Bool2Char(gBGImg.DarkMode)); lIniFile.WriteString('BOOL', 'Reslice',Bool2Char(gBGImg.ResliceOnLoad)); lIniFile.WriteString('BOOL', 'ResliceOrtho',Bool2Char(gBGImg.OrthoReslice)); lIniFile.WriteString('BOOL', 'ShowDraw',Bool2Char(gBGImg.ShowDraw)); @@ -757,7 +762,7 @@ procedure TImgForm.ReadIniFile; //gBGImg.FSLBETEXE := lIniFile.ReadString('STR', 'FSLBETEXE', gBGImg.FSLBETEXE); gBGImg.FSLBASE := lIniFile.ReadString('STR', 'FSLBASE', gBGImg.FSLBASE); gBGImg.LoadUInt16asFloat32 := IniBool(lIniFile,'LoadUInt16asFloat32', gBGImg.LoadUInt16asFloat32); - + gBGImg.DarkMode := IniBool(lIniFile,'DarkMode',gBGImg.DarkMode); gBGImg.ResliceOnLoad := IniBool(lIniFile,'Reslice',gBGImg.ResliceOnLoad); gBGImg.OrthoReslice := IniBool(lIniFile,'ResliceOrtho',gBGImg.OrthoReslice); gBGImg.ThinPen := IniBool(lIniFile, 'ThinPen',True); @@ -1289,6 +1294,12 @@ procedure TImgForm.ToolPanelClick(Sender: TObject); end; +procedure TImgForm.TriplePanelMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +begin + //LabelX.caption := inttostr(random(888)); +end; + procedure Add2MRU (var lNewFilename: string); //add new file to most-recent list var @@ -1468,7 +1479,7 @@ function TImgForm.OpenAndDisplayImg(var lFilename: string; lAdd2MRU: boolean): b Result := false; {$IFDEF DICOMdrop} if not IsNIfTIHdrExt(lFilename) then begin - x := dcm2niiForm.FindDicom2niixPath(''); + x := dcm2niiForm.getCustomDcm2niix(); if fileexists(x) then begin lFilename := dcm2Nifti(x, lFilename); if fileexists(lFilename) and (lFilename <> x) then @@ -1569,6 +1580,9 @@ procedure TImgForm.DisplayHdrClick(Sender: TObject); lLayer:integer; begin lLayer := ActiveLayer; + {$IFDEF LCLCocoa} + setThemeMode(HdrForm, gBGImg.DarkMode); + {$ENDIF} HdrForm.SaveHdrDlg.Filename := gMRIcroOverlay[lLayer].HdrFilename; HdrForm.WriteHdrForm (gMRIcroOverlay[lLayer]); //HdrForm.ShowModal; @@ -1830,7 +1844,7 @@ procedure TImgForm.FormCreate(Sender: TObject); SetBGImgDefaults(gBGImg); CloseImagesClick(nil); gColorSchemeDir := extractfilepath(paramstr(0))+'Resources'+pathdelim+'lut'; - if not fileexists(gColorSchemeDir) then + if not direxists(gColorSchemeDir) then gColorSchemeDir := extractfilepath(paramstr(0))+'lut'; {$IFDEF Darwin} if not fileexists(gColorSchemeDir) then @@ -1856,7 +1870,7 @@ procedure TImgForm.FormCreate(Sender: TObject); {$ENDIF} {$ENDIF} gTemplateDir := extractfilepath(paramstr(0))+'Resources'+pathdelim+'templates'; - if not fileexists(gTemplateDir) then + if not direxists(gTemplateDir) then gTemplateDir := extractfilepath(paramstr(0))+'templates'; {$IFDEF Darwin} if not fileexists(gTemplateDir) then @@ -3538,6 +3552,12 @@ procedure TImgForm.Extract1Click(Sender: TObject); end; end; +procedure TImgForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +begin + //LabelX.caption := inttostr(random(888)); +end; + procedure TImgForm.GetWidthForPPI(Sender: TCustomImageList; AImageWidth, APPI: Integer; var AResultWidth: Integer); begin @@ -5042,29 +5062,9 @@ function delimStr(s, default: string; idx: integer): string; strs.Free; end; -procedure CheckForUpdatesDcm2niix; -const - kBase = '/rordenlab/dcm2niix/releases/latest'; - kUrl = 'https://github.com' + kBase; - kApi = 'https://api.github.com/repos' + kBase; -var - exe, cmd, line1, localVer: string; -begin - exe := dcm2niiForm.getExeName; - if not fileexists(exe) then begin - showmessage('Unable to find dcm2niix installed '+ exe); - exit; - end; - cmd := '"'+exe +'" -h'; - dcm2niiForm.RunCmd(cmd, false, line1); - localVer := delimStr(line1, line1, 5); - ReportGitVer(localVer, kApi, kUrl, exe); -end; - procedure TImgForm.CheckForUpdates(Sender: TObject); begin CheckForUpdatesMRIcron; - CheckForUpdatesDcm2niix; end; {$ELSE} procedure TImgForm.CheckForUpdates(Sender: TObject); @@ -5079,7 +5079,6 @@ procedure TImgForm.SetDarkMode; begin //setThemeMode(Self.Handle, gBGImg.DarkMode); setThemeMode(Self, gBGImg.DarkMode); - end; {$ENDIF} diff --git a/nii_label.pas b/nii_label.pas index 2dfe114..86fda1d 100755 --- a/nii_label.pas +++ b/nii_label.pas @@ -40,8 +40,10 @@ procedure LoadLabelsCore(lInStr: string; var lLabels: TStrRA); repeat lCh := lInStr[lPos]; inc(lPos); if (lCh >= '0') and (lCh <= '9') then - lStr1 := lStr1 + lCh; - until (lPos > lLength) or (lCh=kCR) or (lCh=UNIXeoln) or (((lCh=kTab)or (lCh=' ')) and (length(lStr1)>0)); + lStr1 := lStr1 + lCh + else + lCh := kTab; + until (lPos > lLength) or ((lCh=kTab) and (length(lStr1)>0)); if (length(lStr1) > 0) and (lPos <= lLength) then begin lIndex := strtoint(lStr1); if lPass = 1 then begin diff --git a/nsappkitext_old.pas b/nsappkitext_old.pas deleted file mode 100644 index 9dc4612..0000000 --- a/nsappkitext_old.pas +++ /dev/null @@ -1,97 +0,0 @@ -unit nsappkitext; - -{$mode objfpc}{$H+} -{$modeswitch objectivec2} - -interface - -uses - CocoaAll, LCLType; - -type - NSAppearance = objcclass external (NSObject, NSCodingProtocol) - private - _name : NSString; - _bundle : NSBundle; - _private : Pointer; - _reserved : id; - _auxilary : id; - {$ifdef CPU32} - _extra : array [0..1] of id; - {$endif} - - public - procedure encodeWithCoder(aCoder: NSCoder); message 'encodeWithCoder:'; - function initWithCoder(aDecoder: NSCoder): id; message 'initWithCoder:'; - - function name: NSString; message 'name'; - - // Setting and identifying the current appearance in the thread. - class function currentAppearance: NSAppearance; message 'currentAppearance'; - // nil is valid and indicates the default appearance. - class procedure setCurrentAppearance(appearance: NSAppearance); message 'setCurrentAppearance:'; - - // Finds and returns an NSAppearance based on the name. - // For standard appearances such as NSAppearanceNameAqua, a built-in appearance is returned. - // For other names, the main bundle is searched. - class function appearanceNamed(aname: NSString): NSAppearance; message 'appearanceNamed:'; - - {/* Creates an NSAppearance by searching the specified bundle for a file with the specified name (without path extension). - If bundle is nil, the main bundle is assumed. - */ - #if NS_APPEARANCE_DECLARES_DESIGNATED_INITIALIZERS - - (nullable instancetype)initWithAppearanceNamed:(NSString *)name bundle:(nullable NSBundle *)bundle NS_DESIGNATED_INITIALIZER; - - (nullable instancetype)initWithCoder:(NSCoder *)aDecoder NS_DESIGNATED_INITIALIZER; - #endif} - - // Query allowsVibrancy to see if the given appearance actually needs vibrant drawing. - // You may want to draw differently if the current apperance is vibrant. - function allowsVibrancy: Boolean; message 'allowsVibrancy'; - end; - procedure setThemeMode(FormHandle: HWND; isDarkMode: boolean); - - -var - NSAppearanceNameAqua: NSString; cvar; external; - // Light content should use the default Aqua apppearance. - NSAppearanceNameLightContent: NSString; cvar; external; // deprecated - - // The following two Vibrant appearances should only be set on an NSVisualEffectView, or one of its container subviews. - NSAppearanceNameVibrantDark : NSString; cvar; external; - NSAppearanceNameVibrantLight: NSString; cvar; external; - -type - //it's actually a protocol! - NSAppearanceCustomization = objccategory external (NSObject) - procedure setAppearance(aappearance: NSAppearance); message 'setAppearance:'; - function appearance: NSAppearance; message 'appearance'; - - // This returns the appearance that would be used when drawing the receiver, taking inherited appearances into account. - // - function effectiveAppearance: NSAppearance; message 'effectiveAppearance'; - end; - - -implementation - -procedure setThemeMode(FormHandle: HWND; isDarkMode: boolean); -var - theWindow : CocoaAll.NSWindow; -begin - theWindow := NSView(FormHandle).window; - if isDarkMode then - theWindow.setAppearance (NSAppearance.appearanceNamed(NSAppearanceNameVibrantDark)) - else - theWindow.setAppearance (NSAppearance.appearanceNamed(NSAppearanceNameAqua)); - theWindow.invalidateShadow; - //window.invalidateShadow() - -end; - -(*{$IFDEF LCLCocoa} -{$mode objfpc}{$H+} -{$modeswitch objectivec2} -{$ENDIF} *) - -end. - diff --git a/prefs.pas b/prefs.pas index 8b43b67..0b20bc4 100755 --- a/prefs.pas +++ b/prefs.pas @@ -5,10 +5,11 @@ interface uses +{$IFDEF LCLCocoa}nsappkitext, {$ENDIF} {$IFDEF Windows} ShellAPI, Windows, {$ENDIF} //x18 userdir, Process, FileUtil, Clipbrd, Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, - Spin, Buttons, nsappkitext; + Spin, Buttons; type diff --git a/render.pas b/render.pas index 33ac6d7..4fa27d4 100755 --- a/render.pas +++ b/render.pas @@ -837,14 +837,14 @@ procedure TRenderForm.FormCreate(Sender: TObject); Save1.ShortCut := ShortCut(Word('S'), [ssMeta]); Close1.ShortCut := ShortCut(Word('W'), [ssMeta]); {$ENDIF} - gRenderDir := DefaultsDir('render'); + gRenderDir := extractfilepath(paramstr(0))+'Resources'+pathdelim+'render'; {$IFDEF Darwin} - if not fileexists(gRenderDir) then + if not direxists(gRenderDir) then gRenderDir := AppDir + 'render'; {$ENDIF} //showmessage(gRenderDir); //gRenderDir := extractfiledir(paramstr(0))+pathdelim+'render'+pathdelim; - gRenderDefaultsFilename := gRenderDir + 'default.ini'; + gRenderDefaultsFilename := gRenderDir +pathdelim+ 'default.ini'; gRenderStartupFilename := gRenderDefaultsFilename; RenderForm.DoubleBuffered := true; end;