一、起因说明

之前有些项目是用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

使用VB6写一个自定义的进度信息框窗口的更多相关文章

  1. (转载)Android自定义ProgressDialog进度等待框

    Android自定义ProgressDialog进度等待框 作者:无缘公子 字体:[增加 减小] 类型:转载 时间:2016-01-11我要评论 这篇文章主要介绍了Android自定义Progress ...

  2. 如果你想深刻理解ASP.NET Core请求处理管道,可以试着写一个自定义的Server

    我们在上面对ASP.NET Core默认提供的具有跨平台能力的KestrelServer进行了详细介绍(<聊聊ASP.NET Core默认提供的这个跨平台的服务器——KestrelServer& ...

  3. 如何写一个自定义的js文件

    自定义一个Utils.js文件,在其中写js代码即可.如: (function(w){ function Utils(){} Utils.prototype.getChilds = function( ...

  4. Android一个自定义的进度环:ProgressChart

    源代码及可执行文件下载地址:http://files.cnblogs.com/rainboy2010/ProgressChart.zip 因项目需要,自己尝试定义了一个进度环,用于显示进度,实现效果如 ...

  5. 写一个自定义的控件接口 C#

    以下是我的测试代码:APP_Code/ucInterface.cs /* APP_Code/ucInterface.cs */ /// <summary> /// Summary desc ...

  6. 利用伪类写一个自定义checkbox和radio

    首先是效果图来一张 再来一张html结构 关键的CSS来了~ 首先呢要把input标签设置为display: none;  因为自定义的原理是通过label的for属性,来点击label转向为点击in ...

  7. 【Winform-自定义控件】一个自定义的进度条

    0.选择基类 public class MySlider : Control 1.设置控件的Style 在构造函数里添加: public MySlider() { //1.设置控件Style this ...

  8. 使用sys模块写一个软件安装进度条

    import sys,time for i in range(50): sys.stdout.write('#') sys.stdout.flush() #强制刷新将内存中的文件写一条,输出一条. t ...

  9. 写一个自己定义进度颜色和圆形转动的ProgressBar(具体介绍)

    先上图: 我们得自己定义ProgressBar的样式 <span style="white-space:pre"> </span><style nam ...

随机推荐

  1. c++编程思想(三)--c++中c 续,重点sizeof和内存对齐

    之前理论性的太多,下面就是代码及理论结合了 1.sizeof()是一个独立运算符,并不是函数,可以让我们知道任何变量字节数,可以顺带学一下struct,union,内存对齐 内存对齐:为了机器指令快速 ...

  2. web请求

    概述 发起一个http请求的过程就是建立一个socket通信的过程. 我们可以模仿浏览器发起http请求,譬如用httpclient工具包,curl命令等方式. curl "http://w ...

  3. MONO 如何打包 .NET程序独立运行(winform篇)

    .NET程序独立运行是指运行.NET的电脑上,不需要安装.NET框架. .NET程序集“独立运行”并非真正的独立,它是运行在mono运行时基础之上的.由于这个运行时可以独立存在,所以,我们不需要在目标 ...

  4. WebApi实现通讯加密

    一. 场景介绍: 如题如何有效的,最少量的现有代码侵入从而实现客户端与服务器之间的数据交换加密呢? 二. 探究: 1.需求分析 webapi服务端 有如下接口: public class ApiTes ...

  5. Javascript事件绑定及深入

    由于开学后的编程实验课,接触了海量字符换搜索的实验,所以好几天没有学习JS课程了,今天继续学习事件绑定. 传统事件绑定存在一些问题,如:同名事件函数都执行,第二个函数会覆盖第一个. 下面我们以事件切换 ...

  6. storyboard页面跳转传值

    受学姐的影响,习惯纯代码编程,这次要修改别人的代码,很多编程风格还不习惯. 在此之前,页面跳转我都用的是Navigation,故事板上的页面跳转带传值,让我卡了好半天. 页面跳转: [self per ...

  7. Java设计模式之《观察者模式》及应用场景

    原创作品,可以转载,但是请标注出处地址:http://www.cnblogs.com/V1haoge/p/6513651.html 观察者模式,又可以称之为发布-订阅模式,观察者,顾名思义,就是一个监 ...

  8. Linux i2c子系统(三) _解决probe无法执行

    如果你也遇到了填充了id_match_table,compitible怎么看都一样,但probe就是不执行(让我哭一会),你可以回头看一下上一篇的模板,我们这里虽然使用的是设备树匹配,但和platfo ...

  9. Java日志工具之SLF4J

    SLF4J全称为Simple Logging Facade for Java (简单日志门面),作为各种日志框架的简单门面或者抽象,包括 java.util.logging, log4j, logba ...

  10. BOM基础(三)

    在我之前关于DOM的文章里,其实已经有提到过事件的概念.在讲事件之前,首先要知道的就是javascript是由事件驱动的.什么叫事件驱动呢?打个比方,比如我们在页面中点击一个按钮,才会跳出一个窗口或者 ...