Based on the code I got from here I'm trying to move a border (made from a UC) around the selected sub-items of a ListView. As mentioned in a following post in the same thread I'm using nmcdr.nmcd.rc as the values I need for the location and size of the border but it appears from many testings that this approach is not dependable as I get erroneous results. About the only thing that is correct is the .Left value while the others; .Top, .Right, and .Bottom values are totally out of scope.
Here is the code snippet from that other thread that I am using:
Code:
Public Function LVWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Select Case uMsg
Case WM_NOTIFY
Dim tNMH As NMHDR
CopyMemory tNMH, ByVal lParam, Len(tNMH)
Select Case tNMH.Code
Case NM_CLICK
If gOnMO = False Then
Dim LVHTI As LVHITTESTINFO
Dim nmia As NMITEMACTIVATE
CopyMemory nmia, ByVal lParam, LenB(nmia)
LVHTI.pt.x = nmia.PTAction.x
LVHTI.pt.y = nmia.PTAction.y
SendMessage Form1.ListView1.hWnd, LVM_SUBITEMHITTEST, 0&, LVHTI
If (LVHTI.Flags And LVHT_ONITEM) Then
gLastItem = gHighlight
gHighlight = LVHTI.iItem
gHighlightSub = nmia.iSubitem
Else
gHighlight = -1: gHighlightSub = -1
End If
RedrawList Form1.ListView1.hWnd
End If
Case NM_CUSTOMDRAW
Dim ItemX As Long
Dim ItemY As Long
Dim ItemW As Long
Dim ItemH As Long
Dim nmcdr As NMLVCUSTOMDRAW
CopyMemory nmcdr, ByVal lParam, LenB(nmcdr)
Select Case nmcdr.nmcd.dwDrawStage
Case CDDS_ITEMPOSTPAINT
' -- use the nmcdr.nmcd members for drawing, i.e., the .Hdc & .Rc members
Exit Function
Case (CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM)
' -- use the nmcdr.nmcd members for drawing, i.e., the .Hdc & .Rc members
Exit Function
Case CDDS_PREPAINT
LVWndProc = CDRF_NOTIFYITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
LVWndProc = CDRF_NOTIFYSUBITEMDRAW Or CDRF_NEWFONT Or CDRF_NOTIFYPOSTPAINT
Exit Function
Case (CDDS_ITEMPREPAINT Or CDDS_SUBITEM)
If gHighlightSub > 0 Then
If (nmcdr.nmcd.dwItemSpec = gHighlight) And (nmcdr.iSubitem = gHighlightSub) Then
If gSetBk Then
nmcdr.clrTextBk = vbYellow
ItemX = nmcdr.nmcd.rc.Left
ItemY = nmcdr.nmcd.rc.Top
ItemW = nmcdr.nmcd.rc.Right
ItemH = nmcdr.nmcd.rc.Bottom
Form1.UC_Border.Move ItemX, ItemY, ItemW, ItemH
End If
If gSetTxt Then
nmcdr.clrText = vbRed
End If
Else
If gSetBk Then nmcdr.clrTextBk = vbWhite
If gSetTxt Then nmcdr.clrText = vbBlack
End If
CopyMemory ByVal lParam, nmcdr, LenB(nmcdr)
LVWndProc = CDRF_NEWFONT Or CDRF_NOTIFYPOSTPAINT
'LVWndProc = CDRF_NEWFONT
Exit Function
End If
End Select
End Select
Case WM_DESTROY
Call UnSubclass(hWnd, PtrLVWndProc)
End Select
LVWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
Now I could put this code (bold red) in the other Case statements, Case CDDS_ITEMPOSTPAINT and Case (CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM), as it was suggested to do so but that doesn't change anything and the values still come out wrong
1. With more complex code, it is often better to post a short working example. Don't expect people to go to different threads and try to cobble together code that you may or may not be using.
2. Along with those red items, you should also debug.print out gHighlight & gHighlightSub for validation; just for completeness
3. The .Right member of a RECT structure is not the Width and .Bottom member is not the Height.
I am getting valid values. When I do this, using my own code, here are some debug.print results
I don't know what code you're using to get those values but I'm using the same code as I posted above and here are the results of the Debug.Print in each of the three Case statements I get when I click on the 0 item in Subitem 1. Only in the 2nd and 3rd Cases are the .Left and .Right values correct otherwise all other values are meaningless. My Form is in vbPixels.
If I run the Project again I will get completely different values except where I noted the correct values
I understand the gHighlight and gHighlightSub values but for what reason would they be needed
The RECT structure that describes the bounding rectangle of the area being drawn. This member is initialized only by the CDDS_ITEMPREPAINT notification. Version 5.80. This member is also initialized by the CDDS_PREPAINT notification.
Your code
Code:
Case CDDS_ITEMPREPAINT
LVWndProc = CDRF_NOTIFYSUBITEMDRAW Or CDRF_NEWFONT Or CDRF_NOTIFYPOSTPAINT
Exit Function
Case (CDDS_ITEMPREPAINT Or CDDS_SUBITEM)
If gHighlightSub > 0 Then
If (nmcdr.nmcd.dwItemSpec = gHighlight) And (nmcdr.iSubitem = gHighlightSub) Then
If gSetBk Then
nmcdr.clrTextBk = vbYellow
ItemX = nmcdr.nmcd.rc.Left
ItemY = nmcdr.nmcd.rc.Top
ItemW = nmcdr.nmcd.rc.Right
ItemH = nmcdr.nmcd.rc.Bottom
Form1.UC_Border.Move ItemX, ItemY, ItemW, ItemH
End If
Try dumping the rect in Case CDDS_ITEMPREPAINT not Case (CDDS_ITEMPREPAINT Or CDDS_SUBITEM)
For the case of CDDS_ITEMPREPAINT Or CDDS_SUBITEM you have to use a previously preserved rectangle (from CDDS_ITEMPREPAINT) but for this to work your WndProc (or SubclassProc) has to call back into the form the subclassed listview is placed on (and only a simple redirector being in a standard bas module), so you can save state for this particular listview between different notification.
I don't know what code you're using to get those values but I'm using the same code as I posted above and here are the results of the Debug.Print in each of the three Case statements I get when I click on the 0 item in Subitem 1. Only in the 2nd and 3rd Cases are the .Left and .Right values correct otherwise all other values are meaningless.
What code am I using? The correct code obviously. I'd venture to say that all your values are meaningless. Personally, I won't comment on your code any further without seeing a posted sample project. If we can get the RECT values correctly and you can't, then it is something in your code (and I have my guesses). We need to see your project, not sample statements that should work in other projects but doesn't in yours.
Insomnia is just a byproduct of, "It can't be done"
Except for the Debug statements and two Case statements the entire project is the same as what fafalone posted in the other thread
Form code
Code:
Option Explicit
Private Sub Check1_Click()
If gSetTxt = True Then
gSetTxt = False
Else
gSetTxt = True
End If
ListView1.Refresh
End Sub
Private Sub Check2_Click()
If gSetBk = True Then
gSetBk = False
Else
gSetBk = True
End If
ListView1.Refresh
End Sub
Private Sub Check3_Click()
If gOnMO = True Then
gOnMO = False
Else
gOnMO = True
End If
ListView1.Refresh
End Sub
Private Sub Form_Load()
gSetBk = True
gHighlight = -1
gHighlightSub = -1
ListView1.View = lvwReport
ListView1.ColumnHeaders.Add , , "Column 0"
ListView1.ColumnHeaders.Add , , "Column 1"
ListView1.ColumnHeaders.Add , , "Column 2"
ListView1.ColumnHeaders.Add , , "Column 3"
Dim lvi As ListItem
Set lvi = ListView1.ListItems.Add(, , "Item 1")
lvi.SubItems(1) = "Subitem 1.1"
lvi.SubItems(2) = "Subitem 1.2"
lvi.SubItems(3) = "Subitem 1.3"
Set lvi = ListView1.ListItems.Add(, , "Item 2")
lvi.SubItems(1) = "Subitem 2.1"
lvi.SubItems(2) = "Subitem 2.2"
lvi.SubItems(3) = "Subitem 2.3"
Set lvi = ListView1.ListItems.Add(, , "Item 3")
lvi.SubItems(1) = "Subitem 3.1"
lvi.SubItems(2) = "Subitem 3.2"
lvi.SubItems(3) = "Subitem 3.3"
Set lvi = ListView1.ListItems.Add(, , "Item 4")
lvi.SubItems(1) = "Subitem 4.1"
lvi.SubItems(2) = "Subitem 4.2"
lvi.SubItems(3) = "Subitem 4.3"
Set lvi = ListView1.ListItems.Add(, , "Item 5")
lvi.SubItems(1) = "Subitem 5.1"
lvi.SubItems(2) = "Subitem 5.2"
lvi.SubItems(3) = "Subitem 5.3"
Set lvi = ListView1.ListItems.Add(, , "Item 6")
lvi.SubItems(1) = "Subitem 6.1"
lvi.SubItems(2) = "Subitem 6.2"
lvi.SubItems(3) = "Subitem 6.3"
Set lvi = ListView1.ListItems.Add(, , "Item 7")
lvi.SubItems(1) = "Subitem 7.1"
lvi.SubItems(2) = "Subitem 7.2"
lvi.SubItems(3) = "Subitem 7.3"
Set lvi = ListView1.ListItems.Add(, , "Item 8")
lvi.SubItems(1) = "Subitem 8.1"
lvi.SubItems(2) = "Subitem 8.2"
lvi.SubItems(3) = "Subitem 8.3"
Set lvi = ListView1.ListItems.Add(, , "Item 9")
lvi.SubItems(1) = "Subitem 9.1"
lvi.SubItems(2) = "Subitem 9.2"
lvi.SubItems(3) = "Subitem 9.3"
Subclass Form1.hWnd, AddressOf LVWndProc
End Sub
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
SetOnMouseMove x / Screen.TwipsPerPixelX, y / Screen.TwipsPerPixelY
End Sub
.BAS code
Code:
Option Explicit
Public gSetBk As Boolean
Public gSetTxt As Boolean
Public gOnMO As Boolean
Public gHighlight As Long
Public gHighlightSub As Long
Public gLastItem As Long
Private Declare Function DefSubclassProc Lib "comctl32.dll" Alias "#413" (ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowSubclass Lib "comctl32.dll" Alias "#410" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long, Optional ByVal dwRefData As Long) As Long
Private Declare Function RemoveWindowSubclass Lib "comctl32.dll" Alias "#412" (ByVal hWnd As Long, ByVal pfnSubclass As Long, ByVal uIdSubclass As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const LVM_FIRST = &H1000
Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
Private Const LVM_HITTEST = (LVM_FIRST + 18)
Private Const LVM_SUBITEMHITTEST = (LVM_FIRST + 57)
Private Const LVM_REDRAWITEMS = (LVM_FIRST + 21)
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type LVHITTESTINFO
pt As POINTAPI
Flags As LVHT_Flags
iItem As Long
iSubitem As Long
iGroup As Long
End Type
Private Enum LVHT_Flags
LVHT_NOWHERE = &H1 ' in LV client area, but not over item
LVHT_ONITEMICON = &H2
LVHT_ONITEMLABEL = &H4
LVHT_ONITEMSTATEICON = &H8
LVHT_ONITEM = (LVHT_ONITEMICON Or LVHT_ONITEMLABEL Or LVHT_ONITEMSTATEICON)
'outside the LV's client area
LVHT_ABOVE = &H8
LVHT_BELOW = &H10
LVHT_TORIGHT = &H20
LVHT_TOLEFT = &H40
LVHT_EX_GROUP_HEADER = &H10000000
LVHT_EX_GROUP_FOOTER = &H20000000
LVHT_EX_GROUP_COLLAPSE = &H40000000
LVHT_EX_GROUP_BACKGROUND = &H80000000
LVHT_EX_GROUP_STATEICON = &H1000000
LVHT_EX_GROUP_SUBSETLINK = &H2000000
LVHT_EX_GROUP = (LVHT_EX_GROUP_BACKGROUND Or LVHT_EX_GROUP_COLLAPSE Or LVHT_EX_GROUP_FOOTER Or LVHT_EX_GROUP_HEADER Or LVHT_EX_GROUP_STATEICON Or LVHT_EX_GROUP_SUBSETLINK)
LVHT_EX_ONCONTENTS = &H4000000 'On item AND not on the background
LVHT_EX_FOOTER = &H8000000
End Enum
Private Const WM_NOTIFY = &H4E
Private Const WM_MOUSEMOVE = (&H200)
Private Const WM_DESTROY = &H2
Private Const NM_FIRST As Long = 0&
Private Const NM_CUSTOMDRAW As Long = NM_FIRST - 12&
Private Const NM_CLICK As Long = NM_FIRST - 2& 'uses NMCLICK struct
Private Type NMHDR
hWndFrom As Long ' Window handle of control sending message
IDFrom As Long ' Identifier of control sending message
Code As Long ' Specifies the notification code
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type NMCUSTOMDRAW
hdr As NMHDR
dwDrawStage As Long
hDC As Long
rc As RECT
dwItemSpec As Long
uItemState As Long
lItemlParam As Long
End Type
Private Type NMLVCUSTOMDRAW
nmcd As NMCUSTOMDRAW
clrText As Long
clrTextBk As Long
iSubitem As Long
End Type
Private Type NMITEMACTIVATE
hdr As NMHDR
iItem As Long
iSubitem As Long
uNewState As Long
uOldState As Long
uChanged As Long
PTAction As POINTAPI
lParam As Long
uKeyFlags As Long
End Type
Private Const CDDS_PREPAINT As Long = &H1&
Private Const CDDS_POSTPAINT As Long = &H2&
Private Const CDDS_ITEM As Long = &H10000
Private Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
Private Const CDDS_ITEMPOSTPAINT As Long = (CDDS_ITEM Or CDDS_POSTPAINT) 'OG
Private Const CDDS_SUBITEM = &H20000
Private Const CDRF_NOTIFYITEMDRAW As Long = &H20&
Private Const CDRF_NOTIFYSUBITEMDRAW = &H20
Private Const CDRF_NEWFONT As Long = &H2&
Public Function Subclass(hWnd As Long, lpfn As Long) As Long
Subclass = SetWindowSubclass(hWnd, lpfn, 0)
End Function
Public Function UnSubclass(hWnd As Long, lpfn As Long) As Long
UnSubclass = RemoveWindowSubclass(hWnd, lpfn, 0)
End Function
Private Sub RedrawList(hLVS As Long)
Dim ct As Long
ct = SendMessage(hLVS, LVM_GETITEMCOUNT, 0&, ByVal 0&)
SendMessage hLVS, LVM_REDRAWITEMS, 0&, ByVal ct
End Sub
Public Sub SetOnMouseMove(px As Long, py As Long)
If gOnMO = True Then
Dim nOld As Long
nOld = gHighlight
Dim LVHTI As LVHITTESTINFO
LVHTI.pt.x = px
LVHTI.pt.y = py
SendMessage Form1.ListView1.hWnd, LVM_SUBITEMHITTEST, 0&, LVHTI
If (LVHTI.Flags And LVHT_ONITEM) Then
gHighlight = LVHTI.iItem
gHighlightSub = LVHTI.iSubitem
Else
gHighlight = -1: gHighlightSub = -1
End If
If nOld <> -1 Then
SendMessage Form1.ListView1.hWnd, LVM_REDRAWITEMS, nOld, ByVal nOld
End If
If gHighlight <> -1 Then
SendMessage Form1.ListView1.hWnd, LVM_REDRAWITEMS, gHighlight, ByVal gHighlight
End If
End If
End Sub
Public Function LVWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Select Case uMsg
Case WM_NOTIFY
Dim tNMH As NMHDR
CopyMemory tNMH, ByVal lParam, Len(tNMH)
Select Case tNMH.Code
Case NM_CLICK
If gOnMO = False Then
Dim LVHTI As LVHITTESTINFO
Dim nmia As NMITEMACTIVATE
CopyMemory nmia, ByVal lParam, LenB(nmia)
LVHTI.pt.x = nmia.PTAction.x
LVHTI.pt.y = nmia.PTAction.y
SendMessage Form1.ListView1.hWnd, LVM_SUBITEMHITTEST, 0&, LVHTI
If (LVHTI.Flags And LVHT_ONITEM) Then
gLastItem = gHighlight
gHighlight = LVHTI.iItem
gHighlightSub = nmia.iSubitem
Else
gHighlight = -1: gHighlightSub = -1
End If
RedrawList Form1.ListView1.hWnd
End If
Case NM_CUSTOMDRAW
Dim nmcdr As NMLVCUSTOMDRAW
CopyMemory nmcdr, ByVal lParam, LenB(nmcdr)
Select Case nmcdr.nmcd.dwDrawStage
Case CDDS_ITEMPOSTPAINT
' -- use the nmcdr.nmcd members for drawing, i.e., the .Hdc & .Rc members
'Debug.Print nmcdr.nmcd.rc.Left
'Debug.Print nmcdr.nmcd.rc.Top
'Debug.Print nmcdr.nmcd.rc.Right
'Debug.Print nmcdr.nmcd.rc.Bottom
'Debug.Print gHighlight
'Debug.Print gHighlightSub
Exit Function
Case (CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM)
' -- use the nmcdr.nmcd members for drawing, i.e., the .Hdc & .Rc members
'Debug.Print nmcdr.nmcd.rc.Left
'Debug.Print nmcdr.nmcd.rc.Top
'Debug.Print nmcdr.nmcd.rc.Right
'Debug.Print nmcdr.nmcd.rc.Bottom
'Debug.Print gHighlight
'Debug.Print gHighlightSub
Exit Function
Case CDDS_PREPAINT
Debug.Print nmcdr.nmcd.rc.Left
Debug.Print nmcdr.nmcd.rc.Top
Debug.Print nmcdr.nmcd.rc.Right
Debug.Print nmcdr.nmcd.rc.Bottom
Debug.Print gHighlight
Debug.Print gHighlightSub
LVWndProc = CDRF_NOTIFYITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
'Debug.Print nmcdr.nmcd.rc.Left
'Debug.Print nmcdr.nmcd.rc.Top
'Debug.Print nmcdr.nmcd.rc.Right
'Debug.Print nmcdr.nmcd.rc.Bottom
'Debug.Print gHighlight
'Debug.Print gHighlightSub
LVWndProc = CDRF_NOTIFYSUBITEMDRAW Or CDRF_NEWFONT
Exit Function
Case (CDDS_ITEMPREPAINT Or CDDS_SUBITEM)
'Debug.Print nmcdr.nmcd.rc.Left
'Debug.Print nmcdr.nmcd.rc.Top
'Debug.Print nmcdr.nmcd.rc.Right
'Debug.Print nmcdr.nmcd.rc.Bottom
'Debug.Print gHighlight
'Debug.Print gHighlightSub
If gHighlightSub > 0 Then
If (nmcdr.nmcd.dwItemSpec = gHighlight) And (nmcdr.iSubitem = gHighlightSub) Then
If gSetBk Then nmcdr.clrTextBk = vbYellow
If gSetTxt Then nmcdr.clrText = vbRed
Else
If gSetBk Then nmcdr.clrTextBk = vbWhite
If gSetTxt Then nmcdr.clrText = vbBlack
End If
CopyMemory ByVal lParam, nmcdr, LenB(nmcdr)
LVWndProc = CDRF_NEWFONT
Exit Function
End If
End Select
End Select
Case WM_DESTROY
Call UnSubclass(hWnd, PtrLVWndProc)
End Select
LVWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
Private Function PtrLVWndProc() As Long
PtrLVWndProc = FARPROC(AddressOf LVWndProc)
End Function
Private Function FARPROC(pfn As Long) As Long
FARPROC = pfn
End Function
The biggest problem you have is that your subclass procedure does not filter which hWnds are listview hWnds and which are not. Since the form is subclassed, it gets WM_NOTIFY messages from other stuff besides the listview.
A quick fix would look like this, but is not ideal. You'll want a workaround that does not include referencing non-bas items. Maybe you'll want to use SetProp API or a collection or other methods to distinguish what is sending your form a WM_NOTIFY message. In your sample project, the checkboxes & listivew headers are also sending that message which is what got you confused to begin with. Just a thought.
In your subclass procedure, add this. The last line shown below is the quick fix.
Code:
Case WM_NOTIFY
Dim tNMH As NMHDR
CopyMemory tNMH, ByVal lParam, LenB(tNMH)
If tNMH.hWndFrom <> Form1.ListView1.hWnd Then GoTo exitRoutine
...
Oh, tweak end of routine like so:
Code:
...
End Select
exitRoutine:
LVWndProc = DefSubclassProc(hWnd, uMsg, wParam, lParam)
End Function
edited: expanding on one of the possible workarounds
Code:
Public Declare Function SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Public Declare Function GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
-- in form load before subclassing: SetProp ListView1.hwnd, "CtrlType", 1
:: that 1 in above call, we'll say that 1 = ListView, 2+ = something else for expansion as needed
-- replace quick-fix line in previous example with
Code:
If GetProp(tNMH.hWndFrom, "CtrlType") <> 1 Then GoTo exitRoutine
FYI: Per MSDN, SetProp should be removed with RemoveProp before window is destroyed
Last edited by LaVolpe; Aug 2nd, 2020 at 03:16 PM.
Insomnia is just a byproduct of, "It can't be done"
Nope, done of that stuff made any difference. Same results as I pointed out in post 8
It works, you are not understanding the results
That rect size of 525x118 is the entire visible listview. If you were to debug.print the rect structure during item pre/post paint, you should get the sizes for the specific cells. Think of PREPAINT as the entire listview, ItemPREPAINT/POSTPAINT as a single cell.
Edited:
I use CDDS_PREPAINT to determine if I want to customize any items in the listview
- If Yes, then I return CDRF_NOTIFYITEMDRAW which sends more messages
I use CDDS_ITEMPREPAINT, (CDDS_ITEMPREPAINT Or CDDS_SUBITEM) to determine if I want postpaint messages
- If Yes, then I return CDRF_NOTIFYPOSTPAINT whether or not I'm also returning CDRF_NOTIFYSUBITEMDRAW, CDRF_NEWFONT
Last edited by LaVolpe; Aug 2nd, 2020 at 05:55 PM.
Insomnia is just a byproduct of, "It can't be done"
for testing, how about replacing your subclass procedure with this and see what results you get?
Code:
Public Function LVWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As Long) As Long
Select Case uMsg
Case WM_NOTIFY
Dim tNMH As NMHDR
CopyMemory tNMH, ByVal lParam, Len(tNMH)
If tNMH.hWndFrom <> Form1.ListView1.hwnd Then GoTo exitRoutine
Select Case tNMH.Code
Case NM_CUSTOMDRAW
Dim nmcdr As NMLVCUSTOMDRAW
CopyMemory nmcdr, ByVal lParam, LenB(nmcdr)
Select Case nmcdr.nmcd.dwDrawStage
Case CDDS_ITEMPOSTPAINT
' -- use the nmcdr.nmcd members for drawing, i.e., the .Hdc & .Rc members
Exit Function
Case (CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM)
' -- use the nmcdr.nmcd members for drawing, i.e., the .Hdc & .Rc members
Exit Function
Case CDDS_PREPAINT
LVWndProc = CDRF_NOTIFYITEMDRAW Or CDRF_NOTIFYSUBITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
LVWndProc = CDRF_NOTIFYSUBITEMDRAW
Exit Function
Case (CDDS_ITEMPREPAINT Or CDDS_SUBITEM)
Debug.Print nmcdr.nmcd.dwItemSpec + 1; nmcdr.iSubitem
Debug.Print vbTab; nmcdr.nmcd.rc.Left;
Debug.Print nmcdr.nmcd.rc.Top;
Debug.Print nmcdr.nmcd.rc.Right - nmcdr.nmcd.rc.Left;
Debug.Print nmcdr.nmcd.rc.Bottom - nmcdr.nmcd.rc.Top
End Select
End Select
Case WM_DESTROY
Call UnSubclass(hwnd, PtrLVWndProc)
End Select
exitRoutine:
LVWndProc = DefSubclassProc(hwnd, uMsg, wParam, lParam)
End Function
Insomnia is just a byproduct of, "It can't be done"
The same thing I got when I first started this project. I see where the Left and Right values are correct but those I always got in this Case statement
You used that code I posted, as-is? Here's the results I got and I was going to touch on the rects with zero-dimensions. I didn't paste the other rows' data, but they were nearly the same as below with a different .Top value.
My VB is always manifested. Out of curiosity, I ran an unmanifested version and am getting similar results as you. I'm assuming your IDE is not manifested for common controls, i.e., themed.
Color me curious!
edited & follow-up. Played with this a bit and am putting it to bed for now. I tried to use old-fashioned subclassing to see if possibly comctl32 subclassing had anything to do with it - nope. I tried both v5 & v6 of the listview (while IDE is unmanifested) and am getting similar, not identical results. Thinking that the ocx may need to know a CDDS_PREPAINT message is in play, I forwarded that through, but didn't change the results. The hDC seems to be valid, I can manipulate it. Worse case is that the bounding rectangle may need to be gotten via APIs, i.e., SendMessage with LVM_GETITEMRECT
It seems as though the ocx will not fill in the rect structure during Prepaint & Item Pre/Post paint events unless using common controls 6 via manifesting.
At this point, I'm almost willing to take a mulligan and say it's a flaw in the ocx -- but not quite yet.
Ok, the rect is not being filled unless manifested. Even when I created a listview via APIs, I could not get the rect structure filled correctly. Per MSDN, that structure requires at least v5.82 of comctl32. I have that version and it still isn't filled correctly. Could MSDN be mistaken and at least 6.0 vs 5.82 is required? Testing done for me.
Last edited by LaVolpe; Aug 2nd, 2020 at 09:21 PM.
Insomnia is just a byproduct of, "It can't be done"
This is bad beyond repair. You cannot randomly access Form1 from a WndProc in a module.
You could but its useless for anything that might be used in production code.
Why's that? Especially since 'beyond repair' I'd have to assume you mean you couldn't just put it in a global variable either. I've never had problems here.
You *could* keep WndProc/SubclassProc in a standard bas module and map "instance data" by hWnd from a giant collection but this would be mighty uncomfortable and error prone. It's so much more easier to call back into an instance of a class or form which keeps relevant data about the subclassed control.
What's totally unacceptable is in WndProc/SubclassProc to access Form1.MyControl.hWnd or whatever Form1 properties or controls. Binding a dependency to a random Form1 in such code is never a good idea.
Can you clarify exactly how a setup you're talking about is structured, because this seems unlike 90% of the subclassing code I've seen. It seems like you're talking about just forwarding messages back to the form itself to handle, but that's far less common than simply storing relevant handles in accessible ways.
It's probably a bad idea if it's "a random Form1" in that sense where the form unloading wouldn't exit the entire program, but besides that, I'm not sure I really understand the problem.
At this point, I'm almost willing to take a mulligan and say it's a flaw in the ocx -- but not quite yet.
I don't think it's a flaw in the OCX. I tried my project on another PC (Windows 8.1) and I get same results
Originally Posted by LaVolpe
Per MSDN, that structure requires at least v5.82 of comctl32.
I'm using v5.82 of Comctl32 on XP
Originally Posted by LaVolpe
Could MSDN be mistaken and at least 6.0 vs 5.82 is required?
I tried 6.0 and the values were totally way off. Under Case Case CDDS_PREPAINT using v5.82 I at least got the correct width and height of the entire ListView area but using v6.0 they were all screwed up
I tried 6.0 and the values were totally way off. Under Case Case CDDS_PREPAINT using v5.82 I at least got the correct width and height of the entire ListView area but using v6.0 they were all screwed up
6.0 is comctl32.dll version, not the ocx version. The way we get comctl32 6.0 into our process is via manifesting for common controls. And when that is done, then we also get the rectangle structures filled correctly, as shown in post #15
Insomnia is just a byproduct of, "It can't be done"
Can you clarify exactly how a setup you're talking about is structured, because this seems unlike 90% of the subclassing code I've seen. It seems like you're talking about just forwarding messages back to the form itself to handle, but that's far less common than simply storing relevant handles in accessible ways.
What accessible ways?
Provided that you are tightly coupling the subclassing module and the form, yet again you might have multiple instances of Form1 and how do you deal with this? Present code does not deal with it. It not only directly depends on Form1 but it works just on the single global instance for Form1. It totally fails if you load a second instance of Form1. Is 90% of subclassing like that?
6.0 is comctl32.dll version, not the ocx version. The way we get comctl32 6.0 into our process is via manifesting for common controls. And when that is done, then we also get the rectangle structures filled correctly, as shown in post #15
OK, it's time I put this project on the back shelf for now and start a new thread on manifesting. I'm playing around with your ManifestCreatorII so I'll see how far I get with that,
OK, it's time I put this project on the back shelf for now and start a new thread on manifesting. I'm playing around with your ManifestCreatorII so I'll see how far I get with that,
Suggest for testing with manifest
1. Create a manifest and save it to disk in the same folder as your VB6.exe
2. Name that manifest: VB6manifested.exe.manifest
3. Copy your VB6.exe into the same folder and name the copy: VB6manifested.exe
4. Now double click on VB6manifested.exe and you should be able to play around
The above option allows you to have a manifested IDE and unmanifested.
Insomnia is just a byproduct of, "It can't be done"
Provided that you are tightly coupling the subclassing module and the form, yet again you might have multiple instances of Form1 and how do you deal with this? Present code does not deal with it. It not only directly depends on Form1 but it works just on the single global instance for Form1. It totally fails if you load a second instance of Form1. Is 90% of subclassing like that?
cheers,
</wqw>
Definitely agree but that's a rather specific scenario. I'd say yes, 90% of module-based subclassing code indeed isn't designed around that use case unless the application actually is subclassing something on a form that could have multiple instances.
I'd say yes, 90% of module-based subclassing code indeed isn't designed around that use case unless the application actually is subclassing something on a form that could have multiple instances.
That would be sad indeed provided that SetWindowSubclass API allows trivially passing ObjPtr(Me) so that module based SubclassProc can be reduced to a calling back trampoline.
I'm wondering isn't anyone using half-baked subclassing worried that their project starts regularly carshing and bringing down the IDE along with it? How can promoting better subclassing practices be done in these forums?
Well first, those regular crashes would have to actually exist. Your complaint basically seems to be everyone isn't designing their code around a scenario that can't occur in their app and isn't particularly common. I've used ObjPtr(object) to simply send messages back to the right instance, where multiple instances are possible. But I don't know what you're talking about in regards to these regular crashes where the form in question can't have multiple instances.
But I don't know what you're talking about in regards to these regular crashes where the form in question can't have multiple instances.
With old-style subclassing and an hWnd is subclassed multiple times (whether by your code or along with some compiled ocx), crashes are common because there is no linked-list of sorts to determine what subclass procedure to assign when it comes time to unsubclass. The subclasser only knows what procedure was last to subclass and restores that pointer when it unsubclasses. If that previous subclasser already unloaded and your code didn't know, it will set it as the subclass procedure when your code unsubclasses... crash because that other procedure is already dead code.
Usercontrols are typically the biggest culprit when they subclass their host form. Multiple UCs subclass as they get loaded and if not unloaded/unsubclassed in reverse order, crashes happen.
Comctl32.dll subclassing keeps that linked list for us.
Insomnia is just a byproduct of, "It can't be done"
Well, try debugging this project while the form is subclassed with this half-baked approach for instance.
cheers,
</wqw>
Doing it locally with ObjPtr(Me) as the reference data, Public Function LVWndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal uIdSubclass As Long, ByVal dwRefData As VB.Form) As Long
LVWndProc = dwRefData.F1LVWndProc(hWnd, uMsg, wParam, lParam, uIdSubclass)
End Function
does not prevent crashing if there's a runtime error in the wndproc. Were you suggesting that this ability was solved by doing it that way?
This is a limitation of the method, not whether you do it locally on the form.
Using a redirector to call a friend function of dwRefData instance is infinately better. At least one will never use Form1.ListView1.Property in the code of this Form1 function (the callback) unless he's very very confused what he's doing, so subclassing starts working on instances on Form1 too.
You are right this will not make the SubclassProc any more debuggable because in this case if there is no EbMode involved then debugging is out of the question. I'm sure you know which subclassers use EbMode, there are many attempts but probably the only IDE-Safe ones are LaVolpe's thunks and MST.