一、起因說明
之前有些項目是用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