← Back to branch summary

~ubuntu-branches/ubuntu/raring/mricron/raring

« back to all changes in this revision

Viewing changes to .pc/debian_fslbet/bet.pas

  • Committer: Bazaar Package Importer
  • Author(s): Michael Hanke
  • Date: 2011-02-02 16:18:59 UTC
  • Revision ID: james.westby@ubuntu.com-20110202161859-y916059cgwpgq0i2
Tags: 0.20101102.1~dfsg.1-2
http://bugs.debian.org/611374
* Change maintainer email.
* Add 'fsl' as a suggested package.
* Add patch to make mricron work with Debian's FSL setup (to call BET for
  skull-stripping). Also call mricron via a wrapper that automatically
  sources the FSL configuration file on startup. Closes: #611374

Show diffs side-by-side

added added

removed removed

Lines of Context:
.pc/debian_fslbet/bet.pas
 
1
unit bet;
 
2
 
 
3
{$H+}
 
4
 
 
5
interface
 
6
 
 
7
uses
 
8
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
 
9
  ExtCtrls, Buttons, Spin,Process,nifti_img,define_types,CropEdges, userdir;
 
10
 
 
11
type
 
12
  { TBETForm }
 
13
  TBETForm = class(TForm)
 
14
    Memo1: TMemo;
 
15
    SmoothnessEdit: TFloatSpinEdit;
 
16
    Panel1: TPanel;
 
17
    GoBtn: TSpeedButton;
 
18
    AboutBtn: TSpeedButton;
 
19
    CropBtn: TSpeedButton;
 
20
    procedure CropBtnClick(Sender: TObject);
 
21
    procedure GoBtnClick(Sender: TObject);
 
22
    procedure SpeedButton2Click(Sender: TObject);
 
23
  private
 
24
    { private declarations }
 
25
  public
 
26
    { public declarations }
 
27
  end; 
 
28
 
 
29
var
 
30
  BETForm: TBETForm;
 
31
 
 
32
implementation
 
33
uses
 
34
 nifti_img_view;
 
35
{ TBETForm }
 
36
 
 
37
procedure TBETForm.SpeedButton2Click(Sender: TObject);
 
38
begin
 
39
    Showmessage('You can skull strip scans to allow you to render the surface of the brain.'+chr (13)
 
40
+ 'This uses Steve Smith''s Brain Extraction Tool [BET].'+chr (13)+
 
41
'Default smoothness is 0.50, smaller values generate larger estimates of brain size.'+chr (13)
 
42
+'http://www.fmrib.ox.ac.uk/fsl');
 
43
end;
 
44
 
 
45
//lCmd := extractfilepath(paramstr(0))+'bet "'+lSourceFilename+'" "'+SaveDialog1.Filename
 
46
// +'" -f '+floattostr(SmoothnessEdit.value{/100});
 
47
function PathExists (lCmd: string): boolean;
 
48
begin
 
49
     result := false;
 
50
     if FSize(lCmd) < 1 then begin
 
51
          BETForm.Memo1.Lines.Add('Unable to find executable named '+lCmd);
 
52
          exit;
 
53
     end;
 
54
     result := true;
 
55
end;
 
56
 
 
57
procedure RunCmd (lCmd: string);
 
58
 var
 
59
   AProcess: TProcess;
 
60
   AStringList: TStringList;
 
61
 begin
 
62
   AProcess := TProcess.Create(nil);
 
63
   AStringList := TStringList.Create;
 
64
   AProcess.CommandLine := lCmd;
 
65
   {$IFDEF UNIX}
 
66
      AProcess.Environment.Add(gBGImg.FSLDIR);
 
67
   AProcess.Environment.Add(gBGImg.FSLOUTPUTTYPE);
 
68
 
 
69
   //AProcess.Environment.Add('FSLDIR=/usr/local/fsl');
 
70
   //AProcess.Environment.Add('FSLOUTPUTTYPE=NIFTI_GZ');
 
