--+ 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;
|