ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 EH云课堂直播课程免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 2976|回复: 18

[原创] 用NM_CUSTOMDRAW重绘技术实现Listview控件隔行换色

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-8-3 18:54 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:Windows API应用

实现Listview控件隔行更换背景色的主流方法是利用VB6中的picturebox控件在VBA窗体中绘制图片,模拟背景色的效果。这种方法的缺点非常明显,例如需要安装一个DLL控件才能使用picturebox,且受限于picturebox的高度,只能绘制600多行数据范围的背景图,超过600行就没有办法绘制了。相关内容可看:
知识树:VBA下用的PictureBox控件(ListView隔行不同颜色轻松显示)

如果数据量比较大,ListView隔行不同颜色显示出现故障


我在VBA窗体Listview控件完全教程 帖中给出了一个完美的办法,利用事先保存的图片做背景图片,模拟隔行换色的效果,功能上十分完美,能显示任何行数的数据,但是因为没有使用任何代码,只是巧妙地利用了Listview的某个属性,显得没有技术含量。内心一直想要实现Listview原生修改行列背景色的功能。

一个月前,偶然看到别人的一个提问:怎么在Listview中对特定行、列进行背景颜色和字体颜色的修改,知道了CUSTOMDRAW重绘技术,隐约觉得可以挪到VBA中。别人的提问如下:

if ( CDDS_PREPAINT == pLVCD->nmcd.dwDrawStage )
   {
        *pResult = CDRF_NOTIFYITEMDRAW;
   }
else if ( CDDS_ITEMPREPAINT == pLVCD->nmcd.dwDrawStage )
   {
        *pResult = CDRF_NOTIFYSUBITEMDRAW;
   }
else if ( (CDDS_ITEMPREPAINT | CDDS_SUBITEM) == pLVCD->nmcd.dwDrawStage )
   {
        //这里改变背景和字体颜色
         *pResult = CDRF_NOTIFYPOSTPAINT;
   }
else if ( CDDS_ITEMPOSTPAINT == pLVCD->nmcd.dwDrawStage )
   {
        //在这里进行画图,但怎么都无法进入
    }


搜索CUSTOMDRAW,很遗憾,相关技术很少,而应用到VBA中的则没有任何搜索结果。于是我只好硬着头皮阅读C++代码。说实在的,C++是10多年前学过的东西,现在连语法符合都不认识了。没办法,只能以时间换空间,有空就研究几句,并在微软官网啃食英文文档,慢慢理解了重绘的原理和过程,并在学习过程中,逐渐找到非常珍贵的几条VB语言的相似内容,东拼西凑,东改西改,终于搞成功了:实现了Listview任意行、任意列、任意单元格的前景色和背景色的更改。



CUSTOMDRAW是一个强大而高效的技术,不仅能更改Listview行、列的前景色和背景色,还能更改Listview标题行的前景色和背景色,甚至Listview网格线颜色,还可以应用到其他列表控件。言归正传,以下为我“研究”的成果图和源代码,并附上部分资料(我翻译水平差,请以原文原义为准):

特别提示:窗口过程函数要求传递的Listview控件的父窗体句柄不是Userform1的句柄,而是Userform1的客户区窗口句柄。我开始没搞明白,一直都没有变化,差点放弃了,还好用SPY++看了一下。

