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;