深圳全飞鸿

 找回密码
 立即注册
搜索
热搜: 活动 交友 discuz
查看: 565|回复: 1
打印 上一主题 下一主题

VB中ToolBar改颜色的官方方法

[复制链接]

800

主题

1379

帖子

7705

积分

版主

Rank: 7Rank: 7Rank: 7

积分
7705
跳转到指定楼层
楼主
发表于 2019-5-4 16:53:43 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
摘自:Modules.crack_toolbar.bas

  1. Option Explicit
  2. Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwnewlong As Long) As Long
  3. Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByRef lColorRef As Long) As Long
  4. Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
  5. Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
  6. Private Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
  7. Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long

  8. Private Const GCL_HBRBACKGROUND As Long = -10

  9. Private Function GDI_TranslateColor(OleClr As OLE_COLOR, Optional hPal As Integer = 0) As Long
  10. If OleTranslateColor(OleClr, hPal, GDI_TranslateColor) Then
  11. GDI_TranslateColor = &HFFFF&
  12. End If
  13. End Function

  14. Function GDI_CreateSoildBrush(bColor As OLE_COLOR) As Long
  15. GDI_CreateSoildBrush = CreateSolidBrush(GDI_TranslateColor(bColor))
  16. End Function

  17. Public Sub SetToolbarBK(hwnd As Long, hColor As OLE_COLOR)
  18. DeleteObject SetClassLong(hwnd, GCL_HBRBACKGROUND, GDI_CreateSoildBrush(hColor))
  19. InvalidateRect 0&, 0&, False
  20. End Sub
复制代码
回复

使用道具 举报

800

主题

1379

帖子

7705

积分

版主

Rank: 7Rank: 7Rank: 7

积分
7705
沙发
 楼主| 发表于 2019-5-4 16:54:27 | 只看该作者
用法:

'Private Sub Command1_Click()
'Call SetToolbarBK(Toolbar1.hwnd, vbYellow)
'Call SetToolbarBK(Toolbar1.hwnd, QBColor(Int(Rnd * 16)))  '随机色
'End Sub

'Private Sub Form_Unload(Cancel As Integer)
' SetToolbarBK Toolbar1.hwnd, vbButtonFace
'End Sub


'SetToolbarBK Me.tlbtoolbar.hwnd, Me.BackColor
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|小黑屋|nagomes  

GMT+8, 2025-5-5 04:53 , Processed in 0.023899 second(s), 20 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

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