模块中代码:

  1. Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  2. Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  3. Public Const NM_CUSTOMDRAW = (-12&)
  4. Public Const WM_NOTIFY As Long = &H4E&
  5. Public Const CDDS_PREPAINT As Long = &H1&
  6. Public Const CDRF_NOTIFYITEMDRAW As Long = &H20&
  7. Public Const CDRF_NOTIFYSUBITEMDRAW As Long = &H20&
  8. Public Const CDDS_ITEM As Long = &H10000
  9. Public Const CDDS_SUBITEM As Long = &H20000
  10. Public Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
  11. Public Const CDRF_NEWFONT As Long = &H2&

  12. Public Type NMHDR
  13.     hWndFrom As Long
  14.     idFrom As Long
  15.     code  As Long
  16. End Type

  17. Public Type RECT
  18.     Left As Long
  19.     Top As Long
  20.     Right As Long
  21.     Bottom As Long
  22. End Type

  23. Public Type NMCUSTOMDRAW
  24.     hdr As NMHDR
  25.     dwDrawStage As Long
  26.     hDC As Long
  27.     rc As RECT
  28.     dwItemSpec As Long
  29.     uItemState As Long
  30.     lItemlParam As Long
  31. End Type

  32. Public Type NMLVCUSTOMDRAW
  33.     nmcd As NMCUSTOMDRAW
  34.     clrText As Long
  35.     clrTextBk As Long
  36.     iSubItem As Long
  37. End Type

  38. Public PreWndProc As Long

  39. Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  40.     Select Case uMsg
  41.         Case WM_NOTIFY
  42.         Dim tNMHDR As NMHDR
  43.         CopyMemory tNMHDR, ByVal lParam, Len(tNMHDR)
  44.         With tNMHDR
  45.             If .code = NM_CUSTOMDRAW Then
  46.                 Dim tNMLVCUSTOMDRAW As NMLVCUSTOMDRAW
  47.                 CopyMemory tNMLVCUSTOMDRAW, ByVal lParam, Len(tNMLVCUSTOMDRAW)
  48.                 With tNMLVCUSTOMDRAW.nmcd
  49.                     Select Case .dwDrawStage
  50.                         Case CDDS_PREPAINT
  51.                             WindowProc = CDRF_NOTIFYITEMDRAW
  52.                             Exit Function
  53.                         Case CDDS_ITEMPREPAINT
  54.                             WindowProc = CDRF_NOTIFYSUBITEMDRAW
  55.                             Exit Function
  56.                         Case CDDS_ITEMPREPAINT Or CDDS_SUBITEM
  57.                             Dim iItem&, iSubItem&
  58.                             iItem = .dwItemSpec + 1 '行号
  59.                             iSubItem = tNMLVCUSTOMDRAW.iSubItem + 1 '列号
  60.                            
  61.                             tNMLVCUSTOMDRAW.clrText = IIf(iSubItem Mod 2, vbRed, vbBlue) '奇数列红色,偶数列蓝色,也可任意设置
  62.                             tNMLVCUSTOMDRAW.clrTextBk = IIf(iSubItem Mod 2, RGB(187, 255, 255), RGB(255, 211, 155))
  63.                            
  64. '                            tNMLVCUSTOMDRAW.clrText = IIf(iItem Mod 2, vbRed, vbBlue) '奇数行红色,偶数行蓝色,也可任意设置
  65. '                            tNMLVCUSTOMDRAW.clrTextBk = IIf(iItem Mod 2, RGB(187, 255, 255), RGB(255, 211, 155))
  66.                            
  67. '                            tNMLVCUSTOMDRAW.clrText = IIf(iItem = iSubItem, vbRed, vbBlue) '对角线上的单元格:红色,也可设置任意单元格
  68. '                            tNMLVCUSTOMDRAW.clrTextBk = IIf(iItem = iSubItem, RGB(187, 255, 255), RGB(255, 211, 155))
  69.                            
  70.                             CopyMemory ByVal lParam, tNMLVCUSTOMDRAW, Len(tNMLVCUSTOMDRAW)
  71.                             WindowProc = CDRF_NEWFONT
  72.                             Exit Function
  73.                     End Select
  74.                 End With
  75.             End If
  76.         End With
  77.     End Select
  78.     WindowProc = CallWindowProc(PreWndProc, hwnd, uMsg, wParam, lParam)
  79. End Function


复制代码


