Skip to content

Commit

Permalink
#26 #27
Browse files Browse the repository at this point in the history
  • Loading branch information
@neurolabusc
neurolabusc committed Jun 1, 2018
1 parent 01a6ad6 commit 6ddc151
Show file tree
Hide file tree
Showing 8 changed files with 176 additions and 117 deletions.
15 changes: 11 additions & 4 deletions commandsu.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ function VERSION(): string;
function EXISTS(lFilename: string): boolean; //function
function OVERLAYLOAD(lFilename: string): integer; //function
function OVERLAYLOADVOL(lFilename: string; lVol: integer): integer; //function
procedure SAVENIIXYZ(lFilename: string; lFilter: integer; lScaleX, lScaleY, lScaleZ: single);
procedure SAVENII(lFilename: string; lFilter: integer; lScale: single);
function OVERLAYLOADCLUSTER(lFilename: string; lThreshold, lClusterMM3: single; lSaveToDisk: boolean): integer; //function
procedure ADDNODE(INTENSITY, R,G,B,A: byte);
Expand Down Expand Up @@ -117,7 +118,7 @@ procedure QUIT;
(Ptr:@OVERLAYLOAD;Decl:'OVERLAYLOAD';Vars:'(lFilename: string): integer'),
(Ptr:@OVERLAYLOADCLUSTER;Decl:'OVERLAYLOADCLUSTER';Vars:'(lFilename: string; lThreshold, lClusterMM3: single; lSaveToDisk: boolean): integer'),
(Ptr:@OVERLAYLOADVOL;Decl:'OVERLAYLOADVOL';Vars:'(lFilename: string; lVol: integer): integer'));
knProc = 87;
knProc = 88;
kProcRA : array [1..knProc] of TScriptRec =
(
(Ptr:@AZIMUTH;Decl:'AZIMUTH';Vars:'(DEG: integer)'),
Expand Down Expand Up @@ -184,6 +185,7 @@ procedure QUIT;
(Ptr:@SAVEBMP;Decl:'SAVEBMP';Vars:'(lFilename: string)'),
(Ptr:@SAVEBMPXY;Decl:'SAVEBMPXY';Vars:'(lFilename: string; X,Y: integer)'),
(Ptr:@SAVENII;Decl:'SAVENII';Vars:'(lFilename: string; lFilter: integer; lScale: Single)'),
(Ptr:@SAVENIIXYZ;Decl:'SAVENIIXYZ';Vars:'(lFilename: string; lFilter: integer; lScaleX, lScaleY, lScaleZ: Single)'),
(Ptr:@SCRIPTFORMVISIBLE;Decl:'SCRIPTFORMVISIBLE';Vars:'(VISIBLE: boolean)'),
(Ptr:@SETCOLORTABLE;Decl:'SETCOLORTABLE';Vars:'(TABLENUM: integer)'),
(Ptr:@SHADERFORMVISIBLE;Decl:'SHADERFORMVISIBLE';Vars:'(VISIBLE: boolean)'),
Expand Down Expand Up @@ -1090,7 +1092,7 @@ procedure VIDEOEND;
ScriptForm.Memo2.Lines.Add('saveniiiso failed: maybe your image is already isotropic.');
end; *)

procedure SAVENII(lFilename: string; lFilter: integer; lScale: single);
procedure SAVENIIXYZ(lFilename: string; lFilter: integer; lScaleX, lScaleY, lScaleZ: single);
var
lF, lExt: string;
ret: boolean;
Expand All @@ -1102,15 +1104,20 @@ procedure SAVENII(lFilename: string; lFilter: integer; lScale: single);
if (lExt <> '.NII') and (lExt <> '.NII.GZ') then
lF := lF + '.nii';
EnsureDirExists(lF);
ret := SaveImgScaled (lF, lFilter,lScale);
ret := SaveImgScaled (lF, lFilter,lScaleX, lScaleY, lScaleZ);
if not ret then begin
if lScale <= 0 then
if lScaleX <= 0 then
ScriptForm.Memo2.Lines.Add('savenii failed: maybe your image is already isotropic.')
else
ScriptForm.Memo2.Lines.Add('savenii failed.')
end;
end;

procedure SAVENII(lFilename: string; lFilter: integer; lScale: single);
begin
SAVENIIXYZ(lFilename, lFilter, lScale, lScale, lScale);
end;

