VBA原生控件开发：让你的窗体也能用上状态栏

晚间有风弄枝叶

第7期-创建有多个部分的状态栏


在上期的文章中，我们介绍了状态栏拆分的原理，以及要使用到的两个消息SB_SETPARTS和SB_GETPARTS。那么，这期文章就给出完整的应用代码：创建一个具有多个组成部分的状态栏！

创建一个具有多个组成部分的状态栏

大家依旧只需要复制粘贴以下两个代码即可：

1. 新建一个类模块，命名为TheStatusBar，添加以下代码

1. #If VBA7 And Win64 Then
   
2.     Private ParentWindow As LongPtr
   
3.     Private ParentClient As LongPtr
   
4.     Private StatusBar As LongPtr
   
5.     Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
   
6.     Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
   
7.     Private Declare PtrSafe Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal HwndParent As LongPtr, ByVal hMenu As LongPtr, ByVal Hinstance As LongPtr, lpParam As Any) As LongPtr
   
8.     Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
   
9.     Private Declare PtrSafe Function DestroyWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
   
10.     Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
    
11.     Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr
    
12.     Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long
    
13. #Else
    
14.     Private ParentWindow As Long
    
15.     Private ParentClient As Long
    
16.     Private StatusBar As Long
    
17.     Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    
18.     Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
    
19.     Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal HwndParent As Long, ByVal hMenu As Long, ByVal Hinstance As Long, lpParam As Any) As Long
    
20.     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
    
21.     Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
    
22.     Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    
23.     Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" (ByVal Hwnd As Long, ByVal nIndex As Long) As Long
    
24.     Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
    
25. #End If
    
26.     Private Const STATUSCLASSNAME = "msctls_statusbar32"
    
27.     Private Const WS_CHILD = &H40000000
    
28.     Private Const WS_VISIBLE = &H10000000
    
29.     Private Const CCS_TOP = &H1
    
30.     Private Const SBARS_SIZEGRIP = &H100
    
31.     Private Const SBT_TOOLTIPS = &H800
    
32.     Private Const WM_SIZE = &H5
    
33.     Private Const GWL_STYLE = (-16)
    
34.     Private Const WS_THICKFRAME = &H40000
    
35.     Private Const WS_MINIMIZEBOX = &H20000
    
36.     Private Const WS_MAXIMIZEBOX = &H10000
    
37.     Private Const WM_USER = &H400
    
38.     Private Const SB_SETPARTS = (WM_USER + 4)
    
39.     Private Const SB_GETPARTS = (WM_USER + 6)
    
40.     Private Type RECT
    
41.         Left As Long
    
42.         Top As Long
    
43.         Right As Long
    
44.         Bottom As Long
    
45.     End Type
    
46. Sub Create(ByVal Caption As String)
    
47.     ParentWindow = FindWindow(IIf(Application.Version < 9, "ThunderXFrame", "ThunderDFrame"), Caption)
    
48.     ParentClient = FindWindowEx(ParentWindow, 0, vbNullString, vbNullString)
    
49.     StatusBar = CreateWindowEx(0, STATUSCLASSNAME, vbNullString, WS_CHILD Or WS_VISIBLE Or SBARS_SIZEGRIP, 0, 0, 0, 0, ParentClient, 0, 0, ByVal 0)
    
50.     Split
    
51. End Sub
    
52. Sub Destroy()
    
53.     If StatusBar Then
    
54.         DestroyWindow StatusBar
    
55.         StatusBar = 0
    
56.     End If
    
57. End Sub
    
58. Sub Refresh()
    
59.     Split
    
60.     SendMessage StatusBar, WM_SIZE, 0, ByVal 0
    
61. End Sub
    
62. Sub Split()
    
63.     Dim Cret As RECT: GetClientRect ParentWindow, Cret
    
64.     Dim Part(2) As Long: Part(0) = 22: Part(1) = (3 / 4) * Cret.Right: Part(2) = -1
    
65.     SendMessage StatusBar, SB_SETPARTS, UBound(Part) + 1, ByVal VarPtr(Part(0))
    
66. End Sub
    
67. Property Let IsParentTrickFrame(ByVal Value As Boolean)
    
68.     If Value Then
    
69.         SetWindowLongPtr ParentWindow, GWL_STYLE, GetWindowLongPtr(ParentWindow, GWL_STYLE) Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
    
70.     Else
    
