SELECTDIRECTORY AVEC UNE CHECKBOXE.

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 zip

28 mai 2007 08:39:27 :

changement des mots clés.