dcm_load.pas

unit dcm_load;

{$mode objfpc}{$H+}
//{$DEFINE isGL}


interface

uses
  {$IFNDEF UNIX} Windows, shlobj, {$ENDIF}
  ClipBrd, ExtCtrls, StdCtrls, Forms, Controls, Classes, SysUtils, dialogs, Process;


function dcm2Nifti(dcm2niixExe, dicomDir: string): string;
function HomeDir(useTmp: boolean = true): string; //set path to home if not provided

implementation

{$ifdef LCLCocoa} {$IFDEF isGL}
uses mainunit; //darkmode
{$ENDIF}  {$ENDIF}

function seriesName (s: string): string; //"601 myName" returns 'myName'
const
  kTab = chr(9);
var
    delimPos: integer;
begin
  //delimPos := pos(' ',s);
  delimPos := pos(kTab,s);
  if (delimPos < 1) or (delimPos >= length(s)) then exit(s);
  result := Copy(s, delimPos+1, maxInt);
end;

function seriesNum (s: string): single; //"601 myName" returns 'myName'
const
  kTab = chr(9);
var
    delimPos: integer;
    s2: string;
begin
  //delimPos := pos(' ',s);
  delimPos := pos(kTab,s);
  if (delimPos < 1) or (delimPos >= length(s)) then exit(-1);
  s2 := Copy(s, delimPos+1, maxInt);
  result := StrToFloatDef(Copy(s2, 1, pos('_',s2)-1),-1);
end;

function compareSeries(List: TStringList; Index1, Index2: Integer): Integer;
var
  n1, n2: single;
begin
  n1 := seriesNum(List[Index1]);
  n2 := seriesNum(List[Index2]);
  if (n1 >= n2) then
     result := 1
  else
     result := -1;
  //result := n1 - n2;
end;

function seriesCrc (s: string): double; //"601 myName" returns 601
const
  kTab = chr(9);
begin
  //result := StrToFloatDef(Copy(s, 1, pos(' ',s)-1),-1);
  result := StrToFloatDef(Copy(s, 1, pos(kTab,s)-1),-1);
end;

function dcmStr(s: string): string;
const
  kTab = chr(9);
var
     sl: TStringList;
     //s2: string;
     //i: integer;
begin
  result := '';
  if (length(s) < 1) or (s[1] <> chr(9)) then exit;
  sl := TStringList.Create;
  sl.Delimiter := #9; //TAB
  sl.StrictDelimiter := true;
  sl.DelimitedText := s;
  if sl.Count >= 2 then begin
     //result := sl[1]+' '+extractfilename(sl[sl.Count-1]) ;
     result := sl[1]+kTab+extractfilename(sl[sl.Count-1]) ;

     //s2 := sl[sl.Count-1];
     //result := sl[1]+kTab+extractfilename(s2) ;
     //showmessage(format('*%s*%s*', [result, s2]));
  end else
   result := '';
  sl.Free;
end;

(*function dcmStr(s: string): string;
var
     sl: TStringList;
     s2: string;
     i: integer;
begin
  result := '';
  if (length(s) < 1) or (s[1] <> chr(9)) then exit;
  sl := TStringList.Create;
  sl.Delimiter := #9; //TAB
  sl.StrictDelimiter := false;
  sl.DelimitedText := s;
  if sl.Count >= 2 then begin
     s2 := sl[1];
     i := 2;
     while (i < sl.Count) do begin //in case of space in directory name
           s2 := s2 + ' ' + sl[i];
           i := i + 1;
     end;
     result := sl[0]+' '+extractfilename(s2) ;
  end else
   result := '';
  sl.Free;
end;*)

(*procedure printf(s: string);
begin
{$IFDEF UNIX}writeln(s);{$ENDIF}
end;*)

function dcmList(dcm2niixExe, dicomDir: string): TStringList;
//make sure to free result!
//strList := dcmList(); strList.free;
const
  BUF_SIZE = 2048; // Buffer size for reading the output in chunks
var
  OutputStream : TStream;
  BytesRead    : longint;
  Buffer       : array[1..BUF_SIZE] of byte;
  hprocess: TProcess;
  sData: TStringList;
  s: string;
  x: integer;
