VB6编程步骤-全部

VB6编程 步骤

题目要求

1. 新建工程，在工程中新建2个窗体和1个模块，窗体命名为frmMain和frmConfig，添加Excel操作专用模块。

2. 执行菜单命令“工具-选项-编辑器格式”，设置标准文本的字体格式为自己喜欢的格式，执行菜单命令“工具-选项-编辑器”，“要求变量声明”前打勾

3. 设置工程1的属性，修改启动对象为Sub Main，在module1中添加Sub Main过程，并输入代码：frmMain.Show vbModal。在frmMain上添加一个退出按钮，设置其合适的大小和字体，双击该按钮，输入“Unload Me”。

4. 在frmMain窗体上放置“参数设定”按钮，修改合适的外观属性，双击该按钮，输入代码“frmConfig.show vbmodal”

5. 参数设定编程方法：

（1） 在module1模块中，定义保存参数的自定义变量

Public Type mSetData ' 自定义数据类型：设置参数，用于保存到磁盘文件中

TH As Single ' 温度高限

TL As Single ' 温度低限

RHH As Single ' 湿度高限

RHL As Single ' 湿度低限

End Type

Public mAlarm As mSetData ' 用自定义类型mSetData 定义设置参数变量mAlarm

Public sAppPath As String ' 字符串，存放应用程序所在的路径

（2） 在module1模块中创建一个初始化过程Init，代码如下

Sub Init()

sAppPath = "E:\软件技术基础\TR" '应用程序路径

Open sAppPath & "\Para.a" For Random As #1 Len = Len(mAlarm) ' 打开随机方式访问文件

Get #1, 1, mAlarm ' 读取文件内容到变量中

Close #1 '关闭文件

End Sub

在sub Main 中调用Init 过程

Sub main()

Init ' 初始化，读取原设置参数

frmMain.Show vbModal ' 启动主窗体，有模式窗体

End Sub

（3） 设置frmConfig窗体的界面。 如图所示

上述四个文本框的名字，从上到下依次为：txtTempH，txtTempL，txtRHH，txtRHL

双击该窗体空白处，在Form_Load事件中输入代码，如下

Private Sub Form_Load() '调入旧参数并显示在界面上

Me.txtRHH = mAlarm.RHH

Me.txtRHL = mAlarm.RHL

Me.txtTempH = mAlarm.TH

Me.txtTempL = mAlarm.TL

End Sub

双击该窗体上的“确定”按钮，代码如下：

Private Sub cmdOK_Click() '把界面上输入的新参数保存在变量中

mAlarm.TH = Me.txtTempH

mAlarm.TL = Me.txtTempL

mAlarm.RHH = Me.txtRHH

mAlarm.RHL = Me.txtRHL

'变量保存在文件中

Open sAppPath & "\Para.a" For Random As #1 Len = Len(mAlarm)

Put #1, 1, mAlarm

Close #1

Unload Me

End Sub

6. 下位机数据的模拟采集

（1） 定义变量存放下位机的数据

Public Type mData ' 自定义数据类型：下位机数据，用于保存到磁盘文件中

T(1 To 2) As Single ' 温度

RH(1 To 2) As Single ' 湿度

End Type

Public mD(1 To 4) As mData ' 用自定义类型mData定义下位机数据变量

（2） 在frmMain窗体上放置一个定时器控件，命名为：tmrCaiji，其Ennabled 属性设为True，并设Interval属性为1000，双击定时器，完成代码如下所示：

Private Sub tmrCaiji_Timer()' 采集定时器，模拟产生下位机的数据

For i = 1 To 4

mD(i).T(1) = 30 + Rnd * 20: mD(i).T(2) = 50 + Rnd * 20 ' 随机数 Rnd在0~1之间

mD(i).RH(1) = 60 + Rnd * 20: mD(i).RH(2) = 30 + Rnd * 20

Next i

End Sub

7. 下位机数据更新到界面上，并作报警处理

