一、起因说明
之前有些项目是用Access完成的，当时为了给用户显示一些进度信息，自制了一个进度信息窗体，类似下图所示：
随着项目不断变迁，需要将进度信息按阶段及子进度进行显示，并且出于代码封装的需求，需要将其封装到一个dll文件中。最终完成的效果如下图：
调用该进度信息框的代码类似如下所示：
1 Private Sub cmdCommand1_Click() 2 Dim pb As New CProgressBar 3 pb.AddStage "第一步", 10000 4 pb.AddStage "第二步", 10000 5 pb.AddStage "第三步", 10000 6 pb.AddStage "第四步", 10000 7 Do Until pb.IsCompleted 8 pb.NextStep 9 Loop 10 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窗体中控件的布局情况如下左图所示，所包含的控件命名清单如下右图所示;
1 '/////////////////////////////////////////////////////////////////////////////// 2 '模块名称： CProgressBar：进度条显示窗体模块 3 '相关模块： CLayoutHelper： 4 '/////////////////////////////////////////////////////////////////////////////// 5 6 Private m_LayoutHelper As CLayoutHelper 7 Private Const BAR_MARGIN = 30 8 Private mStartTime As Single 9 10 Private Sub Form_Initialize() 11 Set m_LayoutHelper = New CLayoutHelper 12 m_LayoutHelper.StartLayout Me, "", Me.ScaleHeight - 70, 0, 30 13 Me.lblStartTime.Caption = Format(Now, "yyyy/m/d h:mm:ss") 14 Me.lblEndTime.Caption = "" 15 Me.lblTotalTime.Caption = "" 16 mStartTime = Timer 17 End Sub 18 19 Private Sub Form_Unload(Cancel As Integer) 20 Set m_LayoutHelper = Nothing 21 End Sub 22 23 '设置总进度结束时间信息 24 Public Sub SetEndTime() 25 Me.lblEndTime.Caption = Format(Now, "yyyy/m/d h:mm:ss") 26 End Sub 27 28 '重画总进度条及其文本内容 29 Public Sub DrawStage(Caption As String, Position As Double) 30 DrawBar picStage, Caption, Position 31 End Sub 32 33 '重画子进度条及其文本内容 34 Public Sub DrawStep(Position As Double) 35 DrawBar picStep, Format(Position, "0%"), Position 36 Me.lblTotalTime.Caption = GetPassedTime() 37 End Sub 38 39 '根据起始时间与结束时间计算累计的时间数，返回“×时×分×秒”格式字符串 40 Private Function GetPassedTime() As String 41 Dim mHour As Long, mMinute As Long, mSecond As Long 42 Dim mPassTime As Single 43 mPassTime = Timer - mStartTime 44 mHour = mPassTime (60 ^ 2) 45 mMinute = (mPassTime - mHour * (60 ^ 2)) 60 46 mSecond = mPassTime - mHour * (60 ^ 2) - mMinute * 60 47 GetPassedTime = mHour & "时" & mMinute & "分" & mSecond & "秒" 48 End Function 49 50 '画进度条的过程 51 Private Sub DrawBar(TargetBar As PictureBox, Caption As String, Position As Double) 52 '画背景进度条 53 TargetBar.Cls 54 TargetBar.ForeColor = RGB(0, 255, 0) 55 TargetBar.Line (BAR_MARGIN, BAR_MARGIN)-Step((TargetBar.ScaleWidth - BAR_MARGIN * 2) * Position, _ 56 TargetBar.ScaleHeight - BAR_MARGIN * 2), , BF 57 '画进度文字信息 58 TargetBar.ForeColor = RGB(255, 0, 0) 59 TargetBar.FontSize = 10 60 TargetBar.FontBold = True 61 TargetBar.CurrentX = (TargetBar.ScaleWidth - TargetBar.TextWidth(Caption)) / 2 62 TargetBar.CurrentY = (TargetBar.ScaleHeight - TargetBar.TextHeight(Caption)) / 2 63 TargetBar.Print Caption 64 End Sub
CLayoutHelper代码示意
CLayoutHelper模块为无边框窗体提供鼠标拖动功能、增添外边框、添加关闭按钮、置顶等功能。其中的MoveBar用于拖动窗体，LineBar是MoveBar与内容区域的分割线，FProgressBar的MoveBar与窗体同高，LineBar为0，可以点击FProgressBar所有位置进行拖动。TitleLabel用于在MoveBar左上角显示文本信息。
1 '/////////////////////////////////////////////////////////////////////////////// 2 '模块名称： CLayoutHelper：控制动态库中包含窗口的布局 3 '相关模块： 4 '/////////////////////////////////////////////////////////////////////////////// 5 6 Private WithEvents m_TargetForm As VB.Form 7 Private WithEvents m_MoveBar As Label 8 Private m_TitleLabel As Label 9 Private m_LineBar As Label 10 Private m_BackGround As Label 11 Private WithEvents m_CloseBarBG As Label 12 Private WithEvents m_CloseBar As Label 13 Private m_PrePos As Point 14 15 Private m_MoveBarHeight As Long 16 Private m_LineBarHeight As Long 17 Private m_BorderWidth As Long 18 19 Private m_MoveBarColor As Long 20 Private m_LineBarColor As Long 21 Private m_BorderColor As Long 22 23 Private Sub Class_Initialize() 24 m_MoveBarColor = RGB(190, 205, 219) 25 m_LineBarColor = RGB(140, 140, 140) 26 m_BorderColor = RGB(0, 0, 0) 27 End Sub 28 29 Public Property Get MoveBarColor() As Long 30 MoveBarColor = m_MoveBarColor 31 End Property 32 33 Public Property Let MoveBarColor(ByVal vData As Long) 34 m_MoveBarColor = vData 35 m_MoveBar.BackColor = vData 36 m_CloseBarBG.BackColor = vData 37 End Property 38 39 Public Property Get LineBarColor() As Long 40 LineBarColor = m_LineBarColor 41 End Property 42 43 Public Property Let LineBarColor(ByVal vData As Long) 44 m_LineBarColor = vData 45 m_LineBar.BackColor = vData 46 End Property 47 48 Public Property Get BorderColor() As Long 49 BorderColor = m_BorderColor 50 End Property 51 52 Public Property Let BorderColor(ByVal vData As Long) 53 m_BorderColor = vData 54 m_TargetForm.BackColor = vData 55 End Property 56 57 Public Property Set TargetForm(ByVal vData As VB.Form) 58 Set m_TargetForm = vData 59 m_TargetForm.BackColor = RGB(0, 0, 0) 60 End Property 61 62 Public Property Get Title() As String 63 Title = m_TitleLabel.Caption 64 End Property 65 66 Public Property Let Title(ByVal vData As String) 67 m_TitleLabel.Caption = vData 68 End Property 69 70 Public Property Get MoveBarHeight() As Long 71 MoveBarHeight = m_MoveBarHeight 72 End Property 73 74 Public Property Let MoveBarHeight(ByVal vData As Long) 75 If vData <= 0 Then 76 m_MoveBarHeight = 700 77 Else 78 m_MoveBarHeight = vData 79 End If 80 End Property 81 82 Public Property Get LineBarHeight() As Long 83 LineBarHeight = m_LineBarHeight 84 End Property 85 86 Public Property Let LineBarHeight(ByVal vData As Long) 87 If vData < 0 Then 88 m_LineBarHeight = 0 89 Else 90 m_LineBarHeight = vData 91 End If 92 End Property 93 94 Public Property Get BorderWidth() As Long 95 BorderWidth = m_BorderWidth 96 End Property 97 98 Public Property Let BorderWidth(ByVal vData As Long) 99 If vData <= 0 Then 100 m_BorderWidth = 30 101 Else 102 m_BorderWidth = vData 103 End If 104 End Property 105 106 Public Property Get InnerLeft() As Long 107 InnerLeft = m_BorderWidth 108 End Property 109 110 Public Property Get InnerTop() As Long 111 InnerTop = m_BorderWidth + m_MoveBar.Height + m_LineBar.Height 112 End Property 113 114 Public Property Get InnerWidth() As Long 115 InnerWidth = m_TargetForm.ScaleWidth - 2 * m_BorderWidth 116 End Property 117 118 Public Property Get InnerHeight() As Long 119 InnerHeight = m_TargetForm.ScaleHeight - 2 * m_BorderWidth - m_MoveBar.Height - m_LineBar.Height 120 End Property 121 122 Public Sub StartLayout(Optional TargetForm As VB.Form = Nothing, _ 123 Optional TitleText As String = "信息提示", _ 124 Optional MoveBarHeight As Long = 700, _ 125 Optional LineBarHeight As Long = 30, _ 126 Optional BorderWidth As Long = 30, _ 127 Optional TopMost As Boolean = True) 128 129 If TargetForm Is Nothing And m_TargetForm Is Nothing Then Exit Sub 130 Set Me.TargetForm = TargetForm 131 Me.MoveBarHeight = MoveBarHeight 132 Me.LineBarHeight = LineBarHeight 133 Me.BorderWidth = BorderWidth 134 135 Set m_CloseBar = CreateCloseLabel(m_TargetForm, RGB(0, 0, 0)) 136 Set m_CloseBarBG = CreateCloseBGLabel(m_TargetForm, m_MoveBarColor) 137 Set m_TitleLabel = CreateTitleLabel(m_TargetForm, TitleText) 138 Set m_MoveBar = CreateLabel(m_TargetForm, m_CloseBarBG.BackColor) 139 Set m_LineBar = CreateLabel(m_TargetForm, m_LineBarColor) 140 ' If LineBarHeight = 0 Then m_LineBar.Visible = False 141 142 Call ResizeForm 143 If TopMost Then Call BringToTop 144 End Sub 145 146 Private Function CreateTitleLabel(TargetForm As VB.Form, Text As String) As Label 147 Dim m_label As Label 148 Static iCount As Long 149 iCount = iCount + 1 150 Set m_label = TargetForm.Controls.Add("VB.Label", "TitleLabel" & iCount) 151 m_label.BackStyle = 0 '透明 152 m_label.BorderStyle = 0 'none 153 m_label.Appearance = 0 'flat 154 m_label.AutoSize = True 155 m_label.FontBold = True 156 m_label.FontSize = 12 157 m_label.Caption = Text 158 m_label.Visible = True 159 Set CreateTitleLabel = m_label 160 Set m_label = Nothing 161 End Function 162 163 Private Function CreateLabel(TargetForm As VB.Form, BackColor As Long) As Label 164 Dim m_label As Label 165 Static iCount As Long 166 iCount = iCount + 1 167 Set m_label = TargetForm.Controls.Add("VB.Label", "udfLabel" & iCount) 168 m_label.BackStyle = 1 'opaque 169 m_label.BorderStyle = 0 'none 170 m_label.Appearance = 0 'flat 171 m_label.AutoSize = False 172 m_label.BackColor = BackColor 173 m_label.Visible = True 174 Set CreateLabel = m_label 175 Set m_label = Nothing 176 End Function 177 178 Private Function CreateCloseBGLabel(TargetForm As VB.Form, BackColor As Long) As Label 179 Dim m_label As Label 180 Static iCount As Long 181 iCount = iCount + 1 182 Set m_label = TargetForm.Controls.Add("VB.Label", "udfCloseBGLabel" & iCount) 183 m_label.BackStyle = 1 'opaque 184 m_label.BorderStyle = 0 'none 185 m_label.Appearance = 0 'flat 186 m_label.AutoSize = False 187 m_label.BackColor = BackColor 188 m_label.Width = 400 189 m_label.Height = m_label.Width 190 m_label.Visible = True 191 192 Set CreateCloseBGLabel = m_label 193 Set m_label = Nothing 194 End Function 195 196 Private Function CreateCloseLabel(TargetForm As VB.Form, ForeColor As Long) As Label 197 Dim m_label As Label 198 Static iCount As Long 199 iCount = iCount + 1 200 Set m_label = TargetForm.Controls.Add("VB.Label", "udfCloseLabel" & iCount) 201 m_label.BackStyle = 0 'Transparent 202 m_label.BorderStyle = 0 'none 203 m_label.Appearance = 0 'flat 204 m_label.AutoSize = True 205 m_label.ForeColor = ForeColor 206 m_label.FontBold = True 207 m_label.FontSize = 12 208 m_label.Caption = "×" 209 m_label.Visible = True 210 Set CreateCloseLabel = m_label 211 Set m_label = Nothing 212 End Function 213 214 Private Sub m_CloseBar_Click() 215 Unload m_TargetForm 216 End Sub 217 218 Private Sub m_CloseBarBG_Click() 219 Unload m_TargetForm 220 End Sub 221 222 Private Sub m_CloseBar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 223 m_CloseBar.ForeColor = RGB(255, 255, 255) 224 m_CloseBarBG.BackColor = m_BorderColor 225 End Sub 226 227 Private Sub m_CloseBarBG_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 228 m_CloseBar.ForeColor = RGB(255, 255, 255) 229 m_CloseBarBG.BackColor = m_BorderColor 230 End Sub 231 232 Private Sub ResizeForm() 233 m_MoveBar.Move Me.BorderWidth, Me.BorderWidth, m_TargetForm.Width - Me.BorderWidth * 2, m_MoveBarHeight 234 m_TitleLabel.Move m_MoveBar.Left + 200, m_MoveBar.Top + (m_MoveBar.Height - m_TitleLabel.Height) / 2 235 m_CloseBarBG.Move m_MoveBar.Left + m_MoveBar.Width - m_CloseBarBG.Width - 10, Me.BorderWidth 236 m_CloseBar.Move m_CloseBarBG.Left + (m_CloseBarBG.Width - m_CloseBar.Width) / 2, _ 237 m_CloseBarBG.Top + (m_CloseBarBG.Height - m_CloseBar.Height) / 2 - 40 238 m_LineBar.Move Me.BorderWidth, Me.BorderWidth + m_MoveBarHeight, m_TargetForm.Width - Me.BorderWidth * 2, m_LineBarHeight 239 End Sub 240 241 Private Sub m_MoveBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 242 If (Button And vbLeftButton) > 0 Then 243 m_PrePos.X = X 244 m_PrePos.Y = Y 245 End If 246 End Sub 247 248 Private Sub m_MoveBar_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 249 If m_TargetForm.WindowState = 2 Then Exit Sub 250 If (Button And vbLeftButton) > 0 Then 251 m_TargetForm.Move m_TargetForm.Left + X - m_PrePos.X, m_TargetForm.Top + Y - m_PrePos.Y 252 End If 253 m_CloseBar.ForeColor = RGB(0, 0, 0) 254 m_CloseBarBG.BackColor = m_MoveBar.BackColor 255 End Sub 256 257 Private Sub BringToTop() 258 SetWindowPos m_TargetForm.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE '窗体置顶 259 End Sub
CProgressBar代码示意
CProgressBar的代码内容并不多，主要完成整个进度条控件的功能调度，并完成一些逻辑控制操作，代码如下所示：
1 '/////////////////////////////////////////////////////////////////////////////// 2 '模块名称： CProgressBar：进度条显示窗体模块 3 '相关模块： CLayoutHelper： 4 '/////////////////////////////////////////////////////////////////////////////// 5 Private Type StageInfo 6 Caption As String 7 StepNumber As Integer 8 End Type 9 10 Private mProgressBar As FProgressBar '进度信息窗体对象 11 Private mStages() As StageInfo '进度阶段信息数组 12 Private mLength As Integer '数组的长度 13 Private mCurrentStage As Integer '当前所处的阶段号 14 Private mCurrentStep As Integer '当前所处的子进度号 15 Private mIsCompleted As Boolean '是否所有进度完成 16 17 Property Get IsCompleted() As Boolean 18 On Error GoTo Exit_Handler 19 If mCurrentStage = UBound(mStages) And _ 20 mCurrentStep = mStages(mCurrentStage).StepNumber Then 21 mIsCompleted = True 22 mProgressBar.SetEndTime 23 End If 24 IsCompleted = mIsCompleted 25 Exit Property 26 Exit_Handler: 27 IsCompleted = False 28 End Property 29 30 '添加一条阶段进度初始信息 31 Public Sub AddStage(Caption As String, StepNumber As Integer) 32 mLength = mLength + 1 33 ReDim Preserve mStages(1 To mLength) 34 mStages(mLength).Caption = Caption 35 mStages(mLength).StepNumber = StepNumber 36 End Sub 37 38 Public Sub NextStep() 39 If mProgressBar.Visible = False Then mProgressBar.Show 40 If mLength = 0 Or mStages(UBound(mStages)).StepNumber = 0 Then Exit Sub 41 If Me.IsCompleted Then Exit Sub 42 If mCurrentStage = 0 Then 43 mCurrentStage = 1 44 mProgressBar.DrawStage mStages(mCurrentStage).Caption, mCurrentStage / mLength 45 End If 46 mCurrentStep = mCurrentStep + 1 47 If mCurrentStep > mStages(mCurrentStage).StepNumber Then 48 mCurrentStep = 1 49 mCurrentStage = mCurrentStage + 1 50 mProgressBar.DrawStage mStages(mCurrentStage).Caption, mCurrentStage / mLength 51 End If 52 mProgressBar.DrawStep mCurrentStep / mStages(mCurrentStage).StepNumber 53 DoEvents 54 End Sub 55 56 Private Sub Class_Initialize() 57 Set mProgressBar = New FProgressBar 58 End Sub 59 60 Private Sub Class_Terminate() 61 Set mProgressBar = Nothing 62 End Sub