First, just to make it clear, I have never done any manifesting and I really don't know what the purpose is or how it works or even make a manifest file.
The manifest file that I have associated with my project was not created by me. I went searching through all of my project libraries looking for all "*.manifest" files. I found quite a few. After opening many of them up in Notepad I noticed that most of them were the same so I just decided to copy one of them and apply it to my project (have no idea if that is safe to do or even if it will work but decided to give it a try).
The reason I have added a manifest file to my project is because it was suggested to me in another thread in the hopes that it would solve my problem.
My problem is I am trying the get the bounding areas of subitems in a ListView. In my code I have placed statements to help me see while running the EXE what the values are of a rectangle that is supposed to contain the .Left, .Top, .Right and .Bottom of any subitem in the ListView that I click on. Even with manifesting my project (assuming I did it correctly) the values still do not always yield correct results. I have included the code of the project and the code of the manifest file and also a zip file containing the project.
Here is the manifest file
Form code
.BAS Module code
FYI: I named the manifest file "VB6manifested.exe.manifest" and the exe "VB6manifested.exe"
When I run the application by double clicking on VB6manifested.exe I get better results than I do when running the app from the IDE but still the values are not dependable. Maybe it's the way I am testing for the results that are giving me false results; I just don't know
The manifest file that I have associated with my project was not created by me. I went searching through all of my project libraries looking for all "*.manifest" files. I found quite a few. After opening many of them up in Notepad I noticed that most of them were the same so I just decided to copy one of them and apply it to my project (have no idea if that is safe to do or even if it will work but decided to give it a try).
The reason I have added a manifest file to my project is because it was suggested to me in another thread in the hopes that it would solve my problem.
My problem is I am trying the get the bounding areas of subitems in a ListView. In my code I have placed statements to help me see while running the EXE what the values are of a rectangle that is supposed to contain the .Left, .Top, .Right and .Bottom of any subitem in the ListView that I click on. Even with manifesting my project (assuming I did it correctly) the values still do not always yield correct results. I have included the code of the project and the code of the manifest file and also a zip file containing the project.
Here is the manifest file
Code:
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
name="Project1.exe"
processorArchitecture="x86"
version="1.0.0.0"
type="win32"
/>
<description>No Comments</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="x86"
publicKeyToken="6595b64144ccf1df"
language="*"
/>
</dependentAssembly>
</dependency>
</assembly>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 Command1_Click()
Subclass Form1.hwnd, AddressOf LVWndProc
End Sub
Private Sub Command2_Click()
UnSubclass Form1.hwnd, AddressOf LVWndProc
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"
End Sub
Private Sub ListView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbLeftButton Then
SetOnMouseMove x / Screen.TwipsPerPixelX, y / Screen.TwipsPerPixelY
End If
End Sub
Private Sub OptionCDSS_Click(Index As Integer)
SelectedCDDS = Index + 1
End SubCode:
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
Public SelectedCDDS As Integer
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)
Private Const CDDS_SUBITEM = &H20000
Private Const CDRF_NOTIFYITEMDRAW As Long = &H20&
Private Const CDRF_NOTIFYSUBITEMDRAW = &H20
Private Const CDRF_NEWFONT As Long = &H2&
Private Const CDRF_NOTIFYPOSTPAINT As Long = &H10
Private Type InitCommonControlsExStruct
lngSize As Long
lngICC As Long
End Type
Private Declare Function InitCommonControls Lib "comctl32" () As Long
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (iccex As InitCommonControlsExStruct) As Boolean
Private Sub Main()
Dim iccex As InitCommonControlsExStruct, hMod As Long
Const ICC_ALL_CLASSES As Long = &HFDFF& ' combination of all known values
' constant descriptions: http://msdn.microsoft.com/en-us/library/bb775507%28VS.85%29.aspx
With iccex
.lngSize = LenB(iccex)
.lngICC = ICC_ALL_CLASSES ' you really should customize this value from the available constants
End With
On Error Resume Next ' error? Requires IEv3 or above
hMod = LoadLibrary("shell32.dll")
InitCommonControlsEx iccex
If Err Then
InitCommonControls ' try Win9x version
Err.Clear
End If
On Error GoTo 0
'... show your main form next (i.e., Form1.Show)
Form1.Show
If hMod Then FreeLibrary hMod
End Sub
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
' Form1.UC_Border.Move px * 15, (py + 20) * 15 'OG
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)
If tNMH.hWndFrom <> Form1.ListView1.hwnd Then GoTo exitRoutine
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
If SelectedCDDS = 1 Then
Form1.Label1.Caption = "CDDS_ITEMPOSTPAINT nmcdr.nmcd.rc.Left = " & nmcdr.nmcd.rc.Left
Form1.Label2.Caption = "CDDS_ITEMPOSTPAINT nmcdr.nmcd.rc.Top = " & nmcdr.nmcd.rc.Top
Form1.Label3.Caption = "CDDS_ITEMPOSTPAINT nmcdr.nmcd.rc.Right = " & nmcdr.nmcd.rc.Right - nmcdr.nmcd.rc.Left
Form1.Label4.Caption = "CDDS_ITEMPOSTPAINT nmcdr.nmcd.rc.Bottom = " & nmcdr.nmcd.rc.Bottom
End If
Exit Function
Case (CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM)
' -- use the nmcdr.nmcd members for drawing, i.e., the .Hdc & .Rc members
If SelectedCDDS = 2 Then
Form1.Label1.Caption = "(CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM) nmcdr.nmcd.rc.Left = " & nmcdr.nmcd.rc.Left
Form1.Label2.Caption = "(CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM) nmcdr.nmcd.rc.Top = " & nmcdr.nmcd.rc.Top
Form1.Label3.Caption = "(CDDS_ITEMPOSTPAINT Or CDDS_SUBITEM) nmcdr.nmcd.rc.Right = " & nmcdr.nmcd.rc.Right - nmcdr.nmcd.rc.Left
Form1.Label4.Caption = "(CDDS_ITEMPOSTAINT Or CDDS_SUBITEM) nmcdr.nmcd.rc.Bottom = " & nmcdr.nmcd.rc.Bottom
End If
Exit Function
Case CDDS_PREPAINT
If SelectedCDDS = 3 Then
Form1.Label1.Caption = "CDDS_PREPAINT nmcdr.nmcd.rc.Left = " & nmcdr.nmcd.rc.Left
Form1.Label2.Caption = "CDDS_PREPAINT nmcdr.nmcd.rc.Top = " & nmcdr.nmcd.rc.Top
Form1.Label3.Caption = "CDDS_PREPAINT nmcdr.nmcd.rc.Right = " & nmcdr.nmcd.rc.Right - nmcdr.nmcd.rc.Left
Form1.Label4.Caption = "CDDS_PREPAINT nmcdr.nmcd.rc.Bottom = " & nmcdr.nmcd.rc.Bottom
End If
LVWndProc = CDRF_NOTIFYITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
If SelectedCDDS = 4 Then
Form1.Label1.Caption = "CDDS_ITEMPREPAINT nmcdr.nmcd.rc.Left = " & nmcdr.nmcd.rc.Left
Form1.Label2.Caption = "CDDS_ITEMPREPAINT nmcdr.nmcd.rc.Top = " & nmcdr.nmcd.rc.Top
Form1.Label3.Caption = "CDDS_ITEMPREPAINT nmcdr.nmcd.rc.Right = " & nmcdr.nmcd.rc.Right - nmcdr.nmcd.rc.Left
Form1.Label4.Caption = "CDDS_ITEMPREPAINT nmcdr.nmcd.rc.Bottom = " & nmcdr.nmcd.rc.Bottom
End If
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
If SelectedCDDS = 5 Then
Form1.Label1.Caption = "CDDS_ITEMPREPAINT Or CDDS_SUBITEM nmcdr.nmcd.rc.Left = " & nmcdr.nmcd.rc.Left
Form1.Label2.Caption = "CDDS_ITEMPREPAINT Or CDDS_SUBITEM nmcdr.nmcd.rc.Top = " & nmcdr.nmcd.rc.Top
Form1.Label3.Caption = "CDDS_ITEMPREPAINT Or CDDS_SUBITEM nmcdr.nmcd.rc.Right = " & nmcdr.nmcd.rc.Right - nmcdr.nmcd.rc.Left
Form1.Label4.Caption = "CDDS_ITEMPREPAINT Or CDDS_SUBITEM nmcdr.nmcd.rc.Bottom = " & nmcdr.nmcd.rc.Bottom
End If
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
exitRoutine:
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 FunctionWhen I run the application by double clicking on VB6manifested.exe I get better results than I do when running the app from the IDE but still the values are not dependable. Maybe it's the way I am testing for the results that are giving me false results; I just don't know