放置一个定时器，命名为：tmrUpdate，其Ennabled 属性设为True，并设Interval属性为1000，双击定时器，完成代码如下所示

Private Sub tmrUpdate_Timer() ' 更新界面定时器

For i = 1 To 4 ' 显示温度，并格式化为显示1位小数

Me.lblTemp1(i) = Format(mD(i).T(1), "#0.0"): Me.lblTemp2(i) = Format(mD(i).T(2), "#0.0") Rnd

Me.lblRH1(i) = Format(mD(i).RH(1), "#0.0"): Me.lblRH2(i) = Format(mD(i).RH(2), "#0.0")

Next i

For i = 1 To 4

If mD(i).T(1) >= mAlarm.TH Then ' 温度高于报警值上限

Me.lblTemp1(i).BackColor = vbRed ' 背景变红

ElseIf mD(i).T(1) < mAlarm.TL Then ' 温度低于报警值下限

Me.lblTemp1(i).BackColor = vbCyan ' 背景变青色

Else ' 温度正常

Me.lblTemp1(i).BackColor = vbGreen ' 背景变绿色

End If

Next i

End Sub

8. 绘制曲线

（1） 放置按钮“开始绘图”，命名为cmdDraw，输入下列代码：

Private Sub cmdDraw_Click()

Me.tmrDraw.Enabled = Not Me.tmrDraw.Enabled ' 每单击一次，切换一次定时器启动/停止命令

If Me.tmrDraw.Enabled = True Then Me.cmdDraw.Caption = "暂停绘图" Else Me.cmdDraw.Caption = "开始绘图"

End Sub

（2） 在frmMain窗体上放置图片框控件picturebox，设置背景为深蓝，命名为picD，在图片框左侧和下侧放置lablel控件，作为坐标刻度指示。，界面如图所示

（3） 在frmMain窗体代码窗口创建一个初始化坐标系的过程，如下所示

Sub InitDraw(Xmin As Single, Xmax As Single, Ymin As Single, Ymax As Single) ' 自变量x，函数值y，min-max：范围

Me.picD.AutoRedraw = True ' 自动重绘

Me.picD.Cls ' 清屏

Me.picD.Scale (Xmin, Ymax)-(Xmax, Ymin) ' 定义坐标系 （左上角x,左上角y）- （右下角x，右下角y）

Me.picD.DrawWidth = 1 ' 画线宽度为1

'画垂直网格

For i = 1 To 6: Me.picD.Line ((Xmax - Xmin) / 6 * i + Xmin, Ymin)-((Xmax - Xmin) / 6 * i + Xmin, Ymax), vbWhite: Next i

'画水平网格

For i = 1 To 10: Me.picD.Line (Xmin, (Ymax - Ymin) / 10 * i + Ymin)-(Xmax, (Ymax - Ymin) / 10 * i + Ymin), vbWhite: Next i

Me.picD.CurrentX = Xmin: Me.picD.CurrentY = Ymin ' 光标回原点

Me.picD.DrawWidth = 2 '画线宽度为2

End Sub

（4） 放置一个定时器，命名为：tmrDraw，其Ennabled 属性设为false，并设Interval属性为100，双击定时器，完成代码如下所示

Private Sub tmrDraw_Timer( ) ' 绘制曲线定时器

Static T As Integer '定义静态变量

T = T + 1 ' 累加

If T = 60 Then ' 到60次

T = 0 '回到0

Call InitDraw(0, 60, 0, 100) 重新初始化坐标系

End If

Me.picD.Line -(T, mD(1).T(1)), vbYellow ' 画线，由上次光标位置画到指定坐标，光标也更新

End Sub

（5） 双击frmMain 窗体，在其Load事件中调用初始化坐标系的过程，如下：

Private Sub Form_Load()

Call InitDraw(0, 60, 0, 100) ' 初始化坐标系

End Sub

9. 数据记录