Begin
  result := Tstringlist.Create;
  if dcm2niixExe = '' then exit;
   hProcess := TProcess.Create(nil);
   hProcess.Executable := dcm2niixExe;
   hprocess.Parameters.Add('-b');
   hprocess.Parameters.Add('n');
   hprocess.Parameters.Add('-n');
   hprocess.Parameters.Add('-1');
   hprocess.Parameters.Add('-f');
   hprocess.Parameters.Add('%s_%p_%t');
   {$IFDEF UNIX}
   hprocess.Parameters.Add('-o');
   hprocess.Parameters.Add(HomeDir);
   {$ENDIF}
   hprocess.Parameters.Add(dicomDir);
   hProcess.Options := hProcess.Options + [ poUsePipes, poNoConsole];
   //code below fails on Windows: http://wiki.freepascal.org/Executing_External_Programs#Reading_large_output
   //hProcess.Options := hProcess.Options + [poWaitOnExit, poUsePipes, poNoConsole];
   hProcess.Execute;
   OutputStream := TMemoryStream.Create;
   repeat
     repeat
       BytesRead := hProcess.Output.Read(Buffer, BUF_SIZE);
       OutputStream.Write(Buffer, BytesRead)
     until BytesRead = 0;  // Stop if no more data is available
   until not hProcess.Running;
   hProcess.Free;
   sData := Tstringlist.Create;
   OutputStream.Position := 0; // Required to make sure all data is copied from the start
   sData.LoadFromStream(OutputStream);
   OutputStream.Free;
   for x := 0 to sData.Count -1 do begin
       s := dcmStr(sData[x]);
       //printf(s);
       if (s <> '') then
           result.Add(s);
   end;
   //next: sort (optional)
   sData.Clear;
   sData.AddStrings(result);
   sData.CustomSort(@compareSeries);
   result.Clear;
   result.AddStrings(sData);
   //release data
   sData.Free;
end;


function HomeDir(useTmp: boolean = true): string; //set path to home if not provided
{$IFDEF UNIX}
begin
  if useTmp then begin
     result := '/tmp/';
     if fileexists(result) then exit;
  end;
  result := expandfilename('~/');
end;
{$ELSE}
var
  SpecialPath: PWideChar;
begin
  Result := '';
  SpecialPath := WideStrAlloc(MAX_PATH);
  try
    FillChar(SpecialPath^, MAX_PATH, 0);
    if SHGetSpecialFolderPathW(0, SpecialPath, CSIDL_PERSONAL, False) then
      Result := SpecialPath+pathdelim;
  finally
    StrDispose(SpecialPath);
  end;
end;
{$ENDIF}

function dcmSeriesSelectForm(dcm2niixExe, dicomDir: string): string;
const
  kMaxItems = 16;  //https://bugs.freepascal.org/view.php?id=35789
var
  PrefForm: TForm;
  rg: TRadioGroup;
  dcmStrings, dcmStringsSeries: TStringlist;
  OKBtn, CancelBtn: TButton;
  i, w,h: integer;
label
  123;
begin
  result := '';
  dcmStrings := dcmList(dcm2niixExe, dicomDir);
  if dcmStrings.Count < 1 then goto 123; //no files
  if dcmStrings.Count = 1 then begin
    result := dcmStrings[0];//seriesNum(dcmStrings[0]);
    goto 123;
  end;
  PrefForm:=TForm.Create(nil);
  PrefForm.BorderWidth := 4;
  PrefForm.Caption:='Save converted images to '+HomeDir;
  PrefForm.Position := poScreenCenter;
  PrefForm.BorderStyle := bsDialog;
  PrefForm.AutoSize:=false;
  //PrefForm.Constraints.MinWidth := 400;
  //radio group
  rg := TRadioGroup.create(PrefForm);
  rg.align := alTop;
  //rg.AutoSize:=false;
  rg.parent := PrefForm;
  rg.caption := 'Select DICOM Series (Series_Protocol_Date)';
  if dcmStrings.Count > (kMaxItems) then begin
     rg.caption := rg.caption + ' (Partial Listing)';
     while (dcmStrings.Count > kMaxItems) do
           dcmStrings.Delete(dcmStrings.Count-1);
  end;
  {$IFDEF SHOWCRC}
  rg.items := dcmStrings;
  {$ELSE}
  dcmStringsSeries := Tstringlist.Create;
  for i := 0 to (dcmStrings.count -1) do begin
      //dcmStringsSeries.add(dcmStrings[i]+'*'+seriesName(dcmStrings[i]));
      dcmStringsSeries.add(seriesName(dcmStrings[i]));
  end;
  rg.items := dcmStringsSeries;
  dcmStringsSeries.Free;
  {$ENDIF}
  //rg.Constraints.MaxWidth:= 300; //https://bugs.freepascal.org/view.php?id=35789
  rg.BorderSpacing.Around := 8;
  rg.AutoSize := true;
  rg.HandleNeeded;
  rg.GetPreferredSize(w, h);
  rg.Align := alTop;
  rg.Height := h;
  rg.ItemIndex:=0;
  //OK button
  OkBtn:=TButton.create(PrefForm);
  OkBtn.Caption:='OK';
  OkBtn.AutoSize := true;
  OkBtn.AnchorSideTop.Control := rg;
  OkBtn.AnchorSideTop.Side := asrBottom;
  OkBtn.AnchorSideRight.Control := PrefForm;
  OkBtn.AnchorSideRight.Side := asrBottom;
  OkBtn.BorderSpacing.Right := 4;
  OkBtn.Anchors := [akTop, akRight];
  OkBtn.Parent:=PrefForm;
  OkBtn.ModalResult:= mrOK;
  //Cancel button
  CancelBtn:=TButton.create(PrefForm);
  CancelBtn.Caption:='Cancel';
  CancelBtn.AutoSize := true;
  CancelBtn.AnchorSideTop.Control := OkBtn;
  CancelBtn.AnchorSideTop.Side := asrCenter;
  CancelBtn.AnchorSideRight.Control := OkBtn;
  CancelBtn.BorderSpacing.Right := 4;
  CancelBtn.Anchors := [akTop, akRight];
  CancelBtn.Parent:=PrefForm;
  CancelBtn.ModalResult:= mrCancel;
  //PrefForm.Height:= OkBtn.Top + OkBtn.Height+4;
  PrefForm.AutoSize:=true;
   {$IFDEF isGL}
  {$IFDEF LCLCocoa}GLForm1.SetFormDarkMode(PrefForm); {$ENDIF}
  {$ENDIF}
  PrefForm.ShowModal;
  result := dcmStrings[rg.ItemIndex];
  if PrefForm.ModalResult = mrCancel then
    result :=  '';
  FreeAndNil(PrefForm);
 123: //cleanup
  dcmStrings.Free;