71.         SetWindowLongPtr ParentWindow, GWL_STYLE, GetWindowLongPtr(ParentWindow, GWL_STYLE) And Not (WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
    
72.     End If
    
73. End Property
    
74. Property Get PartsCount() As Long
    
75.     PartsCount = CLng(SendMessage(StatusBar, SB_GETPARTS, 0, ByVal 0))
    
76. End Property
    
77. Property Get PartsRight() As String
    
78.     Dim Parts&, i&: ReDim Part(1 To 256) As Long
    
79.     Parts = CLng(SendMessage(StatusBar, SB_GETPARTS, 256, ByVal VarPtr(Part(1))))
    
80.     ReDim Preserve Part(1 To Parts) As Long
    
81.     PartsRight = Part(1)
    
82.     For i = 2 To Parts
    
83.         PartsRight = PartsRight & "," & Part(i)
    
84.     Next
    
85. End Property

复制代码

2. 新建一个窗体，命名为UserForm1，添加以下代码

1. Private StatusBar As New TheStatusBar
   
2. Private Sub UserForm_Initialize()
   
3.     StatusBar.Create Me.Caption
   
4. End Sub
   
5. Private Sub UserForm_Terminate()
   
6.     StatusBar.Destroy
   
7.     Set StatusBar = Nothing
   
8. End Sub
   
9. Private Sub UserForm_Resize()
   
10.     StatusBar.Refresh
    
11. End Sub
    
12. Private Sub UserForm_Click()
    
13.     StatusBar.IsParentTrickFrame = True
    
14. End Sub
    
15. Private Sub UserForm_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
16.     If Button = 2 Then MsgBox "当前状态栏被拆分为" & StatusBar.PartsCount & "个部件，每个部件的右边缘位置为" & StatusBar.PartsRight, vbInformation + vbOKOnly, "LELEDY"
    
17. End Sub

复制代码

接下来，大家就可以运行窗体代码了。你可以使用鼠标左键/右键单击窗体的空白区域，以触发不同的效果。左键之后可以使窗体支持大小调整功能，右键之后可以查看状态栏各个部件的信息。



第7期-创建有多个部分的状态栏.rar (47.16 KB, 下载次数: 5)

2025-12-7 10:10 上传

点击文件名下载附件

以上就是本期的全部内容了，我们下期再见。
下期，晚间会带领大家实现状态栏最核心的功能——显示文本内容！

晚间有风弄枝叶

论坛一天一更频率太高了停一段时间后面再更，公众号才更到第四期，需要赶赶公众号的进度

最新动态和全功能版本的状态栏控件在这里：https://mp.weixin.qq.com/s/0B_4G_iIUuFnf-WTJECwTg

aman1516

楼主加油，感谢分享

晚间有风弄枝叶

aman1516 发表于 2025-12-7 13:47
楼主加油，感谢分享

谢谢支持

晚间有风弄枝叶

第8期-更改状态栏的显示文本


在上期的文章中，我们已经创建了一个具有多个组成部分的状态栏了，那么如何为每个部分添加对应的文本内容就是本期要解决的问题。学会了如何更改状态栏的显示文本，状态栏才能发挥它真正的作用！


更改状态栏的显示文本

以下是微软机翻官方文档中的描述：

这段是关于SB_SETTEXT消息的使用介绍。段落采用“总分分”的结构布局，整体还是比较容易理解的。第一句，关键字“通过发送”和“来设置”，阐述了SB_SETTEXT是用于设置状态栏指定部件显示文本的消息。此消息需要分别指定三个参数：状态栏从左到右的部件索引、显示文本的字符串地址、以及绘制字符串的技术。第二句，关键字“绘图技术确定”，说的就是绘制字符串的技术，比如可以用于确定是否绘制边框。第三句，关键字“它还确定”，说的还是绘制字符串的技术。自绘技术SBT_OWNERDRAW，用于确定文本是否由父窗口绘制。如果是那么SB_SETTEXT消息就不再负责指定部件的文本绘制，而是给父窗口发送一个WM_DRAWITEM消息，让父窗口完成这个部件的文本绘制。


这段是关于如何设置状态栏显示文本的对齐方式的使用介绍。需要注意的是，原文给出的制表符\t，并非VBA语言采用的表达式。在VBA中，我们要使用vbTab或Chr(9)来表示制表符。状态栏的显示文本默认左对齐，一个制表符右侧的文本会居中，两个制表符右侧的文本会右对齐。

下图中的居中文本该如何在VBA中表达？

答案是：Chr(9) & "晚间有雨伴人眠的UserForm工坊"。


答案是："晚间有雨伴人眠" & Chr(9) & "的" & Chr(9) & "UserForm工坊"。

1. SB_SETTEXT消息
以下是微软机翻官方文档中的描述：

我们先给出，SB_SETTEXT消息的具体使用方法：

1. Sub Change(ByVal Index As Long, ByVal Text As String, Optional Operation As Long = 0)
   
2.     SendMessage StatusBar, SB_SETTEXTW, Index Or Operation, ByVal StrPtr(Text)
   
3. End Sub

复制代码

在Change过程中参数Index和Operation共同组成了SB_SETTEXTW消息的wParam参数，形式为Index Or Operation。这部分我们可以在上图中找到。其中，Operation为可选参数Optional，这意味着我们在调用时可以省略它。

如需更改状态栏第二个部件的文本为123，可以表达为：

1. Change 1, "123"

复制代码

如需更改状态栏第三个部件为自绘模式，可以表达为：

1. Change 1, "123", SBT_OWNERDRAW

复制代码

相关常量定义：

1. Private Const WM_USER = &H400
   
2. Private Const SB_SETTEXTW = (WM_USER + 11)
   
3. Private Const WM_DRAWITEM = &H2B
   
4. Private Const SBT_OWNERDRAW = &H1000
   
5. Private Const SBT_NOBORDERS = &H100
   
6. Private Const SBT_POPOUT = &H200
   
7. Private Const SBT_RTLREADING = &H400

复制代码

以上就是本期的全部内容了，我们下期再见。
下期，晚间会带领大家学习如何获取状态栏的显示文本，只有把它搞懂，我们才能去创建一个有文本内容的状态栏。