（1） 在frmMain窗体上放置两个按钮“开始记录”和停止记录，命名为cmdStart和cmdStop，放置一个定时器命名为tmrRecord，其定时间隔设为1000

（2） 在程序所在文件夹建一个Excel文件，另存为97-2003兼容模式，名为“数据模板.xls”如图所示：

（3） 在frmMain代码窗口创建如下过程

Sub OpenExcel()

Dim sFileName As String ' 文件名

sFileName = sAppPath & "\" & Month(Now) & "-" & Day(Now) & "-" & Hour(Time) & "-" & Minute(Time) & "-" & Second(Time) ' “月-日-时-分-秒”作文件名

Call GetExcel ' 获取可用的Excel文件

sXLSName = sFileName & ".xls": sModelName = sAppPath & "\数据模板.xls"

If Dir(sXLSName) <> "" Then Kill sXLSName ' 如果欲保存的Excel文件已存在，则先删除

Set xlApp = GetObject(sModelName) '打开模扳文件

xlApp.Parent.Windows(1).Visible = True '使父窗体可见

Set xlSheet = xlApp.Application.Worksheets(1) '当前工作簿的第一页

End Sub

（4） 为“开始记录”按钮添加代码：

Private Sub cmdStart_Click()

OpenExcel ' 打开Excel文件

xlSheet.Cells(1, 5) = Month(Now) & "月" & Day(Now) & "日采集的数据"

xlSheet.Cells(2, 1) = "序号": xlSheet.Cells(2, 2) = "时间"

For i = 1 To 8: xlSheet.Cells(2, i + 2) = i & "#温度": xlSheet.Cells(2, i + 2 + 8) = i & "#湿度": Next i

Me.tmrRecord.Enabled = True ' 开始记录

Me.cmdStop.Enabled = True: Me.cmdStart.Enabled = False ' 使能“停止记录”按钮，禁止“开始记录”按钮

End Sub

（5） 为“停止记录”按钮添加代码：

Private Sub cmdStop_Click()

Me.tmrRecord.Enabled = False '停止记录数据

xlSheet.SaveAs sXLSName ' Excel 表格另存

xlApp.Application.Quit ' 退出Excel

Me.cmdExit.Enabled = True ' 保存完Excel后才能退出系统

Me.cmdStart.Enabled = True: Me.cmdStop.Enabled = False ' 使能“开始记录”按钮，禁止“停止记录”按钮

End Sub

（6） 为定时器tmrRecord按钮添加代码：

Private Sub tmrRecord_Timer() ' 数据记录定时器，定时保存到Excel表格

Static k As Long

k = k + 1

If (k Mod 5) = 0 Then ' 定时器中断5次（即5秒）执行一次

SaveToExcel ' 数据记录到Excel文件

End If

End Sub

（7） 在frmMain代码窗口创建SaveToExcel过程，如下所示：

Private Sub SaveToExcel()

Static k As Long ' K为行号

k = k + 1

If k > 32767 Then k = 0 ' Excel 最大行不能超过32768

xlSheet.Cells(k + 2, 1) = Time: xlSheet.Cells(k + 2, 2) = k ' 表头

xlSheet.Cells(k + 2, 3) = Format(mD(1).T(1), "#0.0") & "℃": xlSheet.Cells(k + 2, 4) = Format(mD(1).T(2), "#0.0") & "℃"

xlSheet.Cells(k + 2, 5) = Format(mD(2).T(1), "#0.0") & "℃": xlSheet.Cells(k + 2, 6) = Format(mD(2).T(2), "#0.0") & "℃"

xlSheet.Cells(k + 2, 7) = Format(mD(3).T(1), "#0.0") & "℃": xlSheet.Cells(k + 2, 8) = Format(mD(3).T(2), "#0.0") & "℃"

xlSheet.Cells(k + 2, 9) = Format(mD(4).T(1), "#0.0") & "℃": xlSheet.Cells(k + 2, 10) = Format(mD(4).T(2), "#0.0") & "℃"