procedure SAVEBMP(lFilename: string);
var
lF,lExt: string;
Expand Down
15 changes: 10 additions & 5 deletions mainunit.lfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1383,7 +1383,7 @@ object GLForm1: TGLForm1
Caption = 'Edit'
object Copy1: TMenuItem
Caption = 'Copy'
ShortCut = 16384
ShortCut = 16451
OnClick = Copy1Click
end
end
Expand Down Expand Up @@ -1651,6 +1651,7 @@ object GLForm1: TGLForm1
Caption = 'Erase'
GroupIndex = 189
RadioItem = True
ShortCut = 16453
OnClick = DrawTool1Click
end
end
Expand Down Expand Up @@ -1679,7 +1680,8 @@ object GLForm1: TGLForm1
OnClick = AutoRoi1Click
end
object voiBinarize1: TMenuItem
Caption = 'Binarize'
Caption = 'Binarize (make entire drawing red)'
Hint = 'Make entire drawing red'
OnClick = voiBinarize1Click
end
object InterpolateDrawMenu: TMenuItem
Expand Down Expand Up @@ -1737,7 +1739,6 @@ object GLForm1: TGLForm1
Caption = 'Coronal'
GroupIndex = 212
RadioItem = True
ShortCut = 16451
OnClick = SetViewClick
end
object Sagittal1: TMenuItem
Expand All @@ -1752,7 +1753,7 @@ object GLForm1: TGLForm1
object MPR1: TMenuItem
Tag = 4
AutoCheck = True
Caption = 'Multi Planar (A+C+S)'
Caption = 'Multi planar (A+C+S)'
GroupIndex = 212
RadioItem = True
ShortCut = 16461
Expand Down Expand Up @@ -1817,7 +1818,7 @@ object GLForm1: TGLForm1
end
object RadiologicalMenu: TMenuItem
AutoCheck = True
Caption = 'Radiological (Flip LR)'
Caption = 'Radiological (flip LR)'
OnClick = RadiologicalMenuClick
end
end
Expand Down Expand Up @@ -1925,6 +1926,10 @@ object GLForm1: TGLForm1
Caption = 'Preferences'
OnClick = Preferences1Click
end
object OnlineHelpMenu: TMenuItem
Caption = 'Online help'
OnClick = OnlineHelpMenuClick
end
end
end
object OpenDialog1: TOpenDialog
Expand Down
41 changes: 28 additions & 13 deletions mainunit.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,7 @@ TGLForm1 = class(TForm)
CoordLabel: TLabel;
LeftBtn: TButton;
AnteriorBtn: TButton;
OnlineHelpMenu: TMenuItem;
XCoordEdit: TEdit;
ResetDefaults1: TMenuItem;
PosteriorBtn: TButton;
Expand Down Expand Up @@ -275,6 +276,7 @@ TGLForm1 = class(TForm)
procedure LineColorBtnClick(Sender: TObject);
procedure LineWidthEditChange(Sender: TObject);
procedure CoordEditChange(Sender: TObject);
procedure OnlineHelpMenuClick(Sender: TObject);
procedure MosaicTextChange(Sender: TObject);
function OpenVOI(lFilename: string): boolean;
procedure BackgroundMaskMenuClick(Sender: TObject);
Expand Down Expand Up @@ -2276,10 +2278,13 @@ procedure TGLForm1.FormCreate(Sender: TObject);
{$IFDEF Darwin} //only for Carbon compile
// OnDropFiles := DropFiles;
//GLBox.DoubleBuffered:= false; // DoubleBuffered
Help1.visible := false;
// Help1.visible := false;
About1.visible := false;
Preferences1.visible := false;
//Edit1.visible := false;
NewWindow1.Visible:= true;
Exit1.visible := false;//with OSX users quit from application menu
Copy1.ShortCut:= ShortCut(Word('C'), [ssMeta]); ;
Open1.ShortCut := ShortCut(Word('O'), [ssMeta]);
Overlays1.ShortCut := ShortCut(Word('O'), [ssShift, ssMeta]);
Tool1.ShortCut := ShortCut(Word('T'), [ssMeta]);
Expand All @@ -2290,22 +2295,24 @@ procedure TGLForm1.FormCreate(Sender: TObject);
//SaveVOI1.ShortCut := ShortCut(Word('S'), [ssMeta]);
HideVOI1.ShortCut := ShortCut(Word('H'), [ssMeta]);
PasteSlice1.ShortCut := ShortCut(Word('V'), [ssMeta]);
UndoVOI1.ShortCut := ShortCut(Word('Z'), [ssMeta]);
//UndoVOI1.ShortCut := ShortCut(Word('Z'), [ssMeta]);
UndoVOI1.ShortCut := ShortCut(Word('U'), [ssMeta]);
Eraser1.ShortCut := ShortCut(Word('E'), [ssMeta]);
NoDraw1.ShortCut := ShortCut(Word('D'), [ssMeta]);
Render1.ShortCut := ShortCut(Word('R'), [ssMeta]);
YokeMenu.ShortCut := ShortCut(Word('Y'), [ssMeta]);
//in Cocoa: non-active menu intercepts keystrokes, so user typing in script form can not type "A" if that is used by main forms Axial menu

