Selectdirectory avec une checkboxe.

Télécharger le projet
Commenter

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.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (ROCABDEL)