while browsing through the MSDN documentation, I stumbled across an interesting thing about subclassing.
After I played around with it a bit, I would like to share the current state with you....
Because of the additional parameters there are more possibilities than with the "old" function SetWindowLongPtr().
I still need to work out how it is best to use the two parameters uIdSubclass and dwRefData
But just look at the example and decide for yourself.
For starters, there is an article on MSDN that discusses the changes that occured in subclassing controls between version 6.0 and prior that you should be familiar with.
LINK : https://learn.microsoft.com/en-us/windo ... g-overview
and more descriptions and opinions ...
LINK : https://github.com/MicrosoftDocs/win32/ ... erview.md
LINK : https://devblogs.microsoft.com/oldnewthing/?p=41883
My code gets bigger and bigger but still can't cover all the possibilities....
So here is a small example code
Code: Select all
EnableExplicit
Import "Comctl32.lib"
; use the PureBasic Syntax (Windows API procedures using trailing underscore)
;
SetWindowSubclass_(hWnd, *fnSubclass, uIdSubclass, dwRefData) As "SetWindowSubclass"
GetWindowSubclass_(hWnd, *fnSubclass, uIdSubclass, *dwRefData) As "GetWindowSubclass"
RemoveWindowSubclass_(hWnd, *fnSubclass, uIdSubclass) As "RemoveWindowSubclass"
DefSubclassProc_(hWnd, uMsg, wParam, lParam) As "DefSubclassProc"
EndImport
Enumeration EWindow
#WINDOW_Main
EndEnumeration
Enumeration EGadget
#GADGET_Panel
#GADGET_Button1
#GADGET_Button2
#GADGET_Button3
#GADGET_Listview1
#GADGET_Listview2
EndEnumeration
#SUBCLAAS_Window = 1
#SUBCLAAS_Button = 2
; ---------------------------------------------------------------------------------------------------------------------
Macro Out(Message)
AddGadgetItem(#GADGET_Listview1, -1, Message)
SetGadgetState(#GADGET_Listview1, CountGadgetItems(#GADGET_Listview1)-1)
SetGadgetState(#GADGET_Listview1, -1)
Debug "OUT: " + Message
AddGadgetItem(#GADGET_Listview2, -1, Message)
SetGadgetState(#GADGET_Listview2, CountGadgetItems(#GADGET_Listview2)-1)
SetGadgetState(#GADGET_Listview2, -1)
EndMacro
; ---------------------------------------------------------------------------------------------------------------------
; SubclasssWindowProc ..
; ---------------------------------------------------------------------------------------------------------------------
Macro Debug(Message)
Debug " : " +
; #PB_Compiler_Procedure + " " +
LSet(Message, 20) +
RSet(Str(uIdSubclass), 4) +
RSet(Str(dwRefData), 6)
EndMacro
Procedure SubclassWindowProc(hWnd, uMsg, wParam, lParam, uIdSubclass, dwRefData)
Static pt.POINT, wr.RECT, hCursor = 0
Protected pt2.POINT
Select uMsg
Case #WM_NCDESTROY :Debug("WM_NCDESTROY")
;
; remove all defined subclass procedures
;
RemoveWindowSubclass_(hWnd, @SubclassWindowProc(), uIdSubclass)
Case #WM_NCLBUTTONDOWN ;:Debug("WM_NCLBUTTONDOWN")
If hCursor : SetCursor_(hCursor) : EndIf
Case #WM_MOUSEMOVE ;:Debug("WM_MOUSEMOVE")
If hCursor = 0 : hCursor = LoadCursor_(#Null, #IDC_HAND) : EndIf
If hCursor : SetCursor_(hCursor) : EndIf
If GetCapture_() = hWnd
GetCursorPos_(pt2)
SetWindowPos_(hWnd, 0, wr\left + (pt2\x - pt\x), wr\top + (pt2\y - pt\y), 0, 0, #SWP_NOSIZE|#SWP_NOZORDER|#SWP_NOREDRAW)
EndIf
Case #WM_LBUTTONDOWN :Debug("WM_LBUTTONDOWN")
SendMessage_(hWnd, #WM_NCLBUTTONDOWN, #HTCAPTION, 0)
Case #WM_LBUTTONUP :Debug("WM_LBUTTONUP")
ReleaseCapture_()
Case #WM_RBUTTONDOWN :Debug("WM_RBUTTONDOWN")
SetCapture_(hWnd)
GetCursorPos_(pt)
GetWindowRect_(hWnd, wr)
If hCursor : SetCursor_(hCursor) : EndIf
Case #WM_RBUTTONUP :Debug("WM_RBUTTONUP")
ReleaseCapture_()
EndSelect
ProcedureReturn DefSubclassProc_(hWnd, uMsg, wParam, lParam)
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure SubclassGadgetProc(hWnd, uMsg, wParam, lParam, uIdSubclass, dwRefData)
Protected *drawItem.DRAWITEMSTRUCT
Protected text.s, field.s, state
Protected textColor, brush ; for background
Select uMsg
Case #WM_NCDESTROY :Debug("WM_NCDESTROY")
;
; remove all defined subclass procedures
;
RemoveWindowSubclass_(hWnd, @SubclassGadgetProc(), uIdSubclass)
Case #WM_RBUTTONUP :Debug("WM_RBUTTONUP")
;
; uIdSubclass is #SUBCLASS_Gadget
;
PostEvent(#PB_Event_Gadget, GetActiveWindow(), GetDlgCtrlID_(hwnd), #PB_EventType_RightClick)
;
; here the use of uIdSubclass is possible (assigned #GADGET_ButtonX)
;
; PostEvent(#PB_Event_Gadget, GetActiveWindow(), uIdSubclass, #PB_EventType_RightClick)
;
; Debug " .. GetDlgCtrlID(hwnd) -> " + GetDlgCtrlID_(hwnd)
; Debug " .. GetProp(hwnd, 'PB_ID') -> " + GetProp_(hwnd, "PB_ID")
; Debug " .. uIdSubclass -> " + uIdSubclass
Case #WM_DRAWITEM ;:Debug("WM_DRAWITEM")
*drawItem = lParam ; type cast :)
; If wParam = #GADGET_Listview1 ; exact this listview
;
; here we can use uIdSubclass (assigned #GADGET_ListviewX)
;
If wParam = uIdSubclass ;:Debug("WM_DRAWITEM")
If *drawItem\itemID <> -1 ; And *drawItem\CtlType = #ODT_LISTBOX
text = GetGadgetItemText(wParam, *drawItem\itemID)
; make it look special (the reason why we do the drawing by ourselves.
If *drawItem\itemState & #ODS_SELECTED
brush = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT))
textColor = GetSysColor_(#COLOR_HIGHLIGHTTEXT)
Else
If *drawItem\itemID & $01
brush = CreateSolidBrush_(GetSysColor_(#COLOR_WINDOW))
Else
brush = CreateSolidBrush_(GetSysColor_(#COLOR_3DFACE))
EndIf
textColor = GetSysColor_(#COLOR_WINDOWTEXT)
EndIf
FillRect_(*drawItem\hdc, *drawItem\rcItem, brush)
DeleteObject_(brush) ; no longer needed
If *drawItem\itemState & #ODS_SELECTED
DrawFocusRect_(*drawItem\hdc, *drawItem\rcItem) ; needed if we let the default procedures work on this event
EndIf
SetTextColor_(*drawItem\hdc, textColor)
SetBkMode_(*drawItem\hdc, #TRANSPARENT)
; first column [30] is item index ...
field = RSet(Str(*drawItem\itemID), 4, "0") + ": "
TextOut_(*drawItem\hdc, *drawItem\rcItem\left+2, *drawItem\rcItem\top, @field, Len(field))
; second column [all] is entire item text
field = text
TextOut_(*drawItem\hdc, *drawItem\rcItem\left+40, *drawItem\rcItem\top, @field, Len(field))
; ProcedureReturn 0 ; don't let the default procedures work
EndIf
EndIf ; wParam = uIdSubclass
EndSelect
ProcedureReturn DefSubclassProc_(hWnd, uMsg, wParam, lParam) ; do the chain procedures
EndProcedure
; ---------------------------------------------------------------------------------------------------------------------
Procedure main()
Protected RefData ; for testing
If OpenWindow(#WINDOW_Main, 0, 0, 640, 480, "Move window with mouse while holding left mouse button", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
StickyWindow(#WINDOW_Main, 1) ; always on top :)
PanelGadget(#GADGET_Panel, 32, 16, 600, 200)
AddGadgetItem(#GADGET_Panel, -1, "Panel 1")
ButtonGadget(#GADGET_Button1, 8, 8, 96, 24, "Button 1")
AddGadgetItem(#GADGET_Panel, -1, "Panel 2")
ButtonGadget(#GADGET_Button2, 8, 8, 96, 24, "Button 2")
AddGadgetItem(#GADGET_Panel, -1, "Panel 3")
ListViewGadget(#GADGET_Listview1, 8, 8, 584, 184, #LBS_OWNERDRAWFIXED|#LBS_HASSTRINGS)
CloseGadgetList() ; Panel
ButtonGadget(#GADGET_Button3, 32, 224, 96, 24, "Button 3")
ListViewGadget(#GADGET_Listview2, 136, 224, 240, 200, #LBS_OWNERDRAWFIXED|#LBS_HASSTRINGS)
; Window
SetWindowSubclass_(WindowID(#WINDOW_Main), @SubclassWindowProc(), #SUBCLAAS_Window, 100) ;
;SetWindowSubclass_(GetParent_(GadgetID(#GADGET_Button1)), @SubclassWindowProc(), #SUBCLAAS_Button, 101) ;
SetWindowSubclass_(GadgetID(#GADGET_Button1), @SubclassGadgetProc(), #SUBCLAAS_Button, 101) ;
SetWindowSubclass_(GadgetID(#GADGET_Button2), @SubclassGadgetProc(), #SUBCLAAS_Button, 102) ;
SetWindowSubclass_(GadgetID(#GADGET_Button3), @SubclassGadgetProc(), #SUBCLAAS_Button, 103) ;
; use the #GADGET_Xxxx to determine the gadget we want work with
;
SetWindowSubclass_(GetParent_(GadgetID(#GADGET_Listview1)), @SubclassGadgetProc(), #GADGET_Listview1, 110) ;
SetWindowSubclass_(GetParent_(GadgetID(#GADGET_Listview2)), @SubclassGadgetProc(), #GADGET_Listview2, 111) ;
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow : Break ; say good bye.
Case #PB_Event_Gadget
Select EventGadget()
Case #GADGET_Button1
Select EventType()
Case #PB_EventType_LeftClick : Out("Left Click Button 1")
Case #PB_EventType_RightClick : Out("Right Click Button 1")
EndSelect
Case #GADGET_Button2
Select EventType()
Case #PB_EventType_LeftClick : Out("Left Click Button 2")
Case #PB_EventType_RightClick : Out("Right Click Button 2")
EndSelect
Case #GADGET_Button3
Select EventType()
Case #PB_EventType_LeftClick : Out("Left Click Button 3")
If GetWindowSubclass_(GetParent_(GadgetID(#GADGET_Listview1)), @SubclassGadgetProc(), #GADGET_Listview1, @RefData)
Debug "OUT: RefData (110) == " + RefData
EndIf
Case #PB_EventType_RightClick : Out("Right Click Button 3")
EndSelect
EndSelect
EndSelect
ForEver
EndIf
EndProcedure
End main()
Happy coding and stay healthy.