[fpc-pascal]Win32: converting lptstr to string
Nikolai Zhubr
s001 at hotbox.ru
Tue Apr 27 00:58:08 CEST 2004
Hi,
Monday, 26 April, 2004, 23:25:07, Inpromptu wrote:
> Hi:
> I was looking the demo sources, and I found c:\pp\demo\win32\edit.pp VERY interesting. So, i decide to try shBrowseForFolder instead of GetOpenFilename, but I don't know wath I'm doing wrong...
> This is my humble little program... be nice with the criticims... !
> {----------begin of program------------}
> program myprogram;
> uses windows;
> const
> COINIT_APARTMENTTHREADED=2;{from
> http://msdn.microsoft.com/library/default.asp?url=/library/en-us/com/htm/cme_a2d_4oqc.asp }
> var
> myDir:browseinfo; {from
> http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/structures/browseinfo.asp }
[trim]
Ok, enough advertising microsoft.com for now... ;-)
See some working example below, hope it helps.
Don't forget to specify -Sd option.
--
Best regards,
Nikolai Zhubr
program SelDir;
const
shell32 = 'shell32.dll';
S_OK = $00000000;
MAX_PATH = 260;
BIF_RETURNONLYFSDIRS = $0001;
type
HWND = LongInt;
BOOL = LongBool;
PItemIDList = pointer;
TBrowseinfo = record
hwndOwner: HWND;
pidlRoot: PItemIDList;
pszDisplayName: PAnsiChar; { Return display name of item selected. }
lpszTitle: PAnsiChar; { text to go in the banner over the tree. }
ulFlags: longint; { Flags that control the return stuff }
lpfn: pointer;
lParam: longint; { extra info that's passed back in callbacks }
iImage: longint; { output var: where to return the Image index. }
end;
__IMalloc_Alloc = function (__Self: pointer; cb: Longint): Pointer; stdcall;
__IMalloc_Realloc = function (__Self: pointer; pv: Pointer; cb: Longint): Pointer; stdcall;
__IMalloc_Free = procedure(__Self: pointer; pv: Pointer); stdcall;
IMalloc = ^__IMalloc2;
__IMalloc2 = ^__IMalloc;
__IMalloc = record
rsrv1, rsrv2, rsrv3: longint;
Alloc: __IMalloc_Alloc;
Realloc: __IMalloc_Realloc;
Free: __IMalloc_Free;
end;
function SHBrowseForFolder(var lpbi: TBrowseInfo): PItemIDList; stdcall;
external shell32 name 'SHBrowseForFolderA';
function SHGetPathFromIDList(pidl: PItemIDList; pszPath: PChar): BOOL; stdcall;
external shell32 name 'SHGetPathFromIDListA';
function SHGetMalloc(var ppMalloc: IMalloc): longint; stdcall;
external shell32 name 'SHGetMalloc';
function SelectDirectory(const Caption: string; const Root: String): string;
var
BrowseInfo: TBrowseInfo;
Buffer: PChar;
ItemIDList: PItemIDList;
ShellMalloc: IMalloc;
begin
Result := '';
FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
begin
Buffer := ShellMalloc^.Alloc(ShellMalloc, MAX_PATH);
try
with BrowseInfo do
begin
pidlRoot := nil;
hwndOwner:= 0 ;
pszDisplayName := Buffer;
lpszTitle := PChar(Caption);
ulFlags := BIF_RETURNONLYFSDIRS;
end;
ItemIDList := ShBrowseForFolder(BrowseInfo);
if ItemIDList <> nil then
begin
ShGetPathFromIDList(ItemIDList, Buffer);
ShellMalloc^.Free(ShellMalloc, ItemIDList);
result := Buffer;
end;
finally
ShellMalloc^.Free(ShellMalloc, Buffer);
end;
end;
end;
begin
writeln ('Started...');
writeln ('Path = ', SelectDirectory('MyCaption', ''));
end.
More information about the fpc-pascal
mailing list