71
   {$ENDIF}
 
72
   AProcess.Options := AProcess.Options + [poWaitOnExit, poStderrToOutPut, poUsePipes];
 
73
   AProcess.Execute;
 
74
   AStringList.LoadFromStream(AProcess.Output);
 
75
   BetForm.Memo1.Lines.AddStrings(AStringList);
 
76
   AStringList.Free;
 
77
   AProcess.Free;
 
78
 end;
 
79
 
 
80
 
 
81
function DoBET(lInFile,lOutFile: string; lFrac: single):boolean;
 
82
var
 
83
  //AProcess: TProcess;
 
84
  lCmd: string;
 
85
begin
 
86
     result := false;
 
87
     lCmd :=  extractfilepath(paramstr(0))+'bet';
 
88
     {$IFNDEF Unix}
 
89
     lCmd := lCmd+'.exe';
 
90
     {$ENDIF}
 
91
     if not PathExists (lCmd) then begin
 
92
        lCmd := '/usr/local/fsl/bin/bet_8UI';
 
93
        if not PathExists (lCmd) then begin
 
94
           lCmd := '/usr/local/fsl/bin/bet';
 
95
           if not PathExists (lCmd) then
 
96
                 exit;
 
97
        end;
 
98
     end; //no bet in home folder...
 
99
  lCmd := lCmd+' "'+lInFile+'" "'+lOutFile +'" -f '+floattostr(lFrac);
 
100
  BETForm.Memo1.Lines.Add(lCmd);
 
101
  RunCmd(lCmd);
 
102
  (*AProcess := TProcess.Create(nil);
 
103
  {$IFDEF UNIX}
 
104
  AProcess.Environment.Add('FSLDIR=/usr/local/fsl');
 
105
  AProcess.Environment.Add('FSLOUTPUTTYPE=NIFTI_GZ');
 
106
  {$ENDIF}
 
107
  AProcess.CommandLine := lCmd;
 
108
  //AProcess.CommandLine := 'C:\bet "C:\txx.hdr" "C:\btxx.hdr" -f 0.5';
 
109
  AProcess.Options := AProcess.Options + [poWaitOnExit];
 
110
  AProcess.Execute;
 
111
  AProcess.Free;  *)
 
112
  result := true;
 
113
end;
 
114
 
 
115
function Bright95Pct: byte;//returns intensity of 95th percentile
 
116
var
 
117
   lPos,l5Pct,lCumulative: integer;
 
118
   lHisto: array [0..255] of integer;
 
119
begin
 
120
     result := 0;
 
121
     if (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems<1) or (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems<>gMRIcroOverlay[kVOIOverlayNum].ScrnBufferItems) then exit;
 
122
     //next - create histogram of intensity
 
123
     for lPos := 0 to 255 do
 
124
         lHisto[lPos] := 0;
 
125
     for lPos := 1 to gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems do
 
126
         inc(lHisto[gMRIcroOverlay[kBGOverlayNum].ScrnBuffer^[lPos]]);
 
127
     //next find 95th percentile
 
128
     l5Pct := (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems div 20);
 
129
     lCumulative := 0;
 
130
     lPos := 256;
 
131
     while (lPos > 0) and (lCumulative < l5Pct) do begin
 
132
         dec(lPos);
 
133
         lCumulative := lCumulative + lHisto[lPos];
 
134
     end;
 
135
     result := lPos;
 
136
end;
 
137
 
 
138
procedure CropVOI (lVOIIntensity: byte);
 
139
var
 
140
   lPos: integer;
 
141
begin
 
142
     if (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems<1) or (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems<>gMRIcroOverlay[kVOIOverlayNum].ScrnBufferItems) then exit;
 
143
     for lPos := 1 to gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems do
 
144
         if gMRIcroOverlay[kVOIOverlayNum].ScrnBuffer^[lPos] = kVOI8bit then
 