xlSheet.Cells(k + 2, 11) = Format(mD(1).RH(1), "#0") & "%": xlSheet.Cells(k + 2, 12) = Format(mD(1).RH(2), "#0") & "%"

xlSheet.Cells(k + 2, 13) = Format(mD(2).RH(1), "#0") & "%": xlSheet.Cells(k + 2, 14) = Format(mD(2).RH(2), "#0") & "%"

xlSheet.Cells(k + 2, 15) = Format(mD(3).RH(1), "#0") & "%": xlSheet.Cells(k + 2, 16) = Format(mD(3).RH(2), "#0") & "%"

xlSheet.Cells(k + 2, 17) = Format(mD(4).RH(1), "#0") & "%": xlSheet.Cells(k + 2, 18) = Format(mD(4).RH(2), "#0") & "%"

End Sub

10. 使用ADO访问数据库

（1） 创建数据库(DB)

① 使用“可视化数据管理器”创建一个数据库文件：执行菜单命令“外接程序\可视化数据管理器”，在打开的对话框中执行如下菜单命令，数据库文件命名为“数据”，保存

② 在数据库窗口中，点右键，选“新建表”，表名称为“数据表”，按如下表格添加字段

添加完后，点击“生成表”

③ 双击“数据表”，点“添加”，输入数据，每输入完一条记录就点击“更新” ，如果出现下列错误提示，点“否”

输入4~5行数据即可，关闭“可视化数据管理器”

（2）创建数据库访问程序

① 在frmMain窗体上放置一个按钮，外形：，名称：cmdDB

② 新建一个窗体，按下表设置属性

③ 在frmDB窗体下方放置两个按钮 外形: ，分别命名为cmdQuery和cmdQuit 。

④ 在frmDB窗体上，执行菜单命令“工程/部件”,按下图选择ADO控件（ActiveX Data Objects）和DataGrid控件。

点击“确定”，可以看到左侧的工具箱多了两个工具图标：

⑤ 在frmDB窗体上放置一个DataGrid控件，设置其宽度（Width）为14000，高度（Height）为7000，其背景色（BackColor）为黄色。右键单击该控件，选“属性”，打开其属性窗口，设置下列其字体属性

⑥ 切换到frmDB的代码窗口，定义访问数据库必须的变量：

Dim cnn As New Connection, Rst As New ADODB.Recordset

⑦ 生成数据库连接字符串：

在frmDB窗体上放置一个ADO控件,右键单击它，如下图选ADODC属性

打开ADO控件的属性页：

点“生成”，得到下图，如图中所示选第二项

点“下一步”，得到下图

点击图中位置，找到数据库文件“数据.mdb”，如下图

点“测试连接”，显示，点确定，复制属性页第一页中“使用连接字符串”下面文本框中的内容。

⑧ 删除frmDB窗体上的ADO控件，双击“查询”按钮，输入如下代码

Private Sub cmdQuery_Click()

'连接数据库并实现所要求的查询

cnn.CursorLocation = adUseClient

cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=E:\软件技术基础\TR\数据.mdb" '此处粘贴刚刚生成的连接字符串

'Rst.Open "select 序号,时间,温度1,湿度1,from 数据 where 温度1>30 ", cnn, adOpenStatic, adLockBatchOptimistic, adCmdText

Rst.Open "select * from 数据表", cnn, adOpenStatic, adLockBatchOptimistic, adCmdText

Debug.Print Rst.RecordCount

'若无满足要求的记录,则提前退出

If Rst.RecordCount < 1 Then '若无符合条件的记录,则

Set Me.DataGrid1.DataSource = Rst '更新查询结果显

Exit Sub

End If

Rst.Sort = "时间" '排序

Set Me.DataGrid1.DataSource = Rst '显示于表格中

For i = 0 To 9: Me.DataGrid1.Columns(i).Width = Me.DataGrid1.Width / 10: Next i