(*Render1.ShortCut := ShortCut(Word('R'), [ssMeta]);
Axial1.ShortCut := ShortCut(Word('A'), [ssMeta]);
Coronal1.ShortCut := ShortCut(Word('C'), [ssMeta]);
Sagittal1.ShortCut := ShortCut(Word('S'), [ssMeta]);
MPR1.ShortCut := ShortCut(Word('M'), [ssMeta]);
YokeMenu.ShortCut := ShortCut(Word('Y'), [ssMeta]);
//in Cocoa: non-active menu intercepts keystrokes, so user typing in script form can not type "A" if that is used by main forms Axial menu
LeftMenu.ShortCut := ShortCut(Word('L'), [ssCtrl]);
RightMenu.ShortCut := ShortCut(Word('R'), [ssCtrl]);
AnteriorMenu.ShortCut := ShortCut(Word('A'), [ssCtrl]);
PosteriorMenu.ShortCut := ShortCut(Word('P'), [ssCtrl]);
SuperiorMenu.ShortCut := ShortCut(Word('S'), [ssCtrl]);
InferiorMenu.ShortCut := ShortCut(Word('I'), [ssCtrl]);
InferiorMenu.ShortCut := ShortCut(Word('I'), [ssCtrl]);*)
{$ELSE}
LeftMenu.ShortCut := ShortCut(Word('L'), [ssAlt]);
RightMenu.ShortCut := ShortCut(Word('R'), [ssAlt]);
Expand Down Expand Up @@ -3613,15 +3620,15 @@ procedure TGLForm1.Scripting1Click(Sender: TObject);
result := lmin;
if result > lmax then
end;*)
function GetFloat(prompt: string; min,def,max: extended): extended;
function GetFloat(prompt: string; min,def,max: double): double;
var
PrefForm: TForm;
OkBtn: TButton;
promptLabel: TLabel;
valEdit: TEdit;
begin
PrefForm:=TForm.Create(nil);
PrefForm.SetBounds(100, 100, 640, 112);
PrefForm.SetBounds(100, 100, 512, 112);
PrefForm.Caption:='Value required';
PrefForm.Position := poScreenCenter;
PrefForm.BorderStyle := bsDialog;
Expand Down Expand Up @@ -3653,7 +3660,7 @@ function GetFloat(prompt: string; min,def,max: extended): extended;
if gPrefs.DarkMode then GLForm1.SetFormDarkMode(PrefForm);
{$ENDIF}
PrefForm.ShowModal;
result := def;
result := NaN;
if (PrefForm.ModalResult = mrOK) then begin
result := StrToFloatDef(valEdit.Caption, def);
if (min < max) and (result < min) then
Expand All @@ -3666,10 +3673,11 @@ function GetFloat(prompt: string; min,def,max: extended): extended;

procedure TGLForm1.BET1Click(Sender: TObject);
var
lFrac: single;
lFrac: double;
lB: string;
begin
lFrac := GetFloat('Brain extraction fraction (smaller values lead to larger brain volume)',0.1,0.45,0.9);
if specialdouble(lFrac) then exit;
if not OpenDialog1.Execute then
exit;
lB := FSLbet(OpenDialog1.FileName,lFrac);
Expand Down Expand Up @@ -3753,6 +3761,7 @@ procedure TGLForm1.Extract1Click(Sender: TObject);
setThemeMode(ExtractForm.Handle, gPrefs.DarkMode);
{$ENDIF}
ExtractForm.ShowModal;
if ExtractForm.ModalResult <> mrOK then exit;
ExtractTexture (gTexture3D, ExtractForm.OtsuLevelsEdit.value, ExtractForm.DilateEdit.value, ExtractForm.OneContiguousObjectCheck.checked);
M_refresh := true;
UpdateTimer.Enabled := true;
Expand Down Expand Up @@ -3869,6 +3878,7 @@ procedure ReportGitVer(localVer, api, url, exe: string);
gitVer, exeNam: string;
git, local: integer;
begin
exeNam := ExtractFileName(exe);
if length(localVer) < 8 then begin //last 8 digits are date: v.1.0.20170101
MessageDlg(exeNam,'Unable to detect version: '+exe, mtConfirmation,[mbOK],0) ;
//showmessage('Unable to detect latest version: '+exe);
Expand All @@ -3880,7 +3890,7 @@ procedure ReportGitVer(localVer, api, url, exe: string);
showmessage('Unable to detect latest version: are you connected to the web and do you have libssl installed? '+api);
exit;
end;
exeNam := ExtractFileName(exe);

