Excel VBA程序开发

ivccav Lv.6

2023-3-25 00:01 关注
本帖最后由 ivccav 于 2023-3-25 13:49 编辑

之前写过3篇关于Listview控件的帖子（如下），阅读人数还挺多，其中一帖阅读量10W+，该控件受欢迎程度可见一斑。
随着64位Office开始支持Listview控件，我想需要了解该控件使用的需求只会更大。

VBA窗体Listview控件完全教程
https://club.excelhome.net/thread-1424969-1-1.html

用NM_CUSTOMDRAW自定义绘制技术实现Listview控件隔行换色
https://club.excelhome.net/thread-1428537-1-1.html

窗体Listview控件实现可编辑功能的完美解决方法
https://club.excelhome.net/thread-1423746-1-1.html


虽然曾经写过“完全教程”，但有一个问题始终没有解决，即Listview控件的网格线颜色无法设定。
我在微软官网查阅了很多NM_CUSTOMDRAW内容，找不到设置网格线颜色的内容。NM_CUSTOMDRAW用于设置每行交替色是很方便的，代码简单。

众所周知，控件绘制可有三种方式：

1.处理 WM_PAINT消息
这是最极端的方式，执行一个 WM_PAINT 处理程序，并且自己完成所有的绘制工作。这意味着代码将需要进行一些与呈现控件相关的琐事 — 创建适当的设备上下文（一个或多个），决定控件的大小和位置，绘制控件等。在绘制过程中，很少需要这种级别的控件。

2.所有者绘制(OwnerDraw)
控制控件绘制的第2种方法是所有者绘制，它是用于开发自定义控件最普通的技术。该技术普遍使用的主要原因在于，系统可为提供很多帮助。在呈现控件的之前，Windows已经创建并填写了设备上下文，决定了控件的大小和位置，并且向您传递信息以使您了解此刻绘制的需求。对于列表控件（例如Listbox和Listview等），Windows将为列表中的每一项调用绘制代码，这意味着您只需绘制这些项，而无需考虑控件的其他方面。这里的”Owner”可以理解为控件类的派生类。

如何启用控件的OwnerDraw属性呢？对于ListView控件，可以设置LVS_OWNERDRAWFIXED风格。
使用OwnerDraw方式，我们需要处理WM_MEASUREITEM和WM_DRAWITEM消息。
如果要设置每行行高，只能使用OwnerDraw方式绘制，且只有在收到WM_MEASUREITEM消息时能进行设置。
设置行高在MEASUREITEMSTRUCT结构体的ItemHeight成员中设置。

Private Type MEASUREITEMSTRUCT
    CtlType                         As Long
    CtlID                           As Long
    itemID                          As Long
    itemWidth                       As Long
    ItemHeight                      As Long
    itemData                        As Long
End Type
所有者绘制(OwnerDraw)方式主要处理WM_DRAWITEM消息对Item和Subitem进行边框绘制。

