StatusBar Control (VBCCRStatusBar)
VBCCRStatusBar 控件提供了一个状态栏，用于在窗体底部显示应用程序的状态信息、提示信息和进度等。它支持多个面板，每个面板可以显示不同类型的信息。
属性
关键属性
Panels: 面板集合SimpleText: 简单文本模式下的文本SimplePanel: 是否使用简单面板模式Style: 状态栏样式SizeGrip: 是否显示大小调整手柄Height: 状态栏高度Enabled: 启用/禁用状态Visible: 可见性Align: 对齐方式（一般为底部）
方法
主要方法
AddPanel([Key As String], [Text As String], [Width As Long], [Style As PanelStyleConstants]): 添加面板RemovePanel(Index As Variant): 移除面板GetPanel(Index As Variant) As Panel: 获取面板对象ShowTips: 显示工具提示Refresh: 刷新显示
事件
PanelClick(Panel As Panel): 面板点击事件PanelDblClick(Panel As Panel): 面板双击事件MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
代码示例
基本用法
vb
Private Sub Form_Load()
' 配置状态栏
With StatusBar1
.SizeGrip = True
.SimplePanel = False
' 添加面板
.AddPanel , "就绪" ' 状态面板
.AddPanel , "行: 1, 列: 1" ' 光标位置面板
.AddPanel , "100%" ' 缩放面板
' 设置面板宽度
.GetPanel(1).Width = 1500
.GetPanel(2).Width = 1000
End With
End Sub多功能状态栏
vb
Private Sub CreateAdvancedStatusBar()
With StatusBar1
' 状态面板
.AddPanel "STATUS", "就绪", 1500
.GetPanel("STATUS").Style = sbrText
' 进度面板
.AddPanel "PROGRESS", "0%", 1000
.GetPanel("PROGRESS").Style = sbrProgress
.GetPanel("PROGRESS").Max = 100
' 日期时间面板
.AddPanel "DATETIME", Now, 2000
.GetPanel("DATETIME").Style = sbrDate
' 键盘状态面板
.AddPanel "KEYBOARD", "", 1000
UpdateKeyboardStatus
End With
End Sub
Private Sub UpdateKeyboardStatus()
Dim Status As String
Status = IIf(GetKeyState(vbKeyCapital) And 1, "CAP ", "") & _
IIf(GetKeyState(vbKeyNumlock) And 1, "NUM ", "") & _
IIf(GetKeyState(vbKeyScrollLock) And 1, "SCRL", "")
StatusBar1.GetPanel("KEYBOARD").Text = Status
End Sub
Private Sub Timer1_Timer()
' 更新日期时间
StatusBar1.GetPanel("DATETIME").Text = Now
End Sub进度显示
vb
Private Sub ShowProgress(ByVal Percentage As Long)
With StatusBar1.GetPanel("PROGRESS")
.Value = Percentage
.Text = Percentage & "%"
End With
End Sub
Private Sub ProcessFiles()
Dim i As Long
For i = 1 To 100
' 处理文件
ShowProgress i
DoEvents
Next i
StatusBar1.GetPanel("STATUS").Text = "处理完成"
End Sub常见用例
文件操作状态
vb
Private Sub ShowFileStatus(ByVal FileName As String)
With StatusBar1
' 显示文件名
.GetPanel(0).Text = "文件: " & FileName
' 显示文件大小
Dim FileLen As Long
FileLen = FileLen(FileName)
.GetPanel(1).Text = "大小: " & Format$(FileLen / 1024, "#,##0.0") & " KB"
' 显示修改时间
Dim FileDate As Date
FileDate = FileDateTime(FileName)
.GetPanel(2).Text = "修改: " & Format$(FileDate, "yyyy-mm-dd hh:nn")
End With
End Sub网络状态显示
vb
Private Enum ConnectionStatus
csOffline = 0
csConnecting = 1
csOnline = 2
End Enum
Private Sub UpdateNetworkStatus(ByVal Status As ConnectionStatus)
With StatusBar1.GetPanel("NETWORK")
Select Case Status
Case csOffline
.Text = "离线"
.BackColor = vbRed
Case csConnecting
.Text = "连接中..."
.BackColor = vbYellow
Case csOnline
.Text = "在线"
.BackColor = vbGreen
End Select
End With
End Sub最佳实践
- 面板管理
vb
Private Sub InitializePanels()
' 清除现有面板
StatusBar1.Panels.Clear
' 添加标准面板
With StatusBar1
.AddPanel "MSG", "", 2000 ' 消息
.AddPanel "POS", "", 1500 ' 位置
.AddPanel "INS", "INS", 400 ' 插入模式
.AddPanel "TIME", "", 1000 ' 时间
End With
' 设置面板样式
SetPanelStyles
End Sub
Private Sub SetPanelStyles()
With StatusBar1
.GetPanel("MSG").Style = sbrText
.GetPanel("POS").Style = sbrText
.GetPanel("INS").Style = sbrText
.GetPanel("TIME").Style = sbrText
' 设置面板提示
.GetPanel("MSG").ToolTipText = "状态消息"
.GetPanel("POS").ToolTipText = "光标位置"
.GetPanel("INS").ToolTipText = "插入模式"
.GetPanel("TIME").ToolTipText = "当前时间"
End With
End Sub- 错误处理
vb
Private Function UpdatePanel(ByVal Key As String, _
ByVal Text As String) As Boolean
On Error GoTo ErrorHandler
Dim Panel As Panel
Set Panel = StatusBar1.GetPanel(Key)
If Not Panel Is Nothing Then
Panel.Text = Text
UpdatePanel = True
End If
Exit Function
ErrorHandler:
UpdatePanel = False
Debug.Print "更新面板错误: " & Err.Description
End Function已知问题和解决方案
- 面板重绘问题
vb
Private Sub RefreshPanel(ByVal Index As Variant)
' 强制重绘面板
Dim Panel As Panel
Set Panel = StatusBar1.GetPanel(Index)
If Not Panel Is Nothing Then
Dim Text As String
Text = Panel.Text
Panel.Text = ""
Panel.Text = Text
End If
End Sub- 自动大小调整
vb
Private Sub Form_Resize()
' 调整最后一个面板的宽度
With StatusBar1
If .Panels.Count > 0 Then
Dim LastPanel As Panel
Set LastPanel = .GetPanel(.Panels.Count - 1)
Dim TotalWidth As Long
TotalWidth = 0
Dim i As Long
For i = 0 To .Panels.Count - 2
TotalWidth = TotalWidth + .GetPanel(i).Width
Next i
LastPanel.Width = .Width - TotalWidth - 100 ' 留出空间给大小调整手柄
End If
End With
End Sub高级特性
自定义绘制
vb
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DrawText Lib "user32" Alias "DrawTextA" ( _
ByVal hDC As Long, _
ByVal lpStr As String, _
ByVal nCount As Long, _
lpRect As RECT, _
ByVal wFormat As Long) As Long
Private Sub StatusBar1_DrawPanel(ByVal hDC As Long, _
ByVal Left As Long, _
ByVal Top As Long, _
ByVal Right As Long, _
ByVal Bottom As Long, _
Panel As Panel)
' 自定义面板绘制
Dim R As RECT
With R
.Left = Left
.Top = Top
.Right = Right
.Bottom = Bottom
End With
' 绘制文本
DrawText hDC, Panel.Text, -1, R, &H20 ' DT_SINGLELINE Or DT_VCENTER
End Sub进度动画
vb
Private Type ProgressInfo
Value As Long
Max As Long
Text As String
ShowText As Boolean
End Type
Private Progress As ProgressInfo
Private Sub InitProgress()
With Progress
.Value = 0
.Max = 100
.ShowText = True
End With
StartProgress
End Sub
Private Sub StartProgress()
Timer1.Interval = 50
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
With Progress
.Value = .Value + 1
If .Value > .Max Then .Value = 0
If .ShowText Then
.Text = Format$(.Value * 100 / .Max, "0") & "%"
End If
UpdateProgressPanel
End With
End Sub
Private Sub UpdateProgressPanel()
With StatusBar1.GetPanel("PROGRESS")
.Value = Progress.Value
If Progress.ShowText Then .Text = Progress.Text
End With
End Sub系统资源监视器
vb
Private Type MEMORYSTATUS
dwLength As Long
dwMemoryLoad As Long
dwTotalPhys As Long
dwAvailPhys As Long
dwTotalPageFile As Long
dwAvailPageFile As Long
dwTotalVirtual As Long
dwAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" ( _
lpBuffer As MEMORYSTATUS)
Private Sub UpdateSystemStatus()
Dim memStatus As MEMORYSTATUS
memStatus.dwLength = LenB(memStatus)
GlobalMemoryStatus memStatus
With StatusBar1
' 内存使用
.GetPanel("MEMORY").Text = "内存: " & _
Format$(memStatus.dwMemoryLoad, "0") & "%"
' CPU使用
.GetPanel("CPU").Text = "CPU: " & GetCPUUsage() & "%"
' 磁盘空间
.GetPanel("DISK").Text = "磁盘: " & _
Format$(GetDiskFreeSpace("C:\") / 1024 / 1024 / 1024, "#,##0.0") & " GB"
End With
End Sub
Private Function GetCPUUsage() As Long
' 这里添加获取CPU使用率的代码
' 可以使用WMI或性能计数器
End Function
Private Function GetDiskFreeSpace(ByVal Drive As String) As Double
' 这里添加获取磁盘剩余空间的代码
' 可以使用FileSystemObject或API
End Function