145
            gMRIcroOverlay[kBGOverlayNum].ScrnBuffer^[lPos]  := lVOIIntensity;
 
146
end;
 
147
 
 
148
procedure DeleteHdrImg(lFilename: string);
 
149
begin
 
150
//exit;
 
151
     if lFilename = '' then
 
152
        exit;
 
153
     DeleteFile(lFilename);
 
154
     if (UpCaseExt(lFileName)='.IMG') then
 
155
            DeleteFile(changefileext(lFilename,'.hdr'));
 
156
     if (UpCaseExt(lFileName)='.HDR') then
 
157
        DeleteFile(changefileext(lFilename,'.img'));
 
158
end;
 
159
 
 
160
function Mask8BitImg(lImgName,lMaskName: string): boolean;
 
161
//should be two 8-bit image files of identical dimensions
 
162
//all non-zero voxels in the mask are written with value of img
 
163
//Warning - only works with .img files with zero voxoffset - can corrupt .nii files - would need to read header....
 
164
var
 
165
   lPos2,lPos,lC,lSz,lMaskSz,lBPP: integer;
 
166
   lImg,lMask: bytep;
 
167
   lInF: File;
 
168
begin
 
169
    result := false;
 
170
    lSz := FSize(lImgName);
 
171
    lMaskSz := FSize(lMaskName);
 
172
    if lSz = lMaskSz then
 
173
       lBPP := 1
 
174
    else if lSz = (2*lMaskSz) then
 
175
         lBPP := 2
 
176
    else if lSz = (2*lMaskSz) then
 
177
         lBPP := 4
 
178
    else
 
179
        lBPP := 0;
 
180
    if (lSz < 1) or (lBPP = 0 ) then
 
181
       exit;
 
182
    //next read mask
 
183
    GetMem(lMask,lSz);
 
184
    AssignFile(lInF, lMaskName);
 
185
    Reset(lInF,1);
 
186
    BlockRead(lInF, lMask^, lMaskSz);
 
187
    CloseFile(lInF);
 
188
    //next: read image
 
189
    GetMem(lImg,lSz);
 
190
    AssignFile(lInF, lImgName);
 
191
    Reset(lInF,1);
 
192
    BlockRead(lInF, lImg^, lSz);
 
193
    CloseFile(lInF);
 
194
    //next mask image
 
195
    for lPos := 1 to lMaskSz do
 
196
        if lMask^[lPos] = 0 then begin
 
197
           lPos2 := ((lPos-1)*lBPP);
 
198
           for lC := 1 to lBPP do
 
199
               lImg^[lC+lPos2] := 0;
 
200
        end;
 
201
    Freemem(lMask);
 
202
    //next save masked image
 
203
    AssignFile(lInF, lImgName);     //1/2008....
 
204
    //AssignFile(lInF, lMaskName);
 
205
    Rewrite(lInF,1);
 
206
    BlockWrite(lInF, lImg^, lSz);
 
207
    CloseFile(lInF);
 
208
    Freemem(lImg);
 
209
    result := true;
 
210
end;
 
