- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
The following code is included in a dialog subclassing module I have used successfully in the 32-bit configuration of the application:
integer(HANDLE) :: hTabDlgProc(7)
!DEC$ IF DEFINED (WIN64)
hTabDlgProc(2) = SetWindowLongPtr(gdlg_tab2%hWnd, DWL_DLGPROC, LOC(Tab2DlgProc))
!DEC$ ELSE
hTabDlgProc(2) = SetWindowLong(gdlg_tab2%hWnd, DWL_DLGPROC, LOC(Tab2DlgProc))
!DEC$ ENDIF
The function referred to in the LOC() functionis defined as follows:
function Tab2DlgProc(hDlg, message, wParam, lParam)
!DEC$ ATTRIBUTES STDCALL :: Tab2DlgProc
use dfwin
implicit none
! Arguments
integer(SINT) :: Tab2DlgProc ! Declare the function
integer(HANDLE) :: hDlg ! Integer identifying the window handle of the dialog box
integer(UINT) :: message ! Integer identifying the window message
integer(fWPARAM) :: wParam ! message-specific information
integer(fLPARAM) :: lParam ! message-specific information
The SetWindowLong function returns a value in 32-bit version but returns zero in the64-bit versionwhere SetWindowLongPtr is required. Any ideas why this is? I suspect the function declaration:
integer(SINT) :: Tab2DlgPoc
If anyonecan help with this it will be most appreciated.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Not that it is relevant to your current discussion, but I think you should ensure that you pass on messages that you do not process inside the IF block and move the 'end select' and include a CASE DEFAULT to pas on all other messages
No, his code structure is fine: there's a RETURN statement within CASE (WM_CTLCOLOR...), so it comes down to the same thing. Like you, Tony, I prefer the CASE DEFAULT, but he's fine as it is.
However, there are two other issues:
1) As I hinted above, try replacing DWL_DLGPROC with GWL_WNDPROC in the call to SetWindowLong(Ptr). I'm not sure how it ever worked in Win32, but it apparently does not in Win64.
2) You have a massive GDI leak -- every while you CreateSolidBrush, but never DeleteObject. Unfortunately, you need to go through some hoops to correctly create and delete the brushes, along the lines of:
[fortran]integer(HANDLE), save:: hPinkBrush = 0 .... case (WM_COLORSTATIC) !Create the brush only once, first time we enter here: if (hPinkBrush==0) hPinkBrush = CreateSolidBrush(...) ... Tab2DlgProc = hPinkBrush case (WM_DESTROY) iret = DeleteObject(hBrush) iret = CallWindowProc(...)[/fortran]
I must say that the whole WM_CTLCOLOR* mechanism sucks, and it's probably a leftover from some GDI structure at Windows 3.1. They could have had WM_SETCOLOR (of which, IIRC, only PBM_SETCOLOR and another one exist), but we're apparently stuck with this...
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
I'm confused by your description. You should use SetWindowLongPtr in both architectures. The return type of the dialog procedure does not matter (or rather, (SINT) is correct.)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Steve,
In my original code, writtenfor CVF, I utilisedSetWindowLong() and this worked fine. When I tried SetWndowLongPtr() the code would not compile. When I moved over to IVF and tried to compile the 64-bit config I got a message relating to the SetWindowLong() function having mis-matched arguments, supporting your statement above. I kept the original function in so that the code would still compile with CVF and as it also works OKfor 32-bit IVF. Unfortunately when I run the 64-bit config, the debugger shows a zero return from SetWindowLongPtr(), presumably indicating a problem.
What other reason would this function fail?
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hm. As far as I know, you aren't supposed to change the dialog procedure (the thingo returned by DWL_DLGPROC) in run-time. You can change the window procedure (the thingo returned by GWL_WNDPROC). Maybe Win32 lets you do that, but -- I think correctly -- Win64 won't.
Well, not sure how it worked in win32 in the first place -- maybe it would for some simple cases. From your subclassing procedure, do you CallWindowProc or return true/false?
For an explanation of differences between dialog procedure and window procedure, see this recent post of mine.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
[fortran]Jugoslav, I use CallWindowProc as shown below.[/fortran]
[fortran][/fortran]
[fortran]function Tab2DlgProc(hDlg, message, wParam, lParam) !DEC$ ATTRIBUTES STDCALL :: Tab2DlgProc use dfwin implicit none ! Arguments integer(SINT) :: Tab2DlgProc ! Declare the function integer(HANDLE) :: hDlg ! Integer identifying the window handle of the dialog box integer(UINT) :: message ! Integer identifying the window message integer(fWPARAM) :: wParam ! message-specific information integer(fLPARAM) :: lParam ! message-specific information ! Local Variables integer(HANDLE) :: hWndControl integer(HANDLE) :: hDCControl integer(HANDLE) :: ret, hbkcolor integer :: j ! delete any existing brush created earlier if(hTabBackbrush(2).ne.0) then ret = DeleteObject(hTabBackbrush(2)) endif select case (message) ! Dialog box drawing message - create PURPLE background case (WM_CTLCOLOREDIT,WM_CTLCOLORSTATIC) ! Edit Control hdcControl = wparam hwndControl = lparam ! Use hwndControl to identify the control do j = 1 , nCtrl if(hWndControl.eq.hCtr(j).and.cTyp(j).eq.message) then hTabBackbrush(2) = CreateSolidBrush(RGB(int1(cBkRGB(j,1)),int1(cBkRGB(j,2)),int1(cBkRGB(j,3)))) ! Create a brush hbkcolor = MSFWIN$SetBKColor(hdcControl,RGB(int1(cBkRGB(j,1)),int1(cBkRGB(j,2)),int1(cBkRGB(j,3)))) ! Set the text background Tab2DlgProc = hTabBackbrush(2) ! return the window background brush handle immediately return endif enddo end select ! pass all other messages on to the default window procedure Tab2DlgProc = CallWindowProc(hTabDlgProc(2), hDlg, message, wParam, lParam) return end function Tab2DlgProc [/fortran]
[fortran]Are you suggesting an alternative method?[/fortran]
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Not that it is relevant to your current discussion, but I think you should ensure that you pass on messages that you do not process inside the IF block and move the 'end select' and include a CASE DEFAULT to pas on all other messages, as follows
select case (message)
! Dialog box drawing message - create PURPLE background
case (WM_CTLCOLOREDIT,WM_CTLCOLORSTATIC)
Do...
if...
else
! If neither of these control messages are processed inside this if block,
! pass them on to the default window procedure
Tab2DlgProc = CallWindowProc(hTabDlgProc(2), hDlg, message, wParam, lParam)
end if...
end do
case default
! pass all other messages on to the default window procedure
Tab2DlgProc = CallWindowProc(hTabDlgProc(2), hDlg, message, wParam, lParam)
end select
return
end function
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Not that it is relevant to your current discussion, but I think you should ensure that you pass on messages that you do not process inside the IF block and move the 'end select' and include a CASE DEFAULT to pas on all other messages
No, his code structure is fine: there's a RETURN statement within CASE (WM_CTLCOLOR...), so it comes down to the same thing. Like you, Tony, I prefer the CASE DEFAULT, but he's fine as it is.
However, there are two other issues:
1) As I hinted above, try replacing DWL_DLGPROC with GWL_WNDPROC in the call to SetWindowLong(Ptr). I'm not sure how it ever worked in Win32, but it apparently does not in Win64.
2) You have a massive GDI leak -- every while you CreateSolidBrush, but never DeleteObject. Unfortunately, you need to go through some hoops to correctly create and delete the brushes, along the lines of:
[fortran]integer(HANDLE), save:: hPinkBrush = 0 .... case (WM_COLORSTATIC) !Create the brush only once, first time we enter here: if (hPinkBrush==0) hPinkBrush = CreateSolidBrush(...) ... Tab2DlgProc = hPinkBrush case (WM_DESTROY) iret = DeleteObject(hBrush) iret = CallWindowProc(...)[/fortran]
I must say that the whole WM_CTLCOLOR* mechanism sucks, and it's probably a leftover from some GDI structure at Windows 3.1. They could have had WM_SETCOLOR (of which, IIRC, only PBM_SETCOLOR and another one exist), but we're apparently stuck with this...
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Juguslav,
Replacing DWL_DLGPROC with GWL_WNDPROC did the trick. With regard to the GDI memory leak I destroy the brush objects in the DLG_DESTROY segment of the dialog callback. The handles are stored globally within the module so that this can be done.
Thanks
Steve (dannycat)

- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page