Browse for Folder

--+ This example was written under Aonix ObjectAda for
--+ Windows and relies on the WinApi and Extra 
--+ packages supplied in the WinApi binding for Aonix
--+ by John Walker.

with gb; use gb;
with gb.OleInterfaces;

with Win32, Win32.WinDef, Win32.WinMain, Win32.WinUser, Win32.WinError, System;
with Win32.WinGDI, Win32.WinBase, Win32.WinNT, Win32.Utils, Interfaces.C;
use  Win32, Win32.WinError, Interfaces.C, System;

package SelectDirectoryWindow is
  Form            : aliased gb.MainWindow;
  ExitButton      : aliased gb.Button;
  DirectoryText   : aliased gb.TextBox(Alignment => Left, AutoScroll => Both, 
                                       MultiLine => gb.False, Password => gb.False, 
                                       ReadOnly => gb.False);
  BrowseButton    : aliased gb.Button;
  procedure Initialize_Form;
end SelectDirectoryWindow;

with Ada.Unchecked_Conversion;
with Extra;
with WinAPI;

package body SelectDirectoryWindow is
  procedure ExitButton_Click is
  begin
     gb.EndApplication;
  end ExitButton_Click;

  procedure BrowseButton_Click is
  
     directory  : string(1..256)  := (others => gb.NullChar);
     info       : constant string := "Select a directory" & gb.NullChar;
     r          : Extra.lpcITEMIDLIST;
     bResult    : WinAPI.BOOL := gb.FALSE;
     bi         : aliased Extra.abrowseinfoA;
     
     use type Extra.lpcITEMIDLIST;
  
     --+ It would be better to place this function in the body of the package,
     --+ but it is left here for completness (and easy of cut and paste).
     function Convert(S: String) return WinAPI.LPCSTR is 
        function UC is new Ada.Unchecked_Conversion(System.Address, WinAPI.LPCSTR);
     begin
        return UC(S(S'First)'Address);
     end Convert;
  
  begin
  
     bi.hwndOwner      := Handle(Form);       -- Handle to a window object
     bi.pidlRoot       := null;               -- default = from desktop folder 
     bi.pszDisplayName := Convert(directory); -- Directory name up to 256 characters
     bi.lpszTitle      := Convert(info);      -- Title for the "Browse for Folder" Common Dialog
     bi.ulFlags        := 0;                  -- Type of folders to be displayed (0 = all).
     bi.lpfn           := null;               -- BrowseCallBackProc'access
     bi.lParam         := 0;                  -- Value to be passed to the callback routine.
     bi.iImage         := 0;
  
     r := Extra.SHBrowseForFolderA(bi'unchecked_access);
  
     if (r /= null) then
  
        bResult := Extra.SHGetPathFromIDListA(R, Convert(directory));
  
        if (bResult = gb.TRUE) then
           Text(DirectoryText, TrimString(directory)& '\');  -- display the selected directory
        end if;
  
     end if;
  
  end BrowseButton_Click;

  procedure Initialize_Form is
  begin
    ExitButton.Click := ExitButton_Click'Access;
    Caption(ExitButton, "Exit");
    Move(ExitButton, 170, 60, 91, 41);

    Text(DirectoryText, "C:\TEMP\");
    Move(DirectoryText, 20, 20, 341, 21);

    BrowseButton.Click := BrowseButton_Click'Access;
    Caption(BrowseButton, "...");
    Move(BrowseButton, 380, 20, 41, 21);

    Caption(Form, "Select Directory Window");
    Move(Form, 49, 164, 450, 148);
    Visible(Form, gb.True);
  end Initialize_Form;
begin
  Initialize_Form;
end SelectDirectoryWindow;


with gb;
with SelectDirectoryWindow;

procedure SelectDirectoryMain is begin
  gb.StartApplication;
end SelectDirectoryMain;