211
 
 
212
(*function Mask8BitImg(lImgName,lMaskName: string): boolean;//should be two 8-bit image files of identical dimensions
 
213
//all non-zero voxels in the mask are written with value of img
 
214
//Note: the mask file is changed - not the image
 
215
var
 
216
   lPos,lSz: integer;
 
217
   lImg,lMask: bytep;
 
218
   lInF: File;
 
219
begin
 
220
    //showmessage( lMaskName+'xx'+lImgName);
 
221
    result := false;
 
222
    lSz := FSize(lImgName);
 
223
    if (lSz < 1) or (lSz <> FSize(lMaskName)) then
 
224
       exit;
 
225
    //fx(lSz,778899);
 
226
    //next read mask
 
227
    GetMem(lMask,lSz);
 
228
    AssignFile(lInF, lMaskName);
 
229
    Reset(lInF,1);
 
230
    BlockRead(lInF, lMask^, lSz);
 
231
    CloseFile(lInF);
 
232
    //next: read image
 
233
    GetMem(lImg,lSz);
 
234
    AssignFile(lInF, lImgName);
 
235
    Reset(lInF,1);
 
236
    BlockRead(lInF, lImg^, lSz);
 
237
    CloseFile(lInF);
 
238
    //next mask image
 
239
    for lPos := 1 to lSz do
 
240
        if lMask^[lPos] = 0 then
 
241
           lImg^[lPos] := 0;
 
242
    Freemem(lMask);
 
243
    //next save masked image
 
244
    AssignFile(lInF, lMaskName);
 
245
    Rewrite(lInF,1);
 
246
    BlockWrite(lInF, lImg^, lSz);
 
247
    CloseFile(lInF);
 
248
    Freemem(lImg);
 
249
    result := true;
 
250
end;*)
 
251
 
 
252
function DefaultsDirCmd: string;
 
253
//Lazarus for Unix does not seem to execute TProcess commands to ~/.. we need to write them to /Home/chris/..
 
254
var
 
255
   lLen,lP: integer;
 
256
   lStr: string;
 
257
begin
 
258
  {$IFDEF UNIX}
 
259
    lStr := extractfiledir(GetAppConfigFile(false));
 
260
    lLen := length(lStr);
 
261
    if lLen < 1 then exit;
 
262
    lP := lLen;
 
263
    while (lP > 0) and (lStr[lP] <> '.') do
 
264
          dec(lP);
 
265
    if lP > 1 then begin
 
266
       for lLen := 1 to (lP-1) do
 
267
           result := result + lStr[lLen];
 
268
    end;
 
269
   {$ELSE} //else ... assume windows
 
270
    result := DefaultsDir('')
 
271
   {$ENDIF}
 
272
    //showmessage('x'+result+'x');
 
273
end;
 
274
 
 
275
procedure TBETForm.GoBtnClick(Sender: TObject);
 
276
label
 
277
666;
 
278
var
 
279
   lTempNameOrig,lTempName8bitMask,lTempBetName,lTempGZName: string;
 
280
begin
 
281
  Memo1.Clear;
 
282
    Memo1.lines.add('Startup Timestamp: '+DateTimeToStr(Now));
 
283
    if (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems < 1)  then begin
 
284
        showmessage('BET error: please use File/Open to display the image you want to brain extract.');
 
285
    end;
 
286
    //showmessage(DefaultsDirCmd);
 
287
    lTempNameOrig :=DefaultsDirCmd+'orig.hdr';//lTempNameOrig := extractfilepath(paramstr(0))+'orig.hdr';
 
288
    SaveAsVOIorNIFTIcore (lTempNameOrig, gMRIcroOverlay[kBGOverlayNum].ImgBuffer,gMRIcroOverlay[kBGOverlayNum].ImgBufferItems, gMRIcroOverlay[kBGOverlayNum].ImgBufferBPP,1,gMRIcroOverlay[kBGOverlayNum].NiftiHdr);
 
289
    //SaveAsVOIorNIFTIcore (lTempNameOrig, gMRIcroOverlay[kBGOverlayNum].ImgBuffer,gMRIcroOverlay[kBGOverlayNum].ImgBufferItems, gMRIcroOverlay[kBGOverlayNum].ImgBufferBPP,gMRIcroOverlay[kBGOverlayNum].NiftiHdr);
 
290
    if gMRIcroOverlay[kVOIOverlayNum].ScrnBufferItems > 0 then begin
 
291
        case MessageDlg('Do you wish to protect tissue shown by the VOI drawing?', mtConfirmation, [mbYes, mbNo], 0) of
 
292
                     mrYes: CropVOI(Bright95Pct);
 
293
        end; //case for protecting VOI
 
294
       ImgForm.CloseVOIClick(nil);
 
295
    end;
 
