API - usar a funcao que busca pasta com uma pasta default aberta |
Top Previous Next |
// usada como callback pela GetFolderDef function BrowseCallbackProc(Wnd: HWnd; Msg: UINT; lParam: LPARAM; lData: LPARAM): Integer; stdcall; var wht,hgt: Integer; winrect: TRect; begin Result := 0; // upon startup, set the selection to the intial directory desired if Msg = BFFM_INITIALIZED then begin windows.GetClientRect(wnd,winrect); wht := winrect.Right - winrect.left; hgt := winrect.Bottom - winrect.top; SetWindowpos(wnd,HWND_TOP,(screen.width-wht) div 2,(screen.height-hgt) div 2,wht,hgt,SWP_NOSIZE); SendMessage(Wnd, BFFM_SETSELECTION, WPARAM(False), lData); end; end;
function GetFolderDef(const PastaDef: string): string; var lpItemID, DeskItemIDList, SelItemId: PItemIDList; BrowseInfo : TBrowseInfo; DisplayName : array[0..MAX_PATH] of char; TempPath : array[0..MAX_PATH] of char; ppshf : IShellFolder; Eaten, Flags : cardinal; OldFolderName: string; PastaDefault : string; begin Result := ''; SelItemId := nil; OldFolderName := PastaDefault; SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOP, DeskItemIDList); if PastaDefault <> '' then begin if PastaDefault[Length(PastaDefault)] = '\' then Delete(PastaDefault,Length(PastaDefault),1); if SHGetDesktopFolder(ppshf)=0 then ppshf.ParseDisplayName(Application.handle, nil, StringToOleStr(PastaDefault), Eaten, SelItemId, Flags); end;
PastaDefault := PastaDef; FillChar(BrowseInfo, sizeof(TBrowseInfo), #0); with BrowseInfo do begin hwndOwner := Application.handle; pszDisplayName:= DisplayName; lpszTitle := PChar('Selecione uma pasta'); ulFlags := BIF_RETURNONLYFSDIRS; pidlRoot := DeskItemIDList; lpfn := BrowseCallbackProc; lparam := Integer(SelItemId); end;
lpItemID := SHBrowseForFolder(BrowseInfo); if lpItemId <> nil then begin SHGetPathFromIDList(lpItemID, TempPath); PastaDefault := IncludeTrailingPathDelimiter(TempPath); GlobalFreePtr(lpItemID); end; Result := PastaDefault; end; |