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.
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.