if CompareText(gitVer, localVer) = 0 then begin
//showmessage('You are running the latest release '+localVer);
MessageDlg(exeNam,'You are running the latest release '+localVer, mtConfirmation,[mbOK],0) ;
Expand Down Expand Up @@ -4068,13 +4078,13 @@ procedure PrefMenuClick;
{$ENDIF}
//UpdateBtn
{$IFDEF UNIX}
UpdateBtn:=TButton.create(PrefForm);
(*UpdateBtn:=TButton.create(PrefForm);
UpdateBtn.Caption:='Check for updates';
UpdateBtn.Left := 28;
UpdateBtn.Width:= 168;
UpdateBtn.Top := 198;
UpdateBtn.Parent:=PrefForm;
UpdateBtn.OnClick:= GLForm1.CheckForUpdates;
UpdateBtn.OnClick:= GLForm1.CheckForUpdates;*)
{$ENDIF}
//UpdateBtn.ModalResult:= mrOK;

Expand Down Expand Up @@ -4563,6 +4573,11 @@ procedure TGLForm1.CoordEditChange(Sender: TObject);

end;

procedure TGLForm1.OnlineHelpMenuClick(Sender: TObject);
begin
OpenURL('https://www.nitrc.org/plugins/mwiki/index.php/mricrogl:MainPage');
end;

procedure TGLForm1.MosaicTextChange(Sender: TObject);
begin
GLForm1.DrawMosaic(MosaicText.Text); //2018
Expand Down
29 changes: 18 additions & 11 deletions reorient.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,8 @@ interface
//function ReorientNIfTI(lFilename: string; lPrefs: TPrefs): string; //returns output filename if successful
function ReorientCore(var lHdr: TNIFTIhdr; lBufferIn: bytep): boolean;
procedure ShrinkLarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lMaxDim: integer);
procedure ShrinkOrEnlarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: integer; lScale: single);
procedure ShrinkOrEnlarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: integer; lScale: single); overload;
procedure ShrinkOrEnlarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: integer; lScaleX, lScaleY, lScaleZ : single); overload;
function EnlargeIsotropic(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: integer): boolean;
implementation
uses mainunit;
Expand Down Expand Up @@ -891,16 +892,17 @@ function EnlargeIsotropic(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: inte
result := true;
end;

procedure ShrinkOrEnlarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: integer; lScale: single);
procedure ShrinkOrEnlarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: integer; lScaleX, lScaleY, lScaleZ: single); overload;
var
fwidth: single;
fwidth, z: single;
filter: TFilterProc;
begin
if lScale <= 0.0 then exit;
if lScale = 1.0 then exit; //no resize
if ((lFilter < 0) or (lFilter > 6)) and (lScale < 1) then
if (lScaleX <= 0.0) or (lScaleY <= 0.0) or (lScaleZ <= 0.0) then exit;
if (lScaleX = 1.0) and (lScaleY = 1.0) and (lScaleZ = 1.0) then exit; //no resize
z := lScaleX * lScaleY * lScaleZ;
if ((lFilter < 0) or (lFilter > 6)) and (z < 1) then
lFilter := 5; //Lanczos nice for downsampling
if ((lFilter < 0) or (lFilter > 6)) and (lScale > 1) then
if ((lFilter < 0) or (lFilter > 6)) and (z > 1) then
lFilter := 6; //Mitchell nice for upsampling
if lFilter = 0 then begin
filter := @BoxFilter; fwidth := 0.5;
Expand All @@ -918,13 +920,18 @@ procedure ShrinkOrEnlarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: inte
filter := @MitchellFilter; fwidth := 2;
end;
if lHdr.datatype = kDT_UNSIGNED_CHAR then
Resize8(lHdr, lBuffer, lScale, lScale, lScale, fwidth, @filter)
Resize8(lHdr, lBuffer, lScaleX, lScaleY, lScaleZ, fwidth, @filter)
else if lHdr.datatype = kDT_SIGNED_SHORT then
Resize16(lHdr, lBuffer, lScale, lScale, lScale, fwidth, @filter)
Resize16(lHdr, lBuffer, lScaleX, lScaleY, lScaleZ, fwidth, @filter)
else if lHdr.datatype = kDT_FLOAT then
Resize32(lHdr, lBuffer, lScale, lScale, lScale, fwidth, @filter)
Resize32(lHdr, lBuffer, lScaleX, lScaleY, lScaleZ, fwidth, @filter)
else if lHdr.datatype = kDT_RGB then
Resize24(lHdr, lBuffer, lScale, lScale, lScale, fwidth, @filter);
Resize24(lHdr, lBuffer, lScaleX, lScaleY, lScaleZ, fwidth, @filter);
end;

