SelectDirectory + bouton créer un nouveau dossier
Résolu
joelsprung
Messages postés
4
Date d'inscription
lundi 8 août 2005
Statut
Membre
Dernière intervention
20 décembre 2005
-
19 déc. 2005 à 11:30
cs_Adkiks Messages postés 40 Date d'inscription jeudi 20 mai 2004 Statut Membre Dernière intervention 29 janvier 2006 - 22 déc. 2005 à 23:40
cs_Adkiks Messages postés 40 Date d'inscription jeudi 20 mai 2004 Statut Membre Dernière intervention 29 janvier 2006 - 22 déc. 2005 à 23:40
A voir également:
- Delphi selectdirectory
- Delphi format - Conseils pratiques -Delphi
- Delphi thread - Conseils pratiques -Delphi
- Shellexecute delphi ✓ - Forum Delphi / Pascal
- Delphi pos ✓ - Forum Delphi / Pascal
- Delphi peche ✓ - Forum Delphi / Pascal
9 réponses
Cirec
Messages postés
3833
Date d'inscription
vendredi 23 juillet 2004
Statut
Modérateur
Dernière intervention
18 septembre 2022
50
20 déc. 2005 à 13:11
20 déc. 2005 à 13:11
Salut,
Essaye ceci, ça fera peut être ton bonheur
// Code testé OK sous Delphi4
var
Form1: TForm1;
Const
BIF_NEWDIALOGSTYLE = $0040; // BIF_NEWDIALOGSTYLE à rajouter si Delphi7 ne le connait pas
implementation
uses ShlObj, ActiveX ; // indispensable
{$R *.DFM}
function IncludeTrailingPathDelimiter( const S: string): string; // à rajouter si Delphi7 ne le connait pas
begin
Result : = S;
If not IsPathDelimiter(Result, Length(Result)) then
Result := Result +'\';
end ;
function IncludeTrailingBackslash(const S: string): string; // à rajouter si Delphi7 ne le connait pas
begin
Result : = IncludeTrailingPathDelimiter(S);
end;
// voici le function qui te permet de sélectionner et où crée un répertoire
function MySelectDirectory(const Title: string;const Root: WideString;var Directory: string; const
Flag:integer): Boolean;
var
RootItemIDList, lpItemID : PItemIDList;
BrowseInfo: TBrowseInfo;
WindowList: Pointer;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
ShellMalloc: IMalloc;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
Result:= False;
Try
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
RootItemIDList := nil ;
if Root <> '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil,
POleStr(Root), Eaten, RootItemIDList, Flags);
end;
with BrowseInfo do begin
hwndOwner : = Application.Handle;
pszDisplayName := @DisplayName;
pidlRoot:= RootItemIDList;
lpszTitle := PChar(Title);
ulFlags := Flag;
end ;
WindowList : = DisableTaskWindows(0);
try
lpItemID := SHBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(WindowList);
end ;
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, TempPath);
Directory : = IncludeTrailingBackslash(TempPath);
GlobalFreePtr(lpItemID);
end;
finally
if Succeeded(SHGetMalloc(ShellMalloc)) then
ShellMalloc.Free(RootItemIDList);
end;
end;
// et la methode d'appel
procedure TForm1.Button1Click(Sender: TObject);
Var s : String;
begin
MySelectDirectory('Choix du répertoire', 'c:\', s,BIF_NEWDIALOGSTYLE);
Label1.Caption := s;
end;
@+
Cirec
Essaye ceci, ça fera peut être ton bonheur
// Code testé OK sous Delphi4
var
Form1: TForm1;
Const
BIF_NEWDIALOGSTYLE = $0040; // BIF_NEWDIALOGSTYLE à rajouter si Delphi7 ne le connait pas
implementation
uses ShlObj, ActiveX ; // indispensable
{$R *.DFM}
function IncludeTrailingPathDelimiter( const S: string): string; // à rajouter si Delphi7 ne le connait pas
begin
Result : = S;
If not IsPathDelimiter(Result, Length(Result)) then
Result := Result +'\';
end ;
function IncludeTrailingBackslash(const S: string): string; // à rajouter si Delphi7 ne le connait pas
begin
Result : = IncludeTrailingPathDelimiter(S);
end;
// voici le function qui te permet de sélectionner et où crée un répertoire
function MySelectDirectory(const Title: string;const Root: WideString;var Directory: string; const
Flag:integer): Boolean;
var
RootItemIDList, lpItemID : PItemIDList;
BrowseInfo: TBrowseInfo;
WindowList: Pointer;
IDesktopFolder: IShellFolder;
Eaten, Flags: LongWord;
ShellMalloc: IMalloc;
DisplayName : array[0..MAX_PATH] of char;
TempPath : array[0..MAX_PATH] of char;
begin
Result:= False;
Try
FillChar(BrowseInfo, sizeof(TBrowseInfo), #0);
RootItemIDList := nil ;
if Root <> '' then
begin
SHGetDesktopFolder(IDesktopFolder);
IDesktopFolder.ParseDisplayName(Application.Handle, nil,
POleStr(Root), Eaten, RootItemIDList, Flags);
end;
with BrowseInfo do begin
hwndOwner : = Application.Handle;
pszDisplayName := @DisplayName;
pidlRoot:= RootItemIDList;
lpszTitle := PChar(Title);
ulFlags := Flag;
end ;
WindowList : = DisableTaskWindows(0);
try
lpItemID := SHBrowseForFolder(BrowseInfo);
finally
EnableTaskWindows(WindowList);
end ;
if lpItemId <> nil then
begin
SHGetPathFromIDList(lpItemID, TempPath);
Directory : = IncludeTrailingBackslash(TempPath);
GlobalFreePtr(lpItemID);
end;
finally
if Succeeded(SHGetMalloc(ShellMalloc)) then
ShellMalloc.Free(RootItemIDList);
end;
end;
// et la methode d'appel
procedure TForm1.Button1Click(Sender: TObject);
Var s : String;
begin
MySelectDirectory('Choix du répertoire', 'c:\', s,BIF_NEWDIALOGSTYLE);
Label1.Caption := s;
end;
@+
Cirec
