Delphi 選擇資料夾對話方塊 (有新建資料夾按鈕)修正版
阿新 • • 發佈:2019-01-24
uses ShlObj; function SelectFolderDialog(const Handle: integer; const Caption: string; const InitFolder: WideString; var SelectedFolder: string): boolean; var BInfo: _browseinfo; Buffer: array[0..MAX_PATH] of Char; ID: IShellFolder; Eaten, Attribute: Cardinal; ItemID: PItemidlist; begin Result := False; BInfo.HwndOwner := Handle; BInfo.lpfn := nil; BInfo.lpszTitle := Pchar(Caption); BInfo.ulFlags := BIF_RETURNONLYFSDIRS + BIF_NEWDIALOGSTYLE; SHGetDesktopFolder(ID); ID.ParseDisplayName(0, nil, PWideChar(InitFolder), Eaten, ItemID, Attribute); BInfo.pidlRoot := ItemID; GetMem(BInfo.pszDisplayName, MAX_PATH); try if SHGetPathFromIDList(SHBrowseForFolder(BInfo), Buffer) then begin SelectedFolder := Buffer; if Length(SelectedFolder) <> 3 then SelectedFolder := SelectedFolder + '\'; result := True; end else begin SelectedFolder := ''; Result := False; end; finally FreeMem(BInfo.pszDisplayName); end; end; procedure TFrmMain.EdtDirPathButtonClick(Sender: TObject); var NewDir: string; begin if SelectFolderDialog(Handle, '選擇', '', NewDir) then EdtDirPath.Text := NewDir; end;