procedure ShrinkOrEnlarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lFilter: integer; lScale: single); overload;
begin
ShrinkOrEnlarge(lHdr, lBuffer, lFilter, lScale, lScale, lScale);
end;

procedure ShrinkLarge(var lHdr: TNIFTIhdr; var lBuffer: bytep; lMaxDim: integer);
Expand Down
10 changes: 5 additions & 5 deletions savethreshold.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,7 @@ interface

//function SaveImg (lOutname: string; var lHdrx: TMRIcroHdr): boolean;
function SaveImg (lOutname: string; var lHdr: TNIFTIhdr; lImg: Bytep): boolean;
function SaveImgScaled (lOutname: string; lFilter: integer; lScale: single): boolean;
function SaveImgScaled (lOutname: string; lFilter: integer; lScaleX, lScaleY, lScaleZ: single): boolean;
//function SaveImgIso (lOutname: string; lFilter: integer): boolean;
function SaveThresholdedUI(lThresh, lClusterMM3: single; lSaveToDisk: boolean): boolean;
function SaveThresholded(lInname: string; lThresh, lClusterMM3: single; lSaveToDisk: boolean): integer;
Expand Down Expand Up @@ -206,7 +206,7 @@ function numVox(h: TNIFTIHdr): int64;
result := outbytes;
end;

function SaveImgScaled (lOutname: string; lFilter: integer; lScale: single): boolean;
function SaveImgScaled (lOutname: string; lFilter: integer; lScaleX, lScaleY, lScaleZ: single): boolean;
var
i, bpp, nVox : int64;
lOutnameGz : string;
Expand All @@ -223,7 +223,7 @@ function SaveImgScaled (lOutname: string; lFilter: integer; lScale: single): boo
end;
nVox := numVox(gTexture3D.NIFTIhdr);
h := gTexture3D.NIFTIhdr;
if (lScale <= 0) and (h.pixdim[1] = h.pixdim[2]) and (h.pixdim[1] = h.pixdim[3]) then
if (lScaleX <= 0) and (lScaleY <= 0) and (lScaleZ <= 0) and (h.pixdim[1] = h.pixdim[2]) and (h.pixdim[1] = h.pixdim[3]) then
exit; //already isotropic
if gTexture3D.RawUnscaledImg32 <> nil then begin
lImg := bytep(gTexture3D.RawUnscaledImg32);
Expand Down Expand Up @@ -264,10 +264,10 @@ function SaveImgScaled (lOutname: string; lFilter: integer; lScale: single): boo
Rewrite(lF,1);
GetMem(lImgX,nVox * bpp);
System.Move(lImg^,lImgX^,nVox * bpp);
if lScale <= 0 then
if (lScaleX <= 0) and (lScaleY <= 0) and (lScaleZ <= 0) then
EnlargeIsotropic(h, lImgX, lFilter)
else
ShrinkOrEnlarge(h, lImgX, lFilter, lScale);
ShrinkOrEnlarge(h, lImgX, lFilter, lScaleX, lScaleY, lScaleZ);
nVox := numVox(h);
//outbytes := nVox * bpp;
BlockWrite(lF,h,sizeof(TNIFTIHdr) );
Expand Down
12 changes: 6 additions & 6 deletions scriptengine.lfm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -604,12 +604,12 @@ object ScriptForm: TScriptForm
Hint = 'quit () Terminates the program. Use with caution. This allows external programs to launch this software and quit once they are done.'
OnClick = InsertCommand
end
object savebmp1: TMenuItem
Tag = 4
Caption = 'savebmp'
Hint = 'savebmp (filename: string) Saves the currently viewed image as a PNG format compressed bitmap image.'
OnClick = InsertCommand
end
object savebmp1: TMenuItem
Tag = 4
Caption = 'savebmp'
Hint = 'savebmp (filename: string) Saves the currently viewed image as a PNG format compressed bitmap image.'
OnClick = InsertCommand
end
object savebmpxy1: TMenuItem
Tag = 1422
Caption = 'savebmpxy'
Expand Down
Loading

0 comments on commit 6ddc151

Please sign in to comment.