Selectdirectory avec une checkboxe.

Soyez le premier à donner votre avis sur cette source.

Vue 7 059 fois - Téléchargée 1 024 fois

Description

ce petit code montre comment ajouter une checkbox dans la boite d'ouverture des dossiers "selectDirectory" du genre scruter les sous-dossier afin de permetre à l'utilisateur de choisir entre l'ouverture du dossier sellectioner seulement et ses sous-dossier.

Source / Exemple :


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,ShlObj, ActiveX, CommCtrl, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;
  id:integer;

implementation
{$R *.dfm}
{MwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMw}
function NewDlgProc(Wnd:HWND; uMsg:DWORD; wParam:WPARAM; lParam:LPARAM):integer; stdcall;
begin
  if (uMsg=WM_COMMAND) then
     if (LOWORD(wParam)=id) then
       if (HIWORD(wParam)=BN_CLICKED) then
       begin
         if (IsDlgButtonChecked(Wnd,id)=BST_CHECKED) then MessageBox(Wnd,'Open SubFolders = Yes','',0) else
         MessageBox(Wnd,'Open SubFolders = No','',0)
       end;
  result:=CallWindowProc(Pointer(GetWindowLong(Wnd,GWL_USERDATA)),Wnd,uMsg,wParam,lParam);
end;
{*************************************************************************************************}
function BrowseCallback(Wnd:HWND; uMsg:DWORD; lParam:LPARAM; lpData:LPARAM ):integer; stdcall;
var
 hwndCheck:HWND;
begin
  if (uMsg=BFFM_INITIALIZED) then
  begin
   hwndCheck:=CreateWindow('BUTTON','Open SubFolders', BS_AUTOCHECKBOX or WS_CHILD or WS_VISIBLE,10,10,100,20,Wnd,id,hInstance,nil);
   SendMessage(hwndCheck,WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT),1);
   SetWindowLong(Wnd,GWL_USERDATA,SetWindowLong(Wnd, DWL_DLGPROC, Integer(@NewDlgProc)));
  end;
  Result:=0;
end;
{MwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMwMw}
procedure TForm1.Button1Click(Sender: TObject);
var
 bi:TBrowseInfo;
 szDir:array[0..MAX_PATH-1] of char;
 pidl:PItemIDList;
 lpMalloc:IMalloc;
begin
  if SUCCEEDED(SHGetMalloc(lpMalloc)) then
  begin
    ZeroMemory(@bi,sizeof(bi));
    bi.hwndOwner := Handle;
    bi.ulFlags := BIF_RETURNONLYFSDIRS or BIF_EDITBOX;
    bi.lpfn := BrowseCallback;
    pidl := SHBrowseForFolder(bi);
    if (pidl<>nil) then
    begin
     if SHGetPathFromIDList(pidl,szDir) then MessageBox(Handle,szDir,'Picked',0);
     lpMalloc.Free(pidl)
    end;
  end;
end;

end.

Codes Sources

A voir également

Ajouter un commentaire Commentaires
Messages postés
9
Date d'inscription
samedi 23 septembre 2006
Statut
Membre
Dernière intervention
3 septembre 2010

Merci pour ce snippet qi m'évite de devoir chercher à le réaliser tout seul.
J'aimerais aussi pouvoir demander une fenêtre plus grande pour la même boite de dialogue.
Est ce possible ?

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.