窗体中代码:

  1. Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  2. Private Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
  3. Private Const GWL_WNDPROC As Long = (-4&)

  4. Private hWndLVParent As Long

  5. Private Sub UserForm_Initialize()
  6.     Dim i&, j&
  7.     With ListView1
  8.         .View = lvwReport
  9.         .FullRowSelect = True
  10.         .LabelEdit = lvwManual
  11.         .Gridlines = True
  12.         .SmallIcons = ImageList1
  13.         .Font.Size = 12
  14.         For i = 1 To 20
  15.             .ColumnHeaders.Add , , "第" & i & "列", 50
  16.         Next
  17.         
  18.         For i = 1 To 20
  19.             With .ListItems.Add(, , Format(i, "00-") & "01")
  20.                 For j = 1 To 19
  21.                     .SubItems(j) = Format(i, "00-") & Format(j + 1, "00")
  22.                 Next
  23.             End With
  24.         Next
  25.         hWndLVParent = GetParent(.hwnd)
  26.     End With
  27.     PreWndProc = SetWindowLong(hWndLVParent, GWL_WNDPROC, AddressOf WindowProc)
  28. End Sub

  29. Private Sub UserForm_Terminate()
  30.     SetWindowLong hWndLVParent, GWL_WNDPROC, PreWndProc
  31. End Sub

复制代码
奇偶行.png

奇偶列.png

对角线.png

源代码和部分资料.zip (184.49 KB, 下载次数: 263)

评分

参与人数 8鲜花 +14 技术 +1 收起 理由
zhu945275 + 2 感谢帮助
EXCEL20022002 + 2 优秀作品
吴狄 + 2
一把小刀闯天下 + 2 太强大了
xyxcc177 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2018-8-3 23:25 | 显示全部楼层
这个原理就是拦截一下控件消息,然后自己随便写

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-4 08:03 | 显示全部楼层


设置标题的前景色和背景色的效果:

QQ图片20180804080104.png

listview中设置标题的前景色和背景色.zip (18.02 KB, 下载次数: 111)

评分

参与人数 3鲜花 +7 收起 理由
小fisher + 3 优秀作品
yunfei2018 + 2 太强大了
不知何故 + 2 优秀作品

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-4 14:55 | 显示全部楼层
居然发现标题错了,不应该叫重绘技术,而应该叫自定义绘制技术,懒得改了。Listview并不是重新绘制,而是在listview项绘制前拦截消息,修改感兴趣的属性,再把消息返回给原来窗口函数处理。

TA的精华主题

TA的得分主题

发表于 2018-8-4 22:54 | 显示全部楼层
listview属于vb的控件,原则上不赞成在vba里面使用它,因为微软可能会不定时以安全为理由更新控件版本,然后以前使用了vb控件的文件你会发现全都打不开了,虽然这种事情概率不高,但在2015年已经发生一次了。此外,vb控件无法在64位office下使用,这是个致命的问题。

另外说一下,listview自定义绘制在C#里面可以很轻松的实现,既然都是用非vba的东西,为啥不逐步向微软推荐的语言转变呢,无论是兼容性还是技术方便性,C#都远远高于vb。

当然,最后还是要感谢作者的技术分享,谢谢对论坛的支持。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-8-4 23:07 | 显示全部楼层
liucqa 发表于 2018-8-4 22:54
listview属于vb的控件,原则上不赞成在vba里面使用它,因为微软可能会不定时以安全为理由更新控件版本,然 ...

感谢建议!

也想过去接触C#,因为VB6是要被微软淘汰的对象,也许某一天就不能用了也未可知。

看来真的需要学点C#了。

TA的精华主题

TA的得分主题

发表于 2018-8-20 20:05 | 显示全部楼层
ivccav 发表于 2018-8-4 23:07
感谢建议!

也想过去接触C#,因为VB6是要被微软淘汰的对象,也许某一天就不能用了也未可知。

64位的office 不能應用嗎
不是說安個exe就能用嗎?

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-8 21:18 | 显示全部楼层
chis3 发表于 2018-8-20 20:05
64位的office 不能應用嗎
不是說安個exe就能用嗎?

应该不可以用64位的Office吧,我没有试过。我没有64位的系统。

TA的精华主题

TA的得分主题

发表于 2018-9-26 14:40 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-10-12 08:25 | 显示全部楼层
ivccav 发表于 2018-8-4 08:03
设置标题的前景色和背景色的效果:

这个蛮强大的,想请教一下:

如果只设置:
1、最后一行,指定字体颜色,背景颜色
2、第8列,第9列,指定字体颜色,背景颜色

如何修改了,谢谢!

文件中的代码看了,不知道咋修改,,,
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-10-22 05:05 , Processed in 0.083241 second(s), 16 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表