Текущий архив: 2004.09.26;
Скачать: CL | DM;

Вниз

Про подмену процедуры окна или "SelectDirectory" с checkbox   Найти похожие ветки 

← →
Dimka-gl ©   (2004-08-15 15:19) [0]

Как создать диалог выбора директории с чекбоксом(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-17 22:46) [1]

plz up

---

← →
jack128 ©   (2004-08-18 00:08) [2]

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

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";

---

← →
jack128 ©   (2004-08-18 00:14) [3]

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

---

← →
Dimka-gl ©   (2004-08-18 03:50) [4]

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

---

Страницы: 1 вся ветка

Текущий архив: 2004.09.26;
Скачать: CL | DM;

Наверх

Память: 0.45 MB
Время: 0.033 c