深圳全飞鸿
标题:
VB中ToolBar改颜色的官方方法
[打印本页]
作者:
zhgc
时间:
2019-5-4 16:53
标题:
VB中ToolBar改颜色的官方方法
摘自:Modules.crack_toolbar.bas
Option Explicit
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwnewlong As Long) As Long
Private Declare Function OleTranslateColor Lib "oleaut32.dll" (ByVal lOleColor As Long, ByVal lHPalette As Long, ByRef lColorRef As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32.dll" (ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32.dll" (ByVal hBitmap As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long
Private Const GCL_HBRBACKGROUND As Long = -10
Private Function GDI_TranslateColor(OleClr As OLE_COLOR, Optional hPal As Integer = 0) As Long
If OleTranslateColor(OleClr, hPal, GDI_TranslateColor) Then
GDI_TranslateColor = &HFFFF&
End If
End Function
Function GDI_CreateSoildBrush(bColor As OLE_COLOR) As Long
GDI_CreateSoildBrush = CreateSolidBrush(GDI_TranslateColor(bColor))
End Function
Public Sub SetToolbarBK(hwnd As Long, hColor As OLE_COLOR)
DeleteObject SetClassLong(hwnd, GCL_HBRBACKGROUND, GDI_CreateSoildBrush(hColor))
InvalidateRect 0&, 0&, False
End Sub
复制代码
作者:
zhgc
时间:
2019-5-4 16:54
用法:
'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
欢迎光临 深圳全飞鸿 (http://www.nagomes.com/disc/)
Powered by Discuz! X3.2