一、起因说明
之前有些项目是用Access完成的，当时为了给用户显示一些进度信息，自制了一个进度信息窗体，类似下图所示：
随着项目不断变迁，需要将进度信息按阶段及子进度进行显示，并且出于代码封装的需求，需要将其封装到一个dll文件中。最终完成的效果如下图：
调用该进度信息框的代码类似如下所示：
Private Sub cmdCommand1_Click()
Dim pb As New CProgressBar
pb.AddStage "第一步",
pb.AddStage "第二步",
pb.AddStage "第三步",
pb.AddStage "第四步",
Do Until pb.IsCompleted
pb.NextStep
Loop
End Sub
二、设计思路
制作这个Dll，我使用的是VB6，因为考虑到可能在后续的Access项目或者VB6项目中使用，所以没有用VB.net或者Delphi来开发。完成这个项目我建立了1个解决方案，包括2个项目文件，一个是dll项目工程文件，其二是测试工程。
如上图1、2、3包含在dll项目工程中，4在测试工程中，注意要将测试工程设置为启动工程。
1、FProgressBar：进度条窗体模块，主要是界面元素设计，仅提供与界面相关的功能，如刷新显示内容的方法与函数，借鉴MVC概念里的View；
2、CLayoutHelper：窗体布局辅助器，主要为无边框窗体添加外边框、移动控制功能、添加关闭按钮等布局特性；
3、CProgressBar：进度条类模块，该类模块可以被测试工程访问，注意需要将其设置成MultiUse，该模块提供了所有进度条逻辑功能，借鉴MVC概念里的Control的概念；
FProgressBar设计示意
FProgressBar窗体中控件的布局情况如下左图所示，所包含的控件命名清单如下右图所示;
'///////////////////////////////////////////////////////////////////////////////
'模块名称： CProgressBar：进度条显示窗体模块
'相关模块： CLayoutHelper：
'/////////////////////////////////////////////////////////////////////////////// Private m_LayoutHelper As CLayoutHelper
Private Const BAR_MARGIN =
Private mStartTime As Single Private Sub Form_Initialize()
Set m_LayoutHelper = New CLayoutHelper
m_LayoutHelper.StartLayout Me, "", Me.ScaleHeight - , ,
Me.lblStartTime.Caption = Format(Now, "yyyy/m/d h:mm:ss")
Me.lblEndTime.Caption = ""
Me.lblTotalTime.Caption = ""
mStartTime = Timer
End Sub Private Sub Form_Unload(Cancel As Integer)
Set m_LayoutHelper = Nothing
End Sub '设置总进度结束时间信息
Public Sub SetEndTime()
Me.lblEndTime.Caption = Format(Now, "yyyy/m/d h:mm:ss")
End Sub '重画总进度条及其文本内容
Public Sub DrawStage(Caption As String, Position As Double)
DrawBar picStage, Caption, Position
End Sub '重画子进度条及其文本内容
Public Sub DrawStep(Position As Double)
DrawBar picStep, Format(Position, "0%"), Position
Me.lblTotalTime.Caption = GetPassedTime()
End Sub '根据起始时间与结束时间计算累计的时间数，返回“×时×分×秒”格式字符串
Private Function GetPassedTime() As String
Dim mHour As Long, mMinute As Long, mSecond As Long
Dim mPassTime As Single
mPassTime = Timer - mStartTime
mHour = mPassTime \ ( ^ )
mMinute = (mPassTime - mHour * ( ^ )) \
mSecond = mPassTime - mHour * ( ^ ) - mMinute *
GetPassedTime = mHour & "时" & mMinute & "分" & mSecond & "秒"
End Function '画进度条的过程
Private Sub DrawBar(TargetBar As PictureBox, Caption As String, Position As Double)
'画背景进度条
TargetBar.Cls
TargetBar.ForeColor = RGB(, , )
TargetBar.Line (BAR_MARGIN, BAR_MARGIN)-Step((TargetBar.ScaleWidth - BAR_MARGIN * ) * Position, _
TargetBar.ScaleHeight - BAR_MARGIN * ), , BF
'画进度文字信息
TargetBar.ForeColor = RGB(, , )
TargetBar.FontSize =
TargetBar.FontBold = True
TargetBar.CurrentX = (TargetBar.ScaleWidth - TargetBar.TextWidth(Caption)) /
TargetBar.CurrentY = (TargetBar.ScaleHeight - TargetBar.TextHeight(Caption)) /
TargetBar.Print Caption
End Sub
CLayoutHelper代码示意
CLayoutHelper模块为无边框窗体提供鼠标拖动功能、增添外边框、添加关闭按钮、置顶等功能。其中的MoveBar用于拖动窗体，LineBar是MoveBar与内容区域的分割线，FProgressBar的MoveBar与窗体同高，LineBar为0，可以点击FProgressBar所有位置进行拖动。TitleLabel用于在MoveBar左上角显示文本信息。
'///////////////////////////////////////////////////////////////////////////////
'模块名称： CLayoutHelper：控制动态库中包含窗口的布局
'相关模块：
'/////////////////////////////////////////////////////////////////////////////// Private WithEvents m_TargetForm As VB.Form
Private WithEvents m_MoveBar As Label
Private m_TitleLabel As Label
Private m_LineBar As Label
Private m_BackGround As Label
Private WithEvents m_CloseBarBG As Label
Private WithEvents m_CloseBar As Label
Private m_PrePos As Point Private m_MoveBarHeight As Long
Private m_LineBarHeight As Long
Private m_BorderWidth As Long Private m_MoveBarColor As Long
Private m_LineBarColor As Long
Private m_BorderColor As Long Private Sub Class_Initialize()
m_MoveBarColor = RGB(, , )
m_LineBarColor = RGB(, , )
m_BorderColor = RGB(, , )
End Sub Public Property Get MoveBarColor() As Long
MoveBarColor = m_MoveBarColor
End Property Public Property Let MoveBarColor(ByVal vData As Long)
m_MoveBarColor = vData
m_MoveBar.BackColor = vData
m_CloseBarBG.BackColor = vData
End Property Public Property Get LineBarColor() As Long
LineBarColor = m_LineBarColor
End Property Public Property Let LineBarColor(ByVal vData As Long)
m_LineBarColor = vData
m_LineBar.BackColor = vData
End Property Public Property Get BorderColor() As Long
BorderColor = m_BorderColor
End Property Public Property Let BorderColor(ByVal vData As Long)
m_BorderColor = vData
m_TargetForm.BackColor = vData
End Property Public Property Set TargetForm(ByVal vData As VB.Form)
Set m_TargetForm = vData
m_TargetForm.BackColor = RGB(, , )
End Property Public Property Get Title() As String
Title = m_TitleLabel.Caption
End Property Public Property Let Title(ByVal vData As String)
m_TitleLabel.Caption = vData
End Property Public Property Get MoveBarHeight() As Long
MoveBarHeight = m_MoveBarHeight
End Property Public Property Let MoveBarHeight(ByVal vData As Long)
If vData <= Then
m_MoveBarHeight =
Else
m_MoveBarHeight = vData
End If
End Property Public Property Get LineBarHeight() As Long
LineBarHeight = m_LineBarHeight
End Property Public Property Let LineBarHeight(ByVal vData As Long)
If vData < Then
m_LineBarHeight =
Else
m_LineBarHeight = vData
End If
End Property Public Property Get BorderWidth() As Long
BorderWidth = m_BorderWidth
End Property Public Property Let BorderWidth(ByVal vData As Long)
If vData <= Then
m_BorderWidth =
Else
m_BorderWidth = vData
End If
End Property Public Property Get InnerLeft() As Long
InnerLeft = m_BorderWidth
End Property Public Property Get InnerTop() As Long
InnerTop = m_BorderWidth + m_MoveBar.Height + m_LineBar.Height
End Property Public Property Get InnerWidth() As Long
InnerWidth = m_TargetForm.ScaleWidth - * m_BorderWidth
End Property Public Property Get InnerHeight() As Long
InnerHeight = m_TargetForm.ScaleHeight - * m_BorderWidth - m_MoveBar.Height - m_LineBar.Height
End Property Public Sub StartLayout(Optional TargetForm As VB.Form = Nothing, _
Optional TitleText As String = "信息提示", _
Optional MoveBarHeight As Long = , _
Optional LineBarHeight As Long = , _
Optional BorderWidth As Long = , _
Optional TopMost As Boolean = True) If TargetForm Is Nothing And m_TargetForm Is Nothing Then Exit Sub
Set Me.TargetForm = TargetForm
Me.MoveBarHeight = MoveBarHeight
Me.LineBarHeight = LineBarHeight
Me.BorderWidth = BorderWidth Set m_CloseBar = CreateCloseLabel(m_TargetForm, RGB(, , ))
Set m_CloseBarBG = CreateCloseBGLabel(m_TargetForm, m_MoveBarColor)
Set m_TitleLabel = CreateTitleLabel(m_TargetForm, TitleText)
Set m_MoveBar = CreateLabel(m_TargetForm, m_CloseBarBG.BackColor)
Set m_LineBar = CreateLabel(m_TargetForm, m_LineBarColor)
' If LineBarHeight = 0 Then m_LineBar.Visible = False Call ResizeForm
If TopMost Then Call BringToTop
End Sub Private Function CreateTitleLabel(TargetForm As VB.Form, Text As String) As Label
Dim m_label As Label
Static iCount As Long
iCount = iCount +
Set m_label = TargetForm.Controls.Add("VB.Label", "TitleLabel" & iCount)
m_label.BackStyle = '透明
m_label.BorderStyle = 'none
m_label.Appearance = 'flat
m_label.AutoSize = True
m_label.FontBold = True
m_label.FontSize =
m_label.Caption = Text
m_label.Visible = True
Set CreateTitleLabel = m_label
Set m_label = Nothing
End Function Private Function CreateLabel(TargetForm As VB.Form, BackColor As Long) As Label
Dim m_label As Label
Static iCount As Long
iCount = iCount +
Set m_label = TargetForm.Controls.Add("VB.Label", "udfLabel" & iCount)
m_label.BackStyle = 'opaque
m_label.BorderStyle = 'none
m_label.Appearance = 'flat
m_label.AutoSize = False
m_label.BackColor = BackColor
m_label.Visible = True
Set CreateLabel = m_label
Set m_label = Nothing
End Function Private Function CreateCloseBGLabel(TargetForm As VB.Form, BackColor As Long) As Label
Dim m_label As Label
Static iCount As Long
iCount = iCount +
Set m_label = TargetForm.Controls.Add("VB.Label", "udfCloseBGLabel" & iCount)
m_label.BackStyle = 'opaque
m_label.BorderStyle = 'none
m_label.Appearance = 'flat
m_label.AutoSize = False
m_label.BackColor = BackColor
m_label.Width =
m_label.Height = m_label.Width
m_label.Visible = True Set CreateCloseBGLabel = m_label
Set m_label = Nothing
End Function Private Function CreateCloseLabel(TargetForm As VB.Form, ForeColor As Long) As Label
Dim m_label As Label
Static iCount As Long
iCount = iCount +
Set m_label = TargetForm.Controls.Add("VB.Label", "udfCloseLabel" & iCount)
m_label.BackStyle = 'Transparent
m_label.BorderStyle = 'none
m_label.Appearance = 'flat
m_label.AutoSize = True
m_label.ForeColor = ForeColor
m_label.FontBold = True
m_label.FontSize =
m_label.Caption = "×"
m_label.Visible = True
Set CreateCloseLabel = m_label
Set m_label = Nothing
End Function Private Sub m_CloseBar_Click()
Unload m_TargetForm
End Sub Private Sub m_CloseBarBG_Click()
Unload m_TargetForm
End Sub Private Sub m_CloseBar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
m_CloseBar.ForeColor = RGB(, , )
m_CloseBarBG.BackColor = m_BorderColor
End Sub Private Sub m_CloseBarBG_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
m_CloseBar.ForeColor = RGB(, , )
m_CloseBarBG.BackColor = m_BorderColor
End Sub Private Sub ResizeForm()
m_MoveBar.Move Me.BorderWidth, Me.BorderWidth, m_TargetForm.Width - Me.BorderWidth * , m_MoveBarHeight
m_TitleLabel.Move m_MoveBar.Left + , m_MoveBar.Top + (m_MoveBar.Height - m_TitleLabel.Height) /
m_CloseBarBG.Move m_MoveBar.Left + m_MoveBar.Width - m_CloseBarBG.Width - , Me.BorderWidth
m_CloseBar.Move m_CloseBarBG.Left + (m_CloseBarBG.Width - m_CloseBar.Width) / , _
m_CloseBarBG.Top + (m_CloseBarBG.Height - m_CloseBar.Height) / -
m_LineBar.Move Me.BorderWidth, Me.BorderWidth + m_MoveBarHeight, m_TargetForm.Width - Me.BorderWidth * , m_LineBarHeight
End Sub Private Sub m_MoveBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If (Button And vbLeftButton) > Then
m_PrePos.X = X
m_PrePos.Y = Y
End If
End Sub Private Sub m_MoveBar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If m_TargetForm.WindowState = Then Exit Sub
If (Button And vbLeftButton) > Then
m_TargetForm.Move m_TargetForm.Left + X - m_PrePos.X, m_TargetForm.Top + Y - m_PrePos.Y
End If
m_CloseBar.ForeColor = RGB(, , )
m_CloseBarBG.BackColor = m_MoveBar.BackColor
End Sub Private Sub BringToTop()
SetWindowPos m_TargetForm.hwnd, HWND_TOPMOST, , , , , SWP_NOMOVE Or SWP_NOSIZE '窗体置顶
End Sub
CProgressBar代码示意
CProgressBar的代码内容并不多，主要完成整个进度条控件的功能调度，并完成一些逻辑控制操作，代码如下所示：
'///////////////////////////////////////////////////////////////////////////////
'模块名称： CProgressBar：进度条显示窗体模块
'相关模块： CLayoutHelper：
'///////////////////////////////////////////////////////////////////////////////
Private Type StageInfo
Caption As String
StepNumber As Integer
End Type Private mProgressBar As FProgressBar '进度信息窗体对象
Private mStages() As StageInfo '进度阶段信息数组
Private mLength As Integer '数组的长度
Private mCurrentStage As Integer '当前所处的阶段号
Private mCurrentStep As Integer '当前所处的子进度号
Private mIsCompleted As Boolean '是否所有进度完成 Property Get IsCompleted() As Boolean
On Error GoTo Exit_Handler
If mCurrentStage = UBound(mStages) And _
mCurrentStep = mStages(mCurrentStage).StepNumber Then
mIsCompleted = True
mProgressBar.SetEndTime
End If
IsCompleted = mIsCompleted
Exit Property
Exit_Handler:
IsCompleted = False
End Property '添加一条阶段进度初始信息
Public Sub AddStage(Caption As String, StepNumber As Integer)
mLength = mLength +
ReDim Preserve mStages( To mLength)
mStages(mLength).Caption = Caption
mStages(mLength).StepNumber = StepNumber
End Sub Public Sub NextStep()
If mProgressBar.Visible = False Then mProgressBar.Show
If mLength = Or mStages(UBound(mStages)).StepNumber = Then Exit Sub
If Me.IsCompleted Then Exit Sub
If mCurrentStage = Then
mCurrentStage =
mProgressBar.DrawStage mStages(mCurrentStage).Caption, mCurrentStage / mLength
End If
mCurrentStep = mCurrentStep +
If mCurrentStep > mStages(mCurrentStage).StepNumber Then
mCurrentStep =
mCurrentStage = mCurrentStage +
mProgressBar.DrawStage mStages(mCurrentStage).Caption, mCurrentStage / mLength
End If
mProgressBar.DrawStep mCurrentStep / mStages(mCurrentStage).StepNumber
DoEvents
End Sub Private Sub Class_Initialize()
Set mProgressBar = New FProgressBar
End Sub Private Sub Class_Terminate()
Set mProgressBar = Nothing
End Sub