| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Про подмену процедуры окна или "SelectDirectory" с checkbox

Dimka-gl ©   (2004-08-15 15:19:00) 

Как создать диалог выбора директории с чекбоксом(recurse subdirectories)? (как в WinAmp 2.9x).
Либо если можно укажите ошибку в том как делал я (тут checkbox создаётся, но не знаю как проверить его сосотояние)!

Мой код такой:

var
 opendirectory_checkbox_hwnd:hwnd;
 tmpwindowlong:cardinal;

function SelectDirCB(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
begin
if (uMsg = BFFM_INITIALIZED) then
begin
 if lpData <> 0 then
   SendMessage(Wnd, BFFM_SETSELECTION, Integer(True), lpdata);
 opendirectory_checkbox_hwnd:=CreateWindowEx(0,'button','Recurse subdirectories', WS_CHILD or WS_VISIBLE or BS_AUTOCHECKBOX,
                 20,10,250,25,Wnd,34,hInstance,nil);
   tmpwindowlong:=SetWindowLong(opendirectory_checkbox_hwnd,GWL_WNDPROC,cardinal(@open_checkbox))
end;
 result := 0;
end;

procedure open_checkbox(hwnd,umsg,wparam,lparam:cardinal);
begin
if uMsg=WM_CHAR then
MessageBox(0,'g','g',MB_OK)else
CallWindowProc(pointer(tmpwindowlong),hwnd,umsg,wparam,lparam);
end;

function SelectDir(var Directory: string): Boolean;
var
 WindowList: Pointer;
 BrowseInfo: TBrowseInfo;
 Buffer: PChar;
 ItemIDList: PItemIDList;
 ShellMalloc: IMalloc;
begin
 Result := False;
 if not DirectoryExists(Directory) then
   Directory := '';
 FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
 if (ShGetMalloc(ShellMalloc) = S_OK) and (ShellMalloc <> nil) then
 begin
   Buffer := ShellMalloc.Alloc(MAX_PATH);
   try
     with BrowseInfo do
     begin
       hwndOwner := Application.Handle;
       pidlRoot := nil;
       pszDisplayName := Buffer;
       lpszTitle := nil;
       ulFlags := BIF_RETURNONLYFSDIRS;
       {if Directory <> '' then
       begin}
         lpfn := SelectDirCB;
         lParam := Integer(PChar(Directory));
       {end;}
     end;
     WindowList := DisableTaskWindows(0);
     try
       ItemIDList := ShBrowseForFolder(BrowseInfo);
     finally
       EnableTaskWindows(WindowList);
     end;
     Result :=  ItemIDList <> nil;
     if Result then
     begin
       ShGetPathFromIDList(ItemIDList, Buffer);
       ShellMalloc.Free(ItemIDList);
       Directory := Buffer;
     end;
   finally
     ShellMalloc.Free(Buffer);
   end;
 end;
end;

p.s. Процесс подмены функции окна взят из iczelion's tutorials для асма. Возможно просто не так типы привожу.

---

Dimka-gl   (2004-08-18 03:50:00) [1]

Спасибо большое! Всё работает.

---

jack128   (2004-08-18 00:14:00) [2]

> процедуру окна
процедуру CheckBox'a имеется в виду.

---

jack128   (2004-08-18 00:08:00) [3]

нужно процедуру окна вот так изменить

var
Checked: boolean;

procedure open_checkbox(hwnd,umsg,wparam,lparam:cardinal); stdcall;
begin
 if uMsg = BM_SETCHECK then
  Checked := wParam = BST_CHECKED;
CallWindowProc(pointer(tmpwindowlong),hwnd,umsg,wparam,lparam);
end;

 s:= 'F:\Teleport Pro';
 Checked := False;
 SelectDir(s);
 // Теперь в Checked - значение чек бокса
 if Checked then Caption := 'true'
 else Caption := 'False';

---

Dimka-gl   (2004-08-17 22:46:00) [4]

plz up

---

Наверх