3.自定义绘制(CustomDraw)
CustomDraw不需要设置风格。只需在接收到NM_CUSTOMDRAW通知时(借由WM_NOTIFY消息）给父窗口。控件的父窗口可以选择处理或不处理此通知。在CustomDraw场景下，控件的大部分绘制工作还是由系统默认完成，我们只是在系统绘制之前或者之后对控件的呈现进行某种方式的”微调”。比如，我们可以使用CustomDraw机制来修改ListView控件中的项目背景色，文字的前景或背景色等。在控件绘制的整个阶段中，系统划分了一系列不同的阶段，开发者设置了感兴趣的阶段后，系统就会在每个开发者感兴趣的阶段发送NM_CUSTOMDRAW通知。当我们收到NM_CUSTOMDRAW通知的时候，我们可以根据通知中的DrawStage知道当前绘制的阶段。具体可看微软官方文档。

本帖使用的是第二种方式。代码来源于网络，是VB6环境下写的一个类模块。如果直接放在VBA中运行，会导致应用软件直接崩溃。我修改了少量参数，让其可以在VBA中正常运行，并针对在VBA中无法触发WM_MEASUREITEM消息导致无法设置行高的问题，写了触发该消息的子过程。还写了应用示例。

该类的接口如下：

image.png


应用实际效果图：

aaaa.png


1024.gif



附件下载见10楼：

64位API声明参考：
https://club.excelhome.net/thread-1656964-1-1.html


赏
有 1 人给楼主打赏
1838阅读
20回复 倒序

ivccav 楼主 置顶 来自 2楼

2023-3-25 00:27
本帖最后由 ivccav 于 2023-3-27 09:08 编辑



完整源代码和应用案例：








ivccav 楼主 3楼

2023-3-25 00:06

新建一个类模块，取名为：CCustomListView


结构体、枚举和常量声明：
  1. Private Type TRACKMOUSEEVENTTYPE
  2.     cbSize                          As Long
  3.     dwFlags                         As Long
  4.     hwndTrack                       As Long
  5.     dwHoverTime                     As Long
  6. End Type

  8. Private Type tSubData
  9.     hwnd                            As Long
  10.     nAddrSub                        As Long
  11.     nAddrOrig                       As Long
  12.     nMsgCntA                        As Long
  13.     nMsgCntB                        As Long
  14.     aMsgTblA()                      As Long
  15.     aMsgTblB()                      As Long
  16. End Type

  18. Private Enum eMsgWhen
  19.     [MSG_AFTER] = &H1
  20.     [MSG_BEFORE] = &H2
  21.     [MSG_BEFORE_AND_AFTER] = MSG_AFTER Or MSG_BEFORE
  22. End Enum

  24. Private Const ALL_MESSAGES          As Long = &HFFFF
  25. Private Const CODE_LEN              As Long = &HC5
  26. Private Const GWL_WNDPROC           As Long = &HFFFC
  27. Private Const PATCH_04              As Long = &H58
  28. Private Const PATCH_05              As Long = &H5D
  29. Private Const PATCH_08              As Long = &H84
  30. Private Const PATCH_09              As Long = &H89

  32. Private Type RECT
  33.     Left                            As Long
  34.     Top                             As Long
  35.     Right                           As Long
  36.     Bottom                          As Long
  37. End Type

  39. Private Type MEASUREITEMSTRUCT
  40.     CtlType                         As Long
  41.     CtlID                           As Long
  42.     itemID                          As Long
  43.     itemWidth                       As Long
  44.     ItemHeight                      As Long
  45.     itemData                        As Long
  46. End Type

  48. Private Type DRAWITEMSTRUCT
  49.     CtlType                         As Long
  50.     CtlID                           As Long
  51.     itemID                          As Long
  52.     itemAction                      As Long
  53.     itemState                       As Long
  54.     hwndItem                        As Long
  55.     hdc                             As Long
  56.     rcItem                          As RECT
  57.     itemData                        As Long
  58. End Type

  60. Private Type NMHDR
  61.     hWndFrom                        As Long
  62.     idFrom                          As Long
  63.     Code                            As Long
  64. End Type

  66. Private Type NMCUSTOMDRAW
  67.     hdr                             As NMHDR
  68.     dwDrawStage                     As Long
  69.     hdc                             As Long
  70.     rc                              As RECT
  71.     dwItemSpec                      As Long
  72.     uItemState                      As Long
  73.     lItemlParam                     As Long
  74. End Type

  76. Private Type NMLVCUSTOMDRAW
  77.     nmcd                                As NMCUSTOMDRAW
  78.     clrText                             As Long
  79.     clrTextBk                           As Long
  80.     iSubItem                            As Long
  81. End Type

  83. Private Type LVITEM
  84.     mask                                As Long
  85.     iItem                               As Long
  86.     iSubItem                            As Long
  87.     state                               As Long
  88.     stateMask                           As Long
  89.     pszText                             As Long
  90.     cchTextMax                          As Long
  91.     iImage                              As Long
  92.     lParam                              As Long
  93.     iIndent                             As Long
  94. End Type


  97. Private Type HDITEM
  98.     mask                                As Long
  99.     cxy                                 As Long
  100.     pszText                             As Long
  101.     hbm                                 As Long
  102.     cchTextMax                          As Long
  103.     fmt                                 As Long
  104.     lParam                              As Long
  105.     iImage                              As Long
  106.     iOrder                              As Long
  107.     type                                As Long
  108.     pvFilter                            As Long
  109.     state                               As Long
  110. End Type

  112. Private Const WM_NCDESTROY              As Long = &H82
  113. Private Const WM_MEASUREITEM            As Long = &H2C
  114. Private Const WM_DRAWITEM               As Long = &H2B

  116. Private Const LVM_FIRST                 As Long = &H1000
  117. Private Const LVM_GETHEADER             As Long = (LVM_FIRST + 31)
  118. Private Const LVM_GETITEMTEXTA          As Long = (LVM_FIRST + 45)

  120. Private Const LVS_OWNERDRAWFIXED        As Long = &H400

  122. Private Const LVIF_TEXT                 As Long = &H1

  124. Private Const DT_LEFT                   As Long = &H0
  125. Private Const DT_TOP                    As Long = &H0
  126. Private Const DT_CENTER                 As Long = &H1
  127. Private Const DT_RIGHT                  As Long = &H2
  128. Private Const DT_VCENTER                As Long = &H4
  129. Private Const DT_BOTTOM                 As Long = &H8
  130. Private Const DT_SINGLELINE             As Long = &H20
  131. Private Const DT_END_ELLIPSIS           As Long = &H8000&

  133. Private Const DCB_ACCUMULATE        As Long = &H2
  134. Private Const DCB_DISABLE           As Long = &H8
  135. Private Const DCB_ENABLE            As Long = &H4
  136. Private Const DCB_RESET             As Long = &H1
  137. Private Const DCB_SET               As Long = (DCB_RESET Or DCB_ACCUMULATE)

  139. Private Const HDM_FIRST                 As Long = &H1200
  140. Private Const HDM_GETITEMCOUNT          As Long = (HDM_FIRST + 0)
  141. Private Const HDM_GETITEMA              As Long = (HDM_FIRST + 3)
  142. Private Const HDM_GETITEMRECT           As Long = (HDM_FIRST + 7)

  144. Private Const HDI_FORMAT                As Long = &H4

  146. Private Const HDF_LEFT                  As Long = 0
  147. Private Const HDF_RIGHT                 As Long = 1
  148. Private Const HDF_CENTER                As Long = 2

  150. Private Const GWL_STYLE                 As Long = (-16)

  152. Private Const PS_SOLID                  As Long = 0

  154. Private Const ODT_LISTVIEW              As Long = 102
  155. Private Const ODS_SELECTED              As Long = &H1


ivccav 楼主 4楼

2023-3-25 00:08



API和模块变量声明

  1. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  2. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
  3. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  4. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  5. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  6. Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
  7. Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
  8. Private Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  9. Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  10. Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

  12. Private Declare Function TrackMouseEvent2 Lib "comctl32.dll" Alias "_TrackMouseEvent" (ByRef lpEventTrack As TRACKMOUSEEVENTTYPE) As Long ' Win95 w/ IE 3.0
  13. Private Declare Function TrackMouseEvent Lib "user32.dll" (ByRef lpEventTrack As TRACKMOUSEEVENTTYPE) As Long ' Win98 or later

  15. Private Declare Function LocalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
  16. Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long

  18. Private Declare Function SetBoundsRect Lib "gdi32" (ByVal hdc As Long, lprcBounds As RECT, ByVal flags As Long) As Long
  19. Private Declare Function GetBoundsRect Lib "gdi32" (ByVal hdc As Long, lprcBounds As RECT, ByVal flags As Long) As Long
  20. Private Declare Function IntersectRect Lib "user32" (lpDestRect As RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
  21. Private Declare Function IsRectEmpty Lib "user32" (lpRect As RECT) As Long
  22. Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  23. Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
  24. Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  25. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  26. Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

  28. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  29. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  30. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  31. Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Any, ByVal bErase As Long) As Long
  32. 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
  33. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  34. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  35. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  36. Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  37. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  38. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  39. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  40. Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long

  42. Private sc_aSubData()           As tSubData
  43. Private sc_aBuf(1 To CODE_LEN)  As Byte
  44. Private sc_pCWP                 As Long
  45. Private sc_pEbMode              As Long
  46. Private sc_pSWL                 As Long

  48. '''''''''''''''''''''''''''''''''''''''''''''''''''''
  49. Private m_bIsTrackHandler32     As Boolean
  50. Private m_bIsTracked            As Boolean

  52. Private m_hWnd                  As Long
  53. Private m_hHeaderWnd            As Long
  54. Private m_hParentWnd            As Long
  55. Private m_dwOriginStyle         As Long

  57. Private m_clrItemBkColor1       As Long
  58. Private m_clrItemBkColor2       As Long
  59. Private m_clrGridColor          As Long
  60. Private m_clrSelectedItemBkColor       As Long

  62. Private m_hItemBkBrush1         As Long
  63. Private m_hItemBkBrush2         As Long
  64. Private m_hGridPen              As Long
  65. Private m_hSelectedItemBkBrush  As Long

  67. Private m_bItemBkColorHorizontal    As Boolean
  68. Private m_bShowGrid             As Boolean
  69. Private m_nItemHeight           As Long


ivccav 楼主 5楼

2023-3-25 00:12



入口函数和消息处理：

  1. Public Sub zSubclass_Proc(ByVal bBefore As Boolean, ByRef bHandled As Boolean, ByRef lReturn As Long, ByRef lhWnd As Long, ByRef uMsg As Long, ByRef wParam As Long, ByRef lParam As Long)
  2.     Select Case uMsg
  3.         Case WM_NCDESTROY
  4.             Detach
  5.             Exit Sub
  6.             
  7.         Case WM_MEASUREITEM
  8.             lReturn = OnMeasureItem(lhWnd, uMsg, wParam, lParam, bHandled)
  9.             Exit Sub
  10.             
  11.         Case WM_DRAWITEM
  12.             lReturn = OnDrawItem(lhWnd, uMsg, wParam, lParam, bHandled)
  13.             Exit Sub
  14.             
  15.     End Select
  16. End Sub

  18. Private Sub Subclass_AddMsg(ByVal lng_hWnd As Long, ByVal uMsg As Long, Optional ByVal When As eMsgWhen = MSG_AFTER)
  19.     With sc_aSubData(zIdx(lng_hWnd))
  20.         If (When And eMsgWhen.MSG_BEFORE) Then
  21.             Call zAddMsg(uMsg, .aMsgTblB, .nMsgCntB, eMsgWhen.MSG_BEFORE, .nAddrSub)
  22.         End If
  23.         If (When And eMsgWhen.MSG_AFTER) Then
  24.             Call zAddMsg(uMsg, .aMsgTblA, .nMsgCntA, eMsgWhen.MSG_AFTER, .nAddrSub)
  25.         End If
  26.     End With
  27. End Sub

  29. Private Sub Subclass_DelMsg(ByVal lng_hWnd As Long, ByVal uMsg As Long, Optional ByVal When As eMsgWhen = MSG_AFTER)
  30.   
  31.     With sc_aSubData(zIdx(lng_hWnd))
  32.         If (When And eMsgWhen.MSG_BEFORE) Then
  33.             Call zDelMsg(uMsg, .aMsgTblB, .nMsgCntB, eMsgWhen.MSG_BEFORE, .nAddrSub)
  34.         End If
  35.         If (When And eMsgWhen.MSG_AFTER) Then
  36.             Call zDelMsg(uMsg, .aMsgTblA, .nMsgCntA, eMsgWhen.MSG_AFTER, .nAddrSub)
  37.         End If
  38.     End With
  39. End Sub


ivccav 楼主 6楼

2023-3-25 00:15



汇编处理。功能是把入口函数完全封装在类中。避免使用标准模块的小尾巴。

  1. Private Function Subclass_InIDE() As Boolean
  2.     Subclass_InIDE = False
  3. End Function

  5. Private Function Subclass_Start(ByVal lng_hWnd As Long) As Long

  7.   Dim i                        As Long
  8.   Dim j                        As Long
  9.   Dim nSubIdx                  As Long
  10.   Dim sSubCode                 As String
  11.   
  12.   Const GMEM_FIXED             As Long = 0
  13.   Const PAGE_EXECUTE_READWRITE As Long = &H40&
  14.   Const PATCH_01               As Long = 18
  15.   Const PATCH_02               As Long = 68
  16.   Const PATCH_03               As Long = 78
  17.   Const PATCH_06               As Long = 116
  18.   Const PATCH_07               As Long = 121
  19.   Const PATCH_0A               As Long = 186
  20.   Const FUNC_CWP               As String = "CallWindowProcA"
  21.   Const FUNC_EBM               As String = "EbMode"
  22.   Const FUNC_SWL               As String = "SetWindowLongA"
  23.   Const MOD_USER               As String = "user32"
  24.   Const MOD_VBA5               As String = "vba5"
  25.   Const MOD_VBA6               As String = "vba6"

  27.     If (sc_aBuf(1) = 0) Then

  29.         sSubCode = "5589E583C4F85731C08945FC8945F8EB0EE80000000083F802742185C07424E830000000837DF800750AE838000000E84D0000005F8B45FCC9C21000E826000000EBF168000000006AFCFF7508E800000000EBE031D24ABF00000000B900000000E82D000000C3FF7514FF7510FF750CFF75086800000000E8000000008945FCC331D2BF00000000B900000000E801000000C3E32F09C978078B450CF2AF75248D4514508D4510508D450C508D4508508D45FC508D45F85052B800000000508B00FF501CC3"
  30.         i = 1
  31.         Do While j < CODE_LEN
  32.             j = j + 1
  33.             sc_aBuf(j) = CByte("&H" & Mid$(sSubCode, i, 2))
  34.             i = i + 2
  35.         Loop
  36.    
  37.         If (Subclass_InIDE) Then
  38.             sc_aBuf(16) = &H90
  39.             sc_aBuf(17) = &H90
  40.             sc_pEbMode = zAddrFunc(MOD_VBA6, FUNC_EBM)
  41.             If (sc_pEbMode = 0) Then
  42.                 sc_pEbMode = zAddrFunc(MOD_VBA5, FUNC_EBM)
  43.             End If
  44.         End If
  45.    
  46.         Call zPatchVal(VarPtr(sc_aBuf(1)), PATCH_0A, ObjPtr(Me))
  47.    
  48.         sc_pCWP = zAddrFunc(MOD_USER, FUNC_CWP)
  49.         sc_pSWL = zAddrFunc(MOD_USER, FUNC_SWL)
  50.         ReDim sc_aSubData(0 To 0) As tSubData
  51.    
  52.       Else
  53.         nSubIdx = zIdx(lng_hWnd, True)
  54.         If (nSubIdx = -1) Then
  55.             nSubIdx = UBound(sc_aSubData()) + 1
  56.             ReDim Preserve sc_aSubData(0 To nSubIdx) As tSubData
  57.         End If
  58.    
  59.         Subclass_Start = nSubIdx
  60.     End If

  62.     With sc_aSubData(nSubIdx)
  63.         
  64.         .nAddrSub = GlobalAlloc(GMEM_FIXED, CODE_LEN)
  65.         Call VirtualProtect(ByVal .nAddrSub, CODE_LEN, PAGE_EXECUTE_READWRITE, i)
  66.         Call RtlMoveMemory(ByVal .nAddrSub, sc_aBuf(1), CODE_LEN)
  67.    
  68.         .hwnd = lng_hWnd
  69.         .nAddrOrig = SetWindowLongA(.hwnd, GWL_WNDPROC, .nAddrSub)
  70.    
  71.         Call zPatchRel(.nAddrSub, PATCH_01, sc_pEbMode)
  72.         Call zPatchVal(.nAddrSub, PATCH_02, .nAddrOrig)
  73.         Call zPatchRel(.nAddrSub, PATCH_03, sc_pSWL)
  74.         Call zPatchVal(.nAddrSub, PATCH_06, .nAddrOrig)
  75.         Call zPatchRel(.nAddrSub, PATCH_07, sc_pCWP)
  76.     End With
  77. End Function

  79. Private Sub Subclass_StopAll()
  80.   
  81.   Dim i As Long
  82.   
  83.     i = UBound(sc_aSubData())
  84.     Do While i >= 0
  85.         With sc_aSubData(i)
  86.             If (.hwnd <> 0) Then
  87.                 Call Subclass_Stop(.hwnd)
  88.             End If
  89.         End With
  90.    
  91.         i = i - 1
  92.     Loop
  93. End Sub

  95. Private Sub Subclass_Stop(ByVal lng_hWnd As Long)
  96.   
  97.     With sc_aSubData(zIdx(lng_hWnd))
  98.         Call SetWindowLongA(.hwnd, GWL_WNDPROC, .nAddrOrig)
  99.         Call zPatchVal(.nAddrSub, PATCH_05, 0)
  100.         Call zPatchVal(.nAddrSub, PATCH_09, 0)
  101.         Call GlobalFree(.nAddrSub)
  102.         .hwnd = 0
  103.         .nMsgCntB = 0
  104.         .nMsgCntA = 0
  105.         Erase .aMsgTblB
  106.         Erase .aMsgTblA
  107.     End With
  108. End Sub


  111. Private Sub zAddMsg(ByVal uMsg As Long, ByRef aMsgTbl() As Long, ByRef nMsgCnt As Long, ByVal When As eMsgWhen, ByVal nAddr As Long)
  112.   
  113.   Dim nEntry  As Long
  114.   Dim nOff1   As Long
  115.   Dim nOff2   As Long
  116.   
  117.     If (uMsg = ALL_MESSAGES) Then
  118.         nMsgCnt = ALL_MESSAGES
  119.       Else
  120.         Do While nEntry < nMsgCnt
  121.             nEntry = nEntry + 1
  122.         
  123.             If (aMsgTbl(nEntry) = 0) Then
  124.                 aMsgTbl(nEntry) = uMsg
  125.                 Exit Sub
  126.             ElseIf (aMsgTbl(nEntry) = uMsg) Then
  127.                 Exit Sub
  128.             End If
  129.         Loop

  131.         nMsgCnt = nMsgCnt + 1
  132.         ReDim Preserve aMsgTbl(1 To nMsgCnt) As Long
  133.         aMsgTbl(nMsgCnt) = uMsg
  134.     End If

  136.     If (When = eMsgWhen.MSG_BEFORE) Then
  137.         nOff1 = PATCH_04
  138.         nOff2 = PATCH_05
  139.       Else
  140.         nOff1 = PATCH_08
  141.         nOff2 = PATCH_09
  142.     End If

  144.     If (uMsg <> ALL_MESSAGES) Then
  145.         Call zPatchVal(nAddr, nOff1, VarPtr(aMsgTbl(1)))
  146.     End If
  147.     Call zPatchVal(nAddr, nOff2, nMsgCnt)
  148. End Sub

  150. Private Function zAddrFunc(ByVal sDLL As String, ByVal sProc As String) As Long
  151.     zAddrFunc = GetProcAddress(GetModuleHandleA(sDLL), sProc)
  152.     Debug.Assert zAddrFunc
  153. End Function

  155. Private Sub zDelMsg(ByVal uMsg As Long, ByRef aMsgTbl() As Long, ByRef nMsgCnt As Long, ByVal When As eMsgWhen, ByVal nAddr As Long)
  156.   
  157.   Dim nEntry As Long
  158.   
  159.     If (uMsg = ALL_MESSAGES) Then
  160.         nMsgCnt = 0
  161.         If When = eMsgWhen.MSG_BEFORE Then
  162.             nEntry = PATCH_05
  163.           Else
  164.             nEntry = PATCH_09
  165.         End If
  166.         Call zPatchVal(nAddr, nEntry, 0)
  167.       Else
  168.         Do While nEntry < nMsgCnt
  169.             nEntry = nEntry + 1
  170.             If (aMsgTbl(nEntry) = uMsg) Then
  171.                 aMsgTbl(nEntry) = 0
  172.                 Exit Do
  173.             End If
  174.         Loop
  175.     End If
  176. End Sub

  178. Private Function zIdx(ByVal lng_hWnd As Long, Optional ByVal bAdd As Boolean = False) As Long
  179.   
  180.     zIdx = UBound(sc_aSubData)
  181.     Do While zIdx >= 0
  182.         With sc_aSubData(zIdx)
  183.             If (.hwnd = lng_hWnd) Then
  184.                 If (Not bAdd) Then
  185.                     Exit Function
  186.                 End If
  187.             ElseIf (.hwnd = 0) Then
  188.                 If (bAdd) Then
  189.                     Exit Function
  190.                 End If
  191.             End If
  192.         End With
  193.         zIdx = zIdx - 1
  194.     Loop
  195.   
  196.     If (Not bAdd) Then
  197.         Debug.Assert False
  198.     End If

  200. End Function

  202. Private Sub zPatchRel(ByVal nAddr As Long, ByVal nOffset As Long, ByVal nTargetAddr As Long)
  203.     Call RtlMoveMemory(ByVal nAddr + nOffset, nTargetAddr - nAddr - nOffset - 4, 4)
  204. End Sub

  206. Private Sub zPatchVal(ByVal nAddr As Long, ByVal nOffset As Long, ByVal nValue As Long)
  207.     Call RtlMoveMemory(ByVal nAddr + nOffset, nValue, 4)
  208. End Sub

  210. Private Function zSetTrue(ByRef bValue As Boolean) As Boolean
  211.     zSetTrue = True
  212.     bValue = True
  213. End Function


ivccav 楼主 7楼

2023-3-25 00:16



类的初始化和销毁:

  1. Private Sub Class_Initialize()
  2.     m_bIsTrackHandler32 = IsFunctionSupported("TrackMouseEvent", "User32")
  3.    
  4.     m_hWnd = 0
  5.     m_dwOriginStyle = 0
  6.    
  7.     m_hItemBkBrush1 = m_hItemBkBrush2 = 0
  8.     m_hGridPen = 0
  9.     m_bItemBkColorHorizontal = False
  10.     ItemHeight = 20
  11.     ShowGird = True
  12.    
  13.     ItemBkColor1 = &HFFFFFF
  14.     ItemBkColor2 = &HFDF8F0
  15.     GridColor = &HE5D7D0
  16.     SelectedItemBkColor = &HABECFC
  17. End Sub

  19. Private Sub Class_Terminate()
  20.     Call Detach
  21.    
  22.     If (m_hItemBkBrush1 <> 0) Then
  23.         Call DeleteObject(m_hItemBkBrush1)
  24.         m_hItemBkBrush1 = 0
  25.     End If
  26.    
  27.     If (m_hItemBkBrush2 <> 0) Then
  28.         Call DeleteObject(m_hItemBkBrush2)
  29.         m_hItemBkBrush2 = 0
  30.     End If
  31.    
  32.     If (m_hSelectedItemBkBrush <> 0) Then
  33.         Call DeleteObject(m_hSelectedItemBkBrush)
  34.         m_hSelectedItemBkBrush = 0
  35.     End If
  36.    
  37.     If (m_hGridPen <> 0) Then
  38.         Call DeleteObject(m_hGridPen)
  39.         m_hGridPen = 0
  40.     End If
  41. End Sub

  43. Private Function IsFunctionSupported(sFunction As String, sModule As String) As Boolean
  44.     Dim hModule As Long
  45.         hModule = GetModuleHandleA(sModule)
  46.     If (hModule = 0) Then
  47.         hModule = LoadLibrary(sModule)
  48.     End If
  49.     If (hModule) Then
  50.         If (GetProcAddress(hModule, sFunction)) Then
  51.             IsFunctionSupported = True
  52.         End If
  53.         FreeLibrary hModule
  54.     End If
  55. End Function

  57. Private Sub TrackMouseTracking(hwnd As Long)
  58.     Dim lpEventTrack As TRACKMOUSEEVENTTYPE
  59.     With lpEventTrack
  60.         .cbSize = Len(lpEventTrack)
  61.         '.dwFlags = &H1 Or &H2  ' TM_HOVER OR TM_LEAVE
  62.         .dwFlags = &H2
  63.         .dwHoverTime = 100
  64.         .hwndTrack = hwnd
  65.     End With
  66.     If (m_bIsTrackHandler32) Then
  67.         TrackMouseEvent lpEventTrack
  68.     Else
  69.         TrackMouseEvent2 lpEventTrack
  70.     End If
  71. End Sub

  73. Private Sub UpdateAll()
  74.     If (m_hWnd <> 0) Then
  75.         Call InvalidateRect(m_hWnd, ByVal 0, 1)
  76.     End If
  77. End Sub


ivccav 楼主 8楼

2023-3-25 00:18



核心代码。处理WM_MEASUREITEM和WM_DRAWITEM消息，绘制ITEM和SUBITEM的边框和文字。

  1. Private Function OnMeasureItem(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef bHandled As Boolean) As Long
  2.     Dim mis As MEASUREITEMSTRUCT
  3.     OnMeasureItem = 0
  4.     bHandled = False
  5.    
  6.     Call CopyMemory(mis, ByVal lParam, Len(mis))
  7.    
  8.     If (mis.CtlType = ODT_LISTVIEW And GetDlgItem(m_hParentWnd, mis.CtlID) = m_hWnd) Then
  9.         mis.ItemHeight = m_nItemHeight
  10.         
  11.         Call CopyMemory(ByVal lParam, mis, Len(mis))
  12.         
  13.         bHandled = True
  14.         OnMeasureItem = 1
  15.     End If
  16. End Function

  18. Private Function OnDrawItem(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByRef bHandled As Boolean) As Long
  19.     Dim dis As DRAWITEMSTRUCT
  20.     Dim rcSubItem As RECT, rcHeaderItem As RECT
  21.    
  22.     Dim nHeaderItemCount As Long
  23.     Dim i As Integer
  24.    
  25.     OnDrawItem = 0
  26.     bHandled = False
  27.    
  28.     Call CopyMemory(dis, ByVal lParam, Len(dis))
  29.    
  30.     If (dis.CtlType = ODT_LISTVIEW And GetDlgItem(m_hParentWnd, dis.CtlID) = m_hWnd) Then
  31.    
  32.         ' 获取列表头个数
  33.         nHeaderItemCount = SendMessage(m_hHeaderWnd, HDM_GETITEMCOUNT, 0, 0)
  34.         Call SetRect(rcSubItem, dis.rcItem.Left, dis.rcItem.Top, dis.rcItem.Left, dis.rcItem.Bottom)
  35.             
  36.         For i = 0 To nHeaderItemCount - 1
  37.             
  38.             Call SendMessage(m_hHeaderWnd, HDM_GETITEMRECT, i, rcHeaderItem)
  39.             
  40.             rcSubItem.Left = rcSubItem.Right
  41.             rcSubItem.Right = rcSubItem.Left + rcHeaderItem.Right - rcHeaderItem.Left
  42.             
  43.             Call OnDrawSubItem(dis, i, rcSubItem)
  44.         Next
  45.     End If
  46.    
  47. End Function

  49. Private Sub OnDrawSubItem(dis As DRAWITEMSTRUCT, ByVal nSubItem As Long, rcSubItem As RECT)
  50.     Dim hdi As HDITEM
  51.     Dim li As LVITEM
  52.     Dim szBuff() As Byte
  53.     Dim szText As String
  54.     Dim wTextFormat As Long
  55.     Dim rcPaint As RECT, rcIntersect As RECT
  56.     Dim hOldBrush As Long
  57.     Dim hOldPen As Long
  58.    
  59.     Call GetBoundsRect(dis.hdc, rcPaint, 0)
  60.     If IsRectEmpty(rcPaint) Then
  61.         Call GetClientRect(m_hWnd, rcPaint)
  62.     End If
  63.     Call IntersectRect(rcIntersect, rcPaint, rcSubItem)
  64.    
  65.     If Not IsRectEmpty(rcPaint) Then
  66.    
  67.         ' 设置绘图边界
  68.         Call SetBoundsRect(dis.hdc, rcIntersect, DCB_SET)

  70.         ' 获取列表项文本
  71.         li.mask = LVIF_TEXT
  72.         li.iItem = dis.itemID
  73.         li.iSubItem = nSubItem
  74.         li.stateMask = -1
  75.         li.pszText = LocalAlloc(&H40, 255)
  76.         li.cchTextMax = 255
  77.         Call SendMessage(m_hWnd, LVM_GETITEMTEXTA, li.iItem, li)
  78.         
  79.         szBuff = StrConv(String$(255, 0), vbFromUnicode)
  80.         Call CopyMemory(szBuff(0), ByVal li.pszText, 255)
  81.         Call LocalFree(li.pszText)
  82.         
  83.         szText = StrConv(szBuff, vbUnicode)
  84.         szText = Left$(szText, InStr(1, szText, vbNullChar) - 1)
  85.         
  86.         ' 获取列表头对齐格式
  87.         hdi.mask = HDI_FORMAT
  88.         Call SendMessage(m_hHeaderWnd, HDM_GETITEMA, li.iSubItem, hdi)
  89.         wTextFormat = DT_LEFT Or DT_VCENTER Or DT_SINGLELINE
  90.         If (hdi.fmt And HDF_CENTER) Then
  91.             wTextFormat = wTextFormat Or DT_CENTER
  92.         ElseIf (hdi.fmt And HDF_RIGHT) Then
  93.             wTextFormat = wTextFormat Or DT_RIGHT
  94.         End If
  95.                
  96.         ' 填充背景
  97.         If ShowGird = True Then
  98.             If (dis.itemState And ODS_SELECTED) Then
  99.                 hOldBrush = SelectObject(dis.hdc, m_hSelectedItemBkBrush)
  100.             ElseIf m_bItemBkColorHorizontal = True Then
  101.                 hOldBrush = SelectObject(dis.hdc, IIf(nSubItem Mod 2, m_hItemBkBrush1, m_hItemBkBrush2))
  102.             Else
  103.                 hOldBrush = SelectObject(dis.hdc, IIf(dis.itemID Mod 2, m_hItemBkBrush1, m_hItemBkBrush2))
  104.             End If
  105.             hOldPen = SelectObject(dis.hdc, m_hGridPen)
  106.             Call Rectangle(dis.hdc, rcSubItem.Left, rcSubItem.Top - 1, rcSubItem.Right + 1, rcSubItem.Bottom)
  107.         Else
  108.             If (dis.itemState And ODS_SELECTED) Then
  109.                 Call FillRect(dis.hdc, rcSubItem, m_hSelectedItemBkBrush)
  110.             ElseIf m_bItemBkColorHorizontal = True Then
  111.                 Call FillRect(dis.hdc, rcSubItem, IIf(nSubItem Mod 2, m_hItemBkBrush1, m_hItemBkBrush2))
  112.             Else
  113.                 Call FillRect(dis.hdc, rcSubItem, IIf(dis.itemID Mod 2, m_hItemBkBrush1, m_hItemBkBrush2))
  114.             End If
  115.         End If
  116.         
  117.         Call InflateRect(rcSubItem, -1, -1)
  118.         Call DrawText(dis.hdc, szText, -1, rcSubItem, wTextFormat)
  119.         Call InflateRect(rcSubItem, 1, 1)
  120.         
  121.         ' 还原设备上下文
  122.         If (hOldBrush <> 0) Then Call SelectObject(dis.hdc, hOldBrush)
  123.         If (hOldPen <> 0) Then Call SelectObject(dis.hdc, hOldPen)
  124.         Call SetBoundsRect(dis.hdc, rcPaint, DCB_SET)
  125.     End If
  126. End Sub


ivccav 楼主 9楼

2023-3-25 00:19



连接方法，还有一些属性：

  1. Public Function Attach(ByVal hwnd As Long) As Boolean
  2.     Dim dwNewStyle As Long
  3.    
  4.     Attach = False
  5.     If Not (m_hWnd = 0) Then Exit Function
  6.    
  7.     m_hWnd = hwnd
  8.     m_dwOriginStyle = GetWindowLong(m_hWnd, GWL_STYLE)
  9.    
  10.     dwNewStyle = m_dwOriginStyle Or LVS_OWNERDRAWFIXED
  11.     Call SetWindowLong(m_hWnd, GWL_STYLE, dwNewStyle)
  12.    
  13.     m_hHeaderWnd = SendMessage(m_hWnd, LVM_GETHEADER, 0, 0)
  14.     m_hParentWnd = GetParent(m_hWnd)
  15.    
  16.     Call Subclass_Start(m_hWnd)
  17.     Call Subclass_Start(m_hParentWnd)
  18.     Call Subclass_AddMsg(m_hWnd, WM_NCDESTROY, MSG_BEFORE)
  19.     Call Subclass_AddMsg(m_hParentWnd, WM_MEASUREITEM, MSG_BEFORE)
  20.     Call Subclass_AddMsg(m_hParentWnd, WM_DRAWITEM, MSG_BEFORE)

  22.     Call UpdateAll
  23.    
  24.     Attach = True
  25. End Function

  27. Public Function Detach() As Boolean
  28.     Detach = False
  29.     If (m_hWnd = 0) Then Exit Function
  30.    
  31.     Call SetWindowLong(m_hWnd, GWL_STYLE, m_dwOriginStyle)
  32.    
  33.     Call Subclass_StopAll
  34.    
  35.    
  36.     Call UpdateAll
  37.    
  38.     m_hWnd = 0
  39.     m_dwOriginStyle = 0
  40.    
  41.     Detach = True
  42. End Function

  44. Public Property Get ItemBkColor1() As Long
  45.     Let ItemBkColor1 = m_clrItemBkColor1
  46. End Property

  48. Public Property Let ItemBkColor1(ByVal clr As Long)
  49.     m_clrItemBkColor1 = clr
  50.    
  51.     If (m_hItemBkBrush1 <> 0) Then
  52.         Call DeleteObject(m_hItemBkBrush1)
  53.         m_hItemBkBrush1 = 0
  54.     End If
  55.     m_hItemBkBrush1 = CreateSolidBrush(m_clrItemBkColor1)
  56.    
  57.     Call UpdateAll
  58. End Property

  60. Public Property Get ItemBkColor2() As Long
  61.     Let ItemBkColor2 = m_clrItemBkColor2
  62. End Property

  64. Public Property Let ItemBkColor2(ByVal clr As Long)
  65.     m_clrItemBkColor2 = clr
  66.    
  67.     If (m_hItemBkBrush2 <> 0) Then
  68.         Call DeleteObject(m_hItemBkBrush2)
  69.         m_hItemBkBrush2 = 0
  70.     End If
  71.     m_hItemBkBrush2 = CreateSolidBrush(m_clrItemBkColor2)
  72.    
  73.     Call UpdateAll
  74. End Property

  76. Public Property Get GridColor() As Long
  77.     Let GridColor = m_clrGridColor
  78. End Property

  80. Public Property Let GridColor(ByVal clr As Long)
  81.     m_clrGridColor = clr
  82.    
  83.     If (m_hGridPen <> 0) Then
  84.         Call DeleteObject(m_hGridPen)
  85.         m_hGridPen = 0
  86.     End If
  87.     m_hGridPen = CreatePen(PS_SOLID, 1, m_clrGridColor)
  88.    
  89.     Call UpdateAll
  90. End Property

  92. Public Property Get SelectedItemBkColor() As Long
  93.     Let SelectedItemBkColor = m_clrSelectedItemBkColor
  94. End Property

  96. Public Property Let SelectedItemBkColor(ByVal clr As Long)
  97.     m_clrSelectedItemBkColor = clr
  98.    
  99.     If (m_hSelectedItemBkBrush <> 0) Then
  100.         Call DeleteObject(m_hSelectedItemBkBrush)
  101.         m_hSelectedItemBkBrush = 0
  102.     End If
  103.     m_hSelectedItemBkBrush = CreateSolidBrush(m_clrSelectedItemBkColor)
  104.    
  105.     Call UpdateAll
  106. End Property

  108. Public Property Get ItemBkColorHorizontal() As Boolean
  109.     ItemBkColorHorizontal = m_bItemBkColorHorizontal
  110. End Property

  112. Public Property Let ItemBkColorHorizontal(ByVal b As Boolean)
  113.     m_bItemBkColorHorizontal = b
  114.     Call UpdateAll
  115. End Property

  117. Public Property Get ItemHeight() As Long
  118.     ItemHeight = m_nItemHeight
  119. End Property

  121. Public Property Let ItemHeight(ByVal n As Long)
  122.     m_nItemHeight = n
  123.     Call UpdateAll
  124. End Property

  126. Public Property Get ShowGird() As Boolean
  127.     ShowGird = m_bShowGrid
  128. End Property

  130. Public Property Let ShowGird(ByVal b As Boolean)
  131.     m_bShowGrid = b
  132.     Call UpdateAll
  133. End Property


ivccav 楼主 10楼

2023-3-25 00:21



应用案例。窗体中有一个textbox，一个Listview，是一个模糊查询的通用界面


  2. Option Explicit

  4. Private Type RECT
  5.         Left                        As Long
  6.         Top                         As Long
  7.         Right                       As Long
  8.         Bottom                      As Long
  9. End Type

  11. Private Type WINDOWPOS
  12.   hwnd                              As Long
  13.   hWndInsertAfter                   As Long
  14.   x                                 As Long
  15.   y                                 As Long
  16.   cx                                As Long
  17.   cy                                As Long
  18.   flags                             As Long
  19. End Type

  21. Private Const WM_WINDOWPOSCHANGED   As Long = &H47
  22. Private Const SWP_NOACTIVATE        As Long = &H10
  23. Private Const SWP_NOMOVE            As Long = &H2
  24. Private Const SWP_NOOWNERZORDER     As Long = &H200
  25. Private Const SWP_NOZORDER          As Long = &H4

  27. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
  28.     ByVal hwnd As Long, _
  29.     ByVal wMsg As Long, _
  30.     ByVal wParam As Long, _
  31.     lParam As Any) As Long
  32. Private Declare Function GetWindowRect Lib "user32" ( _
  33.     ByVal hwnd As Long, _
  34.     lpRect As RECT) As Long
  35. Private Declare Function GetParent Lib "user32" ( _
  36.     ByVal hwnd As Long) As Long

  38. Private arrdata
  39. Private Custom_Listview As CCustomListView
  40. '
  41. Private Sub UserForm_Initialize()
  42.     Dim i&, j&
  43.     TextBox1.ControlTipText = "关键词按销售合约或产品编号模糊查询"
  44.     arrdata = Sheet1.Range("a1").CurrentRegion
  45.     With ListView1
  46.         .View = lvwReport '必选
  47.         .FullRowSelect = True '必选
  48.         .Font.Size = 12
  49.         .LabelEdit = lvwManual
  50.         .MultiSelect = True
  51.         .CheckBoxes = True '未实现复选框功能，但可按住ctrl多选
  52.         .ColumnHeaders.Add , , arrdata(1, 1), 60, lvwColumnLeft
  53.         
  54.         For i = 2 To UBound(arrdata, 2)
  55.             .ColumnHeaders.Add , , arrdata(1, i), 80, lvwColumnCenter
  56.         Next
  57.         For i = 2 To UBound(arrdata)
  58.             With .ListItems.Add
  59.                 .Text = arrdata(i, 1)
  60.                 For j = 2 To UBound(arrdata, 2)
  61.                     .SubItems(j - 1) = arrdata(i, j)
  62.                 Next
  63.             End With
  64.         Next
  65.     End With
  66.    
  67.     Set Custom_Listview = New CCustomListView
  68.     With Custom_Listview
  69.         .ItemBkColor1 = &HFFC0C0 '交替换色1，实际用于第2行/列颜色
  70.         .ItemBkColor2 = &HFDF8F0 '交替换色2，实际用于第1行/列颜色
  71.         .SelectedItemBkColor = &HABECFC '被选中行的高亮颜色
  72.         .ItemHeight = 32 '行高设置
  73.         .ItemBkColorHorizontal = False '为False时隔行换色，True时隔列
  74.         .ShowGird = True '为True时显示网格线
  75.         .GridColor = vbRed '设置网格线颜色
  76.         .Attach ListView1.hwnd
  77.     End With
  78.     TextBox1.SetFocus
  79. End Sub

  81. Private Sub UserForm_Activate()
  82.     ListViewRefresh
  83. End Sub

  85. Private Sub TextBox1_Change()
  86.     Dim i As Long, j As Long
  87.     Dim lstitem As ListItem
  88.     Dim strKey As String
  89.     If IsEmpty(arrdata) Then Exit Sub
  90.     With ListView1
  91.         For i = 1 To .ColumnHeaders.Count
  92.             .ColumnHeaders(i).Icon = 0
  93.         Next
  94.         .ListItems.Clear '清空原有所有数据
  95.         For i = 2 To UBound(arrdata)
  96.             strKey = arrdata(i, 3) & arrdata(i, 5)  '按第3、5列内容为关键词模糊查询
  97.             If InStr(strKey, UCase(TextBox1)) Then '可以使用Instr，也可以使用Like语句
  98.                 Set lstitem = .ListItems.Add 'Add方法在Listview最后面添加一行空行
  99.                 lstitem.Text = arrdata(i, 1) '给新增的空行第一列赋值
  100.                 For j = 2 To UBound(arrdata, 2)
  101.                     lstitem.SubItems(j - 1) = arrdata(i, j) '给新增行除第一列之外的其他列赋值，用SubItems属性
  102.                 Next
  103.             End If
  104.         Next
  105.     End With
  106.     ListViewRefresh
  107. End Sub

  109. '新增的过程。无此过程，控件无法触发WM_MEASUREITEM消息
  110. '修改行高只能在收到发WM_MEASUREITEM时进行修改

  112. Private Sub ListViewRefresh()
  113.     Dim rc As RECT, wp As WINDOWPOS
  114.     ListView1.Refresh
  115.     GetWindowRect ListView1.hwnd, rc
  116.     wp.hwnd = ListView1.hwnd
  117.     wp.cx = rc.Right - rc.Left
  118.     wp.cy = rc.Bottom - rc.Top
  119.     wp.flags = SWP_NOACTIVATE Or SWP_NOMOVE Or SWP_NOOWNERZORDER Or SWP_NOZORDER
  120.     SendMessage ListView1.hwnd, WM_WINDOWPOSCHANGED, 0, wp
  121. End Sub





加载更多
高级模式
插入