Me.DataGrid1.Caption = "查询到的数据"

End Sub

（3） 完成数据访问窗体，双击“返回按钮”，输入下面代码：

Private Sub cmdQuit_Click()

Rst.Close '关闭视图

cnn.Close ' 断开数据库连接

Unload Me ' 关闭窗体

End Sub

11. 给采集到的数据添加滤波功能

（1） 添加模块module2，在其代码窗口中输入下面函数：

' 中位平均法滤波函数，数组x中去掉TrimN个最大的和最小的，剩余数据取平均值

Public Function MidLvBo(x() As Single, TrimN As Integer) As Single

Dim L, U: L = LBound(x): U = UBound(x) ' 取数据源数组下标的下限和上限

Dim b() As Single: ReDim b(L To U) ' 定义用于排序的数组

For i = L To U: b(i) = x(i): Next i ' 数组另存

' 以下为冒泡法排序

For i = L To U - 1

For j = i + 1 To U

If (b(i) > b(j)) Then

Dim t As Single

t = b(i): b(i) = b(j): b(j) = t ' 交换

End If

Next j

Next i

Dim sum As Single, n As Integer: sum = 0 ' sum为求和数，n为最终留下的数据个数

For i = L + TrimN To U - TrimN: sum = sum + b(i): Next i ' 中间数求和

n = U - L - 2 * TrimN + 1 ' 留下的数据个数

If n <= 0 Then MidLvBo = 0 Else MidLvBo = sum / n ' 异常处理

End Function

（2）在frmMain窗体空白处放置按钮，，命名为cmdLvBo，双击它，添加下面的代码：

Private Sub cmdLvBo_Click()

Dim x(1 To 6) As Single, TrimN As Integer, y As Single

For i = 1 To 6

x(i) = CSng(InputBox("请输入6个数据，当前是第" & i & "个"))

Next i

TrimN = CInt(InputBox("请输入滤波两头去掉的数据个数"))

y = MidLvBo(x, TrimN): Debug.Print y

MsgBox "输入的数据分别是：" & x(1) & "," & x(2) & "," & x(3) & "," & x(4) & "," & x(5) & "," & x(6) & vbCrLf & _

"去掉" & TrimN & "个较大值和较小值,滤波结果是: " & y, vbOKOnly

End Sub

12. 给程序添加登录对话框

(1) 添加窗体，命名为frmLogin，设计其界面如下：

界面控件主要属性设置：

(2) 双击“隐藏输入按钮”，添加如下代码：

Private Sub cmdShowPassCode_Click()

Static b As Boolean ' 静态变量，切换单击状态是第一次还是第二次

b = Not b

If b Then

Me.cmdShowPassCode.Caption = "显示输入"

Me.txtPassCode.PasswordChar = ""

Else

Me.cmdShowPassCode.Caption = "显示输入"

Me.txtPassCode.PasswordChar = "#"

End If

End Sub

(3) 双击“登录”按钮，添加如下代码：

Private Sub cdmLogin_Click()

If Trim(Me.txtPassCode) = "123456" Then ' 授权密码，可更改

If MsgBox("欢迎使用本软件!", vbOKOnly) = vbOK Then ' 如果密码正确

Unload Me ' 卸载登录窗体，执行本软件后续程序

End If

Else ' 否则

If MsgBox("对不起，你无权使用本软件!", vbOKOnly) = vbOK Then '提示用户无权使用

End ' 退出本软件

End If

End If

End Sub

（4） 双击“放弃”按钮，添加如下代码

Private Sub cmdGiveUp_Click()

End ' 退出本软件

End Sub

(5) 在module1模块的sub main过程，frmmain.show语句前加入下面语句：

frmLogin.Show vbModal

【完】

本文来源：https://www.2haoxitong.net/k/doc/11ce6c10effdc8d376eeaeaad1f34693dbef1041.html