您可以使用 Windows API 在 VBA 中更改用户窗体标题栏的颜色吗?
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/23634056/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Can you change the color of the titlebar of a userform in VBA using Windows API?
提问by Alex K.
Is it possible to change the color of the title bar for a VBA userform using Windows API. Please note that I am only interested in changing the color of the title bar for a particular userform and not a system-wide them change. Thanks!
是否可以使用 Windows API 更改 VBA 用户窗体的标题栏颜色。请注意,我只对更改特定用户表单的标题栏颜色感兴趣,而不是在系统范围内更改它们。谢谢!
回答by Alex K.
Just for fun;
只是为了好玩;
UserForm:
用户表格:
Private gHWND As Long
Private Sub Label1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
If Button = 1 Then HandleDragMove gHWND
End Sub
Private Sub UserForm_Initialize()
gHWND = Setup(Me)
End Sub
Private Sub UserForm_Click()
Unload Me
End Sub
*.BAS
*.BAS
Option Explicit
Private Const WM_NCLBUTTONDOWN = &HA1&
Private Const HTCAPTION = 2&
Private Const GWL_STYLE = (-16)
Private Const WS_BORDER = &H800000
Private Const WS_DLGFRAME = &H400000
Private Const WS_CAPTION = WS_BORDER Or WS_DLGFRAME
Private Declare Sub ReleaseCapture Lib "User32" ()
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 Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal HWND As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal HWND As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Function Setup(objForm As Object) As Long
Setup = FindWindow("ThunderDFrame", objForm.Caption)
SetWindowLong Setup, GWL_STYLE, GetWindowLong(Setup, GWL_STYLE) And Not WS_CAPTION
End Function
Public Sub HandleDragMove(HWND As Long)
Call ReleaseCapture
Call SendMessage(HWND, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub
(Would need mod for 64bit Office)
(64位Office需要mod)