end; // dcmSeriesSelectForm()


function findNiiFile(baseName: string): string;
//if baseName '~/d/img.nii' does not exist but '~/d/img_e1.nii' does
var
  searchResult : tsearchrec;
begin
  result := basename;
  if FindFirst(changefileext(baseName, '*.nii'), faAnyFile, searchResult) = 0 then begin
     result := ExtractFilePath(basename) + searchResult.Name;
     FindClose(searchResult);
  end;
end;

function dcm2niiSeries(dcm2niixExe, dicomDir, series_name: string): string;
var
    hprocess: TProcess;
    seriesCR: double;
Begin
  result := '';
  if dcm2niixExe = '' then exit;
  seriesCR := seriesCRC(series_name);
  if seriesCR < 1 then exit;
  result := seriesName(series_name);
  if result = '' then exit;
  result := HomeDir+ result+'.nii';
  {$IFDEF UNIX}
  if HomeDir = '/tmp/' then
     //ignore
  else
  {$ENDIF}
  if (fileexists(result)) then begin //if we do over-write, make sure temp in filename
     if MessageDlg('Overwrite image '+result+'?',mtInformation,[mbAbort, mbOK],0) = mrAbort then
        exit;
  end;
   hProcess := TProcess.Create(nil);
   hProcess.Executable := dcm2niixExe;
   hprocess.Parameters.Add('-n');
   hprocess.Parameters.Add(format('%g', [seriesCR]));
   hprocess.Parameters.Add('-f');
   //if isTemp then
   //   hprocess.Parameters.Add(kdcmLoadTempStr+'%p_%t')
   //else
   hprocess.Parameters.Add('%s_%p_%t');
   hprocess.Parameters.Add('-b');
   hprocess.Parameters.Add('n');
   hprocess.Parameters.Add('-z');
   hprocess.Parameters.Add('n');
   hprocess.Parameters.Add('-o');
   hprocess.Parameters.Add(HomeDir);
   hprocess.Parameters.Add(dicomDir);
   //Do NOT use pipes for Windows
   hProcess.Options := hProcess.Options + [poWaitOnExit, poNoConsole];
   hProcess.Execute;
   hProcess.Free;
   if fileexists(result) then exit;
   result := findNiiFile(result); //error handling for multiple echo or coil images
end;

function dcm2Nifti(dcm2niixExe, dicomDir: string): string;
begin
  result := '';
  if dcm2niixExe = '' then exit;
  if not fileexists(dcm2niixExe) then exit;
  result := dcmSeriesSelectForm(dcm2niixExe, dicomDir);
  if result = '' then exit;
  result := dcm2niiSeries(dcm2niixExe, dicomDir, result);
end;

end.