uses

 ShlObj, ActiveX, CommCtrl;

 

var

 id:integer;

 

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,'Checked!','',0) else

         MessageBox(Wnd,'UnChecked!','',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','MyCheckBox', 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;

 

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;