296
    if gMRIcroOverlay[kBGOverlayNum].ImgBufferBPP <> 1 then
 
297
       Memo1.lines.add('Warning: converted image downsampled to 8-bit precision.');
 
298
    lTempName8bitMask := DefaultsDirCmd+'temp8.hdr';//lTempName8bitMask := extractfilepath(paramstr(0))+'temp8.hdr';
 
299
    SaveAsVOIorNIFTIcore (lTempName8bitMask, gMRIcroOverlay[kBGOverlayNum].ScrnBuffer,gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems, 1,1,gMRIcroOverlay[kBGOverlayNum].NiftiHdr);
 
300
    lTempName8bitMask := changefileext(lTempName8bitMask,'.hdr');  //SaveAs renames the .hdr to .img
 
301
    lTempBetName := DefaultsDirCmd+'btemp8.hdr';//lTempBetName := extractfilepath(paramstr(0))+'btemp8.hdr';
 
302
    // showmessage(lTempBetName);
 
303
    if not DoBET(lTempName8bitMask,lTempBetName,SmoothnessEdit.value) then goto 666;
 
304
    Memo1.lines.add('Shutdown Timestamp: '+DateTimeToStr(Now));
 
305
    if Fileexists(lTempBetName) then begin
 
306
       CopyFileEXoverwrite(lTempName8bitMask,lTempBetName); //the old version of BET corrupts some NIfTI information
 
307
    end else begin
 
308
        //assume new version of bet_8UI has saved as .nii.gz
 
309
        lTempGZName := ChangeFileExt(lTempBetName,'.nii.gz');
 
310
        if not Fileexists(lTempGZName) then begin
 
311
           Memo1.lines.add('BET Error: unable to find BET image '+lTempBetName+ ' or '+lTempGZName);
 
312
           {$IFDEF Darwin}
 
313
            Memo1.lines.add(' Try relaunching MRIcron from the Terminal command line, e.g.   /Applications/mricron.app/mricron &');
 
314
           {$ENDIF}
 
315
    //Memo1.Lines.SaveToFile('/Users/crlab/junk.txt');
 
316
           goto 666;
 
317
        end;
 
318
        //convert .nii.gz to hdr/.img so we can mask it...
 
319
        ImgForm.CloseImagesClick(nil);
 
320
        ImgForm.OpenAndDisplayImg(lTempGZName,True);
 
321
        SaveAsVOIorNIFTIcore (lTempBetName,gMRIcroOverlay[kBGOverlayNum].ScrnBuffer, gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems, 1,1,gMRIcroOverlay[kBGOverlayNum].NiftiHdr);
 
322
        //SaveAsVOIorNIFTIcore (lTempBetName, gMRIcroOverlay[kBGOverlayNum].ScrnBuffer,gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems, 1,1,gMRIcroOverlay[kBGOverlayNum].NiftiHdr);
 
323
 
 
324
        DeleteHdrImg(lTempGZName);
 
325
        ImgForm.CloseImagesClick(nil);
 
326
    end;
 
327
    Mask8BitImg(changefileext(lTempNameOrig,'.img'),changefileext(lTempBetName,'.img'));
 
328
    //ImgForm.OpenAndDisplayImg(lTempBetName,True);  // 1/2008
 
329
    ImgForm.OpenAndDisplayImg(lTempNameOrig,True);
 
330
    Memo1.lines.add('Use File/SaveAsNIfTI to save the stripped 8-bit image.');
 
331
666:
 
332
 
 
333
    DeleteHdrImg(lTempBetName);
 
334
    DeleteHdrImg(lTempNameOrig);
 
335
    DeleteHdrImg(lTempName8bitMask);
 
336
end;
 
337
 
 
338
procedure TBETForm.CropBtnClick(Sender: TObject);
 
339
begin
 
340
  CropEdgeForm.Show;
 
341
end;
 
342
 
 
343
(*var
 
344
   lTempNameOrig,lTempName8bitMask,lTempBetName: string;
 
345
begin
 
346
  Memo1.Clear;
 
347
    Memo1.lines.add('Startup Timestamp: '+DateTimeToStr(Now));
 
348
    if (gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems < 1)  then begin
 
349
        showmessage('BET error: please use File/Open to display the image you want to brain extract.');
 
350
    end;
 
351
    lTempNameOrig := '';
 
352
    if gMRIcroOverlay[kVOIOverlayNum].ScrnBufferItems > 0 then begin
 
353
        case MessageDlg('Do you wish to remove tissue shown by the VOI drawing?', mtConfirmation,
 
354
             [mbYes, mbNo], 0) of
 
355
                     mrYes: CropVOI(0);
 
356
                     else case MessageDlg('Do you wish to protect tissue shown by the VOI drawing?', mtConfirmation,
 
357
                          [mbYes, mbNo], 0) of
 
358
                     mrYes: begin
 
359
                             lTempNameOrig := DefaultsDir('')+'orig8.hdr';
 
360
                             SaveAsVOIorNIFTIcore (lTempNameOrig, gMRIcroOverlay[kBGOverlayNum].ScrnBuffer,gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems, 1,gMRIcroOverlay[kBGOverlayNum].NiftiHdr);
 
361
                             CropVOI(Bright95Pct);
 
362
                     end;
 
363
 
 
364
                     end; //case for protecting VOI
 
365
        end; //case for deleting VOI
 
366
 
 
367
       ImgForm.CloseVOIClick(nil);
 
368
    end;
 
369
    if gMRIcroOverlay[kBGOverlayNum].ImgBufferBPP <> 1 then
 
370
       Memo1.lines.add('Warning: converted image downsampled to 8-bit precision.');
 
371
    lTempName8bitMask := DefaultsDir('')+'temp8.hdr';
 
372
    SaveAsVOIorNIFTIcore (lTempName8bitMask, gMRIcroOverlay[kBGOverlayNum].ScrnBuffer,gMRIcroOverlay[kBGOverlayNum].ScrnBufferItems, 1,gMRIcroOverlay[kBGOverlayNum].NiftiHdr);
 
373
    lTempName8bitMask := changefileext(lTempName8bitMask,'.hdr');  //SaveAs renames the .hdr to .img
 
374
    lTempBetName := DefaultsDir('')+'btemp8.hdr';
 
375
    DoBET(lTempName8bitMask,lTempBetName,SmoothnessEdit.value);
 
376
    Memo1.lines.add('Shutdown Timestamp: '+DateTimeToStr(Now));
 
377
 
 
378
    CopyFileEXoverwrite(lTempName8bitMask,lTempBetName); //the old version of BET corrupts some NIfTI information
 
379
    DeleteHdrImg(lTempName8bitMask);
 
380
    if lTempNameOrig <> '' then begin
 
381
       Mask8BitImg(changefileext(lTempNameOrig,'.img'),changefileext(lTempBetName,'.img'));
 
382
       DeleteHdrImg(lTempNameOrig);
 
383
    end;
 
384
    ImgForm.OpenAndDisplayImg(lTempBetName,True);
 
385
    Memo1.lines.add('Use File/SaveAsNIfTI to save the stripped 8-bit image.');
 
386
    DeleteHdrImg(lTempBetName);
 
387
end;*)
 
388
(*procedure TBETForm.GoBtnClick(Sender: TObject);
 
389
begin
 
390
  Memo1.Clear;
 
391
  Memo1.lines.add('Startup Timestamp: '+DateTimeToStr(Now));
 
392
  DoBET('C:\txx.hdr','C:\btxx.hdr',SmoothnessEdit.value);
 
393
  Memo1.lines.add('Shutdown Timestamp: '+DateTimeToStr(Now));
 
394
end; *)
 
395
 
 
396
initialization
 
397
  {$I bet.lrs}
 
398
 
 
399
end.
 
400