Add checkbox on SelectDirectory Dialog. I need help.

[zoltanleo]

Trying to add a checkbox on SelectDirectory Dialog (sample code).

Code: Pascal  [Select][+][-]

1. implementation
2.  
3. uses
4.  ShlObj, ActiveX, CommCtrl, windows, ShellApi;
5.  
6. ...
7. var
8.  id:integer;
9.  
10.  function NewDlgProc(Wnd:HWND; uMsg:DWORD; wParam:WPARAM; lParam:LPARAM):integer; stdcall;
11.  begin
12.    if (uMsg=WM_COMMAND) then
13.       if (LOWORD(wParam)=id) then
14.         if (HIWORD(wParam)=BN_CLICKED) then
15.         begin
16.           if (IsDlgButtonChecked(Wnd,id)=BST_CHECKED) then MessageBox(Wnd,'Checked!','',0) else
17.           MessageBox(Wnd,'UnChecked!','',0)
18.         end;
19.    result:=CallWindowProc(Pointer(GetWindowLong(Wnd,GWL_USERDATA)),Wnd,uMsg,wParam,lParam);
20.  end;
21.  
22.  function BrowseCallback(Wnd:HWND; uMsg:DWORD; lParam:LPARAM; lpData:LPARAM ):integer; stdcall;
23.  var
24.   hwndCheck:HWND;
25.  begin
26.    if (uMsg=BFFM_INITIALIZED) then
27.    begin
28.     hwndCheck:=CreateWindow('BUTTON','MyCheckBox', BS_AUTOCHECKBOX or WS_CHILD or WS_VISIBLE,10,10,100,20,Wnd,id,hInstance,nil);
29.     SendMessage(hwndCheck,WM_SETFONT, GetStockObject(DEFAULT_GUI_FONT),1);
30.     SetWindowLong(Wnd,GWL_USERDATA,SetWindowLong(Wnd, DWL_DLGPROC, Integer(@NewDlgProc)));
31.    end;
32.    Result:=0;
33.  end;
34.  
35.  { TForm1 }
36.  
37. procedure TForm1.Button1Click(Sender: TObject);
38. var
39.   bi:TBrowseInfo;
40.   szDir:array[0..MAX_PATH-1] of char;
41.   pidl:PItemIDList;
42.   lpMalloc:IMalloc;
43. begin
44. if SUCCEEDED(SHGetMalloc(lpMalloc)) then
45.   begin
46.     ZeroMemory(@bi,sizeof(bi));
47.     bi.hwndOwner := Handle;
48.     bi.ulFlags := BIF_RETURNONLYFSDIRS or BIF_EDITBOX;
49.     bi.lpfn := @BrowseCallback;
50.     pidl := SHBrowseForFolder(@bi);
51.  
52.     if (pidl<>nil) then
53.       begin
54.         if SHGetPathFromIDList(pidl,szDir) then MessageBox(Handle,szDir,'Picked',0);
55.         lpMalloc.Free(pidl)
56.       end
57.   end
58. end;                                            

 

I receive an error

Incompatible type for arg no. 1: Got "Pointer", expected "<procedure variable type of function(LongWord,LongWord,LongInt,LongInt):LongInt;StdCall>"

on the line

Code: Pascal  [Select][+][-]

1. result:=CallWindowProc(Pointer(GetWindowLong(Wnd,GWL_USERDATA)),Wnd,uMsg,wParam,lParam);

Help solve the problem, please 

[Blaazen]

The error message says it, the first parameter is pointer but it must be function-variable, i.e. something like:

TFunc = function(A, B: LongWord; C, D: Integer): Integer;

EDIT: If the function GetWindowLong is compatible, you have to use @:

Code: [Select]

result:=CallWindowProc(@GetWindowLong,Wnd,uMsg,wParam,lParam);


[zoltanleo]

EDIT: If the function GetWindowLong is compatible, you have to use @:

Code: [Select]

result:=CallWindowProc(@GetWindowLong,Wnd,uMsg,wParam,lParam);


Failure. I changed the code and got this message

Error: Incompatible type for arg no. 1: Got "<address of function(LongWord,LongInt):LongInt;StdCall>", expected "<procedure variable type of function(LongWord,LongWord,LongInt,LongInt):LongInt;StdCall>"

compiler requires procedural type with four parameters 

[Blaazen]

OK, so this function is not compatible. I understand the error message but I have no idea about this window-centric code. So it's up to you - find a suitable function or define your own with extra - dummy - parameter.

[reinerr]

There's a couple of things your doing wrong, the main one is using DWL_DLGPROC(=4) instead of GWL_WNDPROC(=-4). According to the MSDN you should be able to use either (for a dialog) but I had problems with the former.

I'm not sure what your global id variable is for - debugging?

The following code seems to work for me (Laz/Typhon 64 on Win 7 64). Note my changes are commented with //rr. I'm also using GetWindowLongPtr/SetWindowLongPtr for 64-bit compatibility, which, according to MSDN, are available from Win2k as well so no reason not to use them.

Code: [Select]

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;
  //rr result:=CallWindowProc(Pointer(GetWindowLong(Wnd,GWL_USERDATA)),Wnd,uMsg,wParam,lParam);
  result := CallWindowProc({%H-}WNDPROC(GetWindowLongPtr(Wnd, GWL_USERDATA)),Wnd,uMsg,wParam,lParam);  //rr retrieve old dialog proc and call it
end;

function BrowseCallback(Wnd:HWND; uMsg:DWORD; {%H-}lParam:LPARAM; {%H-}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);
   //rr SetWindowLong(Wnd,GWL_USERDATA,SetWindowLong(Wnd, DWL_DLGPROC, Integer(@NewDlgProc)));
   SetWindowLongPtr(Wnd, GWL_USERDATA, GetWindowLongPtr(Wnd, GWL_WNDPROC)); //rr get old procedure and set to user data
   SetWindowLongPtr(Wnd, GWL_WNDPROC, {%H-}LONG_PTR(@NewDlgProc)); //rr change dialog proc
  end;
  Result:=0;
end;


[zoltanleo]

 2 Blaazen
thanks alot for participating

I'm not sure what your global id variable is for - debugging?

It's possible. This code I copied mechanically 

If you use the compiler directive {$ H-} locally in the procedure, the rest of the code can not use long lines (the compiler will generate an error, such as "Incompatible type ... Got" ShortString ", expected" LongInt "). I used this code

Code: Pascal  [Select][+][-]

1. {$H-}
2. ...
3. my window procedures
4. ...
5. {$H+}

I used your code. Here's what happened:

1. code change in function NewDlgPro causes a dialog box

but regular function SelectDirectory opens a window of another species

2. code change in function BrowseCallback not affect the call dialog

3. Very important! Then I do checked / unchecked for checkbox, always get the message "UnChecked". Thus always function IsDlgButtonChecked (Wnd, id) <> BST_CHECKED


What is wrong?

[reinerr]

If you use the compiler directive {$ H-} locally in the procedure, the rest of the code can not use long lines (the compiler will generate an error, such as "Incompatible type ... Got" ShortString ", expected" LongInt ").

I wasn't aware of there being an issue with using {%H-} locally - if there is you should file a bug report. I note however you said {$H-} instead, which is different. I don't like turning hints off for a range of code because that won't give me any hints if I might have a silly bug.

I used your code. Here's what happened:

I don't know why your project behaves differently. Mine displays the dialog similar to your second image with or without the check box. When I click the check box it does the right thing (checked and unchecked) - see attachment. Originally I tested it with Typhon64 4.8 FPC 2.7.1 but I just recompiled my code with Lazarus32 1.0.12 FPC 2.6.2 and they work the same (properly). Since these are a version later than yours and prior to yours respectively I can only imagine you didn't copy my changes properly. For you I've attached my complete project (unfortunately I couldn't include the working EXE as that makes the attachment too big).

2. code change in function BrowseCallback not affect the call dialog

The changed code in BrowseCallback is basically the same as yours but I just split it in 2, used 64-bit safe API calls and used GWL_WNDPROC instead of DWL_DLGPROC. When I used DWL_DLGPROC my dialogs didn't display properly. I must admit I didn't read the MSDN documentation properly and the function returns the previous value, which is why your code originally worked in just one line.

[zoltanleo]

I wasn't aware of there being an issue with using {%H-} locally - if there is you should file a bug report. I note however you said {$H-} instead, which is different. I don't like turning hints off for a range of code because that won't give me any hints if I might have a silly bug.

{%H-}<>{$H-} 
I have not found in google descriptions of the Directive {%H -}. What is it?

For you I've attached my complete project (unfortunately I couldn't include the working EXE as that makes the attachment too big).

Thank you very much. I will try to use this project.

When I used DWL_DLGPROC my dialogs didn't display properly.

I also tried to use these constants in your code in different variations. And often received AV.

OK. I'll see your code. Then write what happened.

[zoltanleo]

OK. I'll see your code. Then write what happened.

Hmmmm... So I opened your project and got this snow.
Perhaps correct operation depends on FPC or OS settings. I'll have to try FPC 2.7.1 and the latest version CodeTyphon.

And you have not tested this code on Linux?

[zoltanleo]

So I tried this code with different IDE (OS Win seven x32 or x64) and came to this conclusion:

1. For CodeTyphon 4.8 code corrected.

2. Lazarus 1.2 (1.2.2) with FPC 2.6.4 or FPC 2.7.1 the code is incorrect.

Tired, take a time-out 

Friends, thank you very much for your help. If I get the correct code for Lazarus, I will write it here.

[reinerr]

There is only one change I needed to make to get it to compile under Lazarus 1.0.12 and that was to return the declaration of a variable back to its original, namely as below. I had qualified it to reference the new unit it is in.

Code: [Select]

bi:TBrowseInfo;
This then compiled and ran fine, although it was now a 32-bit running in Win7 64-bit. I hope this is the solution to your "the code is incorrect" statement.

PS. The Lazarus version I used was older than yours and Typhon is basically released ahead of Lazarus so it works on an older and newer IDE to yours so I don't see why it shouldn't work for you.

[zoltanleo]

I spent a few experiments in VMWare. I received the following results:
1. Win 7 x32 (any updates OS is not installed), the code works for CodeTyphon 4.8 and Lazarus 1.2.2
2. Win7 x32 (part of OS updates installed possible) code does not work for CodeTyphon 4.8 and Lazarus 1.2.2
3. The basic system Win7 x64 (all updates are installed) code does not work for CodeTyphon 4.8 and Lazarus 1.2.2

 I don't understand what's the matter? 

The compiler generates this warning

Code: [Select]

Warning: Symbol "Tbrowseinfo" is deprecated
How to replace this structure on the "right"?