当前位置：文档库 › 用VB编了一个小程序来实现电脑抽奖的小功能

用VB编了一个小程序来实现电脑抽奖的小功能

用VB编了一个小程序来实现电脑抽奖的小功能，其原理如下：

主要利用VB中的Rnd函数，来实现随机查找和打乱排序的功能，从而实现随机抽奖的目的。Rnd函数的语法结构是Rnd[(number)]，可选的number参数是 single或任何有效的数值表达式。Rnd函数返回小于1但大于或等于0的值。number 的值决定了 Rnd 生成随机数的方式。为了生成某个范围内的随机整数，可使用以下公式：

Int((upperbound － lowerbound ＋ 1) × Rnd ＋ lowerbound)

这里，upperbound 是随机数范围的上限，而 lowerbound 则是随机数范围的下限。

另外，程序中还使用了INI文件，Windows INI文件,可解释为Windows初始化文件。它是一种专门用来保存应用程序初始化信息和运行环境信息的文本文件。ini文件是一种文本文件,它可以通过Notepad等文本编辑器进行编辑。ini文件具有特定的格式。一个INI 文件是由若干个段(section)组成的,每个段中包含若干关键字(key)及相应的值(value)。创建应用程序自己的INI文件,通过INI文件保存应用程序的一些运行环境信息,然后在程序中读取INI文件中的设置信息并据以处理。一旦程序的运行环境需要变更,则可以通过直接修改INI文件，或在程序中提供专门的界面间接地修改INI文件来保证程序的可用性。

源程序及注释如下：

'窗体源程序

Option Explicit

Dim m_strNameArray() As MyName

Dim m_bIsStart As Boolean

Dim m_nNameIndex As Integer

Dim MAX_INDEX As Integer

Dim m_nSelectNum As Integer

'被选定数

Dim nScrollStep As Integer

Dim nScrollWidth As Integer

Dim bScrollState As Boolean

Dim nEnableSecond As Integer

Dim m_strTitle As String

Dim m_strAppTitle As String

Dim m_strScrollTitleLeft As String

Dim m_strScrollTitleRight As String

Private Sub Command_Start_Stop_Click()

If m_bIsStart = True Then

'按停止钮

m_bIsStart = False

Command_Start_Stop.Caption =

“开始"

Label_FlashName.Visible = True

Timer_FlashName.Enabled = True

Timer_ScrollName.Enabled = False

Label_FlashName =

m_strNameArray（m_nNameIndex).strName ＋“中奖了！"

m_strNameArray(m_nNameIndex).bIsSelect = True

m_nSelectNum = m_nSelectNum ＋ 1

Dim Temp As MyName

Temp =

m_strNameArray(MAX_INDEX)

m_str Name Array(MAX－INDEX) = m_strNameArray(m_nNameIndex) m_strNameArray(m_nNameIndex) =

Temp

MAX_INDEX = MAX_INDEX － 1

If MAX_INDEX = 0 Then

MsgBox “非常感谢您使用本软件"

End If

Else '按开始钮

m_bIsStart = True

Command_Start_Stop.Caption = “停止" Command_Start_Stop.Enabled = False Timer_ScrollName.Enabled = True

Timer_FlashName.Enabled = False

Label_FlashName.Caption = “"

End If

End Sub

Private Sub Form_Load()

Form_Bouns.ScaleMode = 3

m_nNameIndex = 0

m_bIsStart = False

Timer_ScrollName.Enabled = True

Timer_ScrollTitle.Enabled = True Label_FlashName.Visible = False

Label_ScrollName.Caption = “" nEnableSecond = 0

'定义起始秒数

ReDimNameArray

'获得文本中的名字和打乱名字顺序nScrollStep = 5 '设定滚动字的步长nScrollWidth = Label_Congruation.Left

'设定title的移动宽度

bScrollState = False

'设定缺省的开始滚动方向为向左

m_nSelectNum = 0

'初始化被选定数为0

Init

'初始化本程序的界面

End Sub

Private Sub Timer_FlashName_Timer() '闪动中奖者姓名

If Label_FlashName.Visible = True Then

Label_FlashName.Visible = False

Else

Label_FlashName.Visible = True

End If

End Sub

Private Sub Timer_ScrollName_Timer() '滚动出现名字

If m_bIsStart = True Then

If m_nNameIndex >= MAX_INDEX Then

m_nNameIndex = 0

End If

m_nNameIndex =

m_nNameIndex ＋ 1

If m_strNameArray(m_nNameIndex).bIsSelect = True Then If m_nNameIndex <

MAX－INDEX Then

m_nNameIndex =

m_nNameIndex ＋ 1

Else

m_nNameIndex = 0

End If

Label_ScrollName.Caption = m_str

NameArray(m_nNameIndex).strName

'End If

End If

End Sub

Private Sub Timer_ScrollTitle_Timer() '滚动“恭喜发财"字样If bScrollState = False Then '向左滚

nScrollStep = 10

Label_Congruation.Caption = m_strScrollTitleLeft

If nScrollWidth > 0 Then

nScrollWidth =

nScrollWidth － nScrollStep

Else

bScrollState = True

End If

Else '向右滚

nScrollStep = －10

Label_Congruation.Caption =

m_strScrollTitleRight

If nScrollWidth < Form_Bouns.ScaleWidth － Label_Congruation.Width Then nScrollWidth =

nScrollWidth － nScrollStep

Else

bScrollState = False

End If

Label_Congruation.Left = nScrollWidth

'以下为8秒钟内使“停止"按钮有效

If nEnableSecond <= 49 Then

If m_bIsStart = True Then

nEnableSecond =nEnableSecond ＋ 1

End If

Else

If m_bIsStart = True Then

Command_Start_Stop.Enabled = True

nEnableSecond = 0

End If

End Sub

'动态定义数组

Private Sub ReDimNameArray()

Dim strMaxIndex As String

Dim nIndex As Integer

Dim bIsBegin As Boolean

bIsBegin = False

nIndex = 0

Open App.Path ＋“\name.txt" For Input As ＃1 '读文件Do Until EOF(1)

If bIsBegin = False Then

Line Input ＃1, strMaxIndex

nMaxIndex = Val(strMaxIndex)

MAX_INDEX = nMaxIndex － 1

ReDim m_strNameArray(0 To nMaxIndex － 1)

bIsBegin = True

Else

Line Input ＃1, m_strNameArray(nIndex).strName

m_strNameArray(nIndex).bIsSelect = False

nIndex = nIndex ＋ 1

End If

Loop

'以下为打乱人员顺序10次

Dim i As Integer

Dim j As Integer

Dim Temp As String

For j = 0 To 10

For i = 0 To nMaxIndex － 1

nRandomNum = ((nMaxIndex － 1) × Rnd) '利用Rnd函数

Temp = m_strNameArray(i).strName

m_strNameArray(i).strName = m_strNameArray(nRandomNum).strName

m_strNameArray(nRandomNum).strName = Temp

Next i

Next j

End Sub

Private Sub Init() '读取INI文件

Dim X As Long

Dim lpFileName

Dim Temp As String × 50

lpFileName = App.Path ＋“\Sortition.ini"

X = GetPrivateProfileString(“SYSTEM",“AppTitle",“抽奖程序", Temp, Len(Temp), lpFileName)

m_strAppTitle = Trim(Temp)

Temp =“"

X = GetPrivateProfileString(“SYSTEM", "Title", "欢迎使用抽奖程序", Temp, Len(Temp), lpFileName)

m_strTitle = Trim(Temp)

Temp = “"

X = GetPrivateProfileString(“SYSTEM",“ScrollTitleRight", “恭喜发财!!!", Temp, Len(Temp), lpFileName) m_strScrollTitleRight = Trim(Temp)

X = GetPrivateProfileString(“SYSTEM",“ScrollTitleLeft", “龙年大发!!!", Temp, Len(Temp), lpFileName)

m_strScrollTitleLeft = Trim(Temp)

Form_Bouns.Caption = m_strAppTitle

Label_CompanyTitle.Caption = m_strTitle

End Sub

模块源程序：

'用于读取ini文件的API函数

Declare Function GetPrivateProfileString Lib “kernel32" Alias “GetPrivateProfileStringA" (ByVal lpApplicationname As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long

Public Type MyName

strName As String

bIsSelect As Boolean

End Type

由于程序利用的windows ini文件保存一些标题信息，因而可以方便的修改使用环境,及标题内容。

见ini文件内容：

[SYSTEM]

;应用程序的form名称

AppTitle=“风云电脑抽奖Test"

;窗口的内的标题(限9个字)

Title=“大抽奖"

;右滚动的文字(仅能为如下格式:XXXX!!!)

ScrollTitleRight=“恭喜发财!!!"

;左滚动的文字(仅能为如下格式:XXXX!!!)

ScrollTitleLeft=“祝您好运!!!"

如此一个小小的电脑抽奖程序便完成了。

以上程序在VB6.0 Windows98环境下编译通过

对于下雪的景象大家可能都不陌生，我们还是用VB来制作一个下雪的景象吧。其实制作这样一个下雪的景象并不复杂，它的原理是首先在底色为黑色的屏幕上随机画出许多白点（雪花），然后使这些雪花不断地向下移动（重画），反复循环，就成功地模拟了下雪的景象。下面是这个小程序，你可以修改其中的一些数据调整雪花的密度和雪花落下的快慢。

双击窗体写如下代码：

Dim Snow(1000, 2), Amounty As Integer

Private Sub Form_Load()

Form1.Show

DoEvents

Randomize

Amounty = 325

For J = 1 To Amounty

Snow(J, 0) = Int(Rnd ＊ Form1.Width)

Snow(J, 1) = Int(Rnd ＊ Form1.Height)

Snow(J, 2) = 10 ＋ (Rnd ＊ 20)

Next J

Do While Not (DoEvents = 0)

For LS = 1 To 10

For I = 1 To Amounty

OldX = Snow(I, 0): OldY = Snow(I, 1)

Snow(I, 1) = Snow(I, 1) ＋ Snow(I, 2)

If Snow(I, 1) > Form1.Height Then

Snow(I, 1) = 0: Snow(I, 2) = 5 ＋ (Rnd ＊ 30)

Snow(I, 0) = Int(Rnd ＊ Form1.Width)

OldX = 0: OldY = 0

End If

Coloury = 8 ＊ (Snow(I, 2) － 10): Coloury = 60 ＋ Coloury

PSet (OldX, OldY), QBColor(0)

PSet (Snow(I, 0), Snow(I, 1)), RGB(Coloury, Coloury, Coloury)

Next I

Next LS

Loop

End

End Sub

编写窗体的鼠标按下代码：

Private Sub Form_MouseDown(Button As Integer,Shift As Integer, X As Single, Y As Single)

unload me

End Sub

运行上面的小程序，就可以看到漫天的雪花在缓缓落下，地面上还会有积雪！鼠标单击可结束程

在编程中经常会遇到应用程序中要输入大量数据的问题，如果能在该程序中实现象电子表格那样的输入界面，就可以解决这个问题。

----VB虽提供了Grid网格控件，但其只具有显示输出功能，要使其能接受输入数据，必须对它加以改造，在计算机报刊中的许多文章都对此进行了探讨，但所用方法都不能令人满意，笔者经过摸索，找出以下办法，供有兴趣者参考。

----首先在VB5.0环境下Form1中放上各控件：Text1;Grid1;Command1;Command2;Vscroll1;Hscroll1。

----双击Form1打开Code窗口，编制程序代码。

Dim inputcolnum, inputrownum As Integer

Private Sub Command2_Click()

End

End Sub

Private Sub Form_Activate()

Text1.SetFocus ' 文本框获得焦点

End Sub

Private Sub Form_Load()

Grid1.ColWidth(0) = 540

Grid1.RowH eight(0) = 216 '单元格的宽和高

inputcolnum = 13

inputrownum = 15 '表中显示的列、行数

Grid1.Cols = 20

Grid1.Rows = 20 '表中总的列、行数

HScroll1.Height = 300

VScroll1.Width = 300 '水平和垂直滚动条的高、宽度

Grid1.Height = (inputrownum + 1) '

(Grid1.RowHeight(0) + Grid1.GridLineWidth * 12)

+ 12 + HScroll1.Height

'800×600象素时为12；640×480为15

Grid1.Width = (inputcolnum + 1) *

(Grid1.ColWidth(0) + Grid1.GridLineWidth * 12)

+ 12 + VScroll1.Width

'表的高、宽度

HScroll1.Width = Grid1.Width - VScroll1.Width

VScroll1.Height = Grid1.Height - HScroll1.Height

' 水平和垂直滚动条的宽、高度

HScroll1.Left = Grid1.Left

HScroll1.Top = Grid1.Top + Grid1.Height - HScroll1.Height

' 水平滚动条的位置

VScroll1.Left = Grid1.Left + Grid1.Width - VScroll1.Width

VScroll1.Top = Grid1.Top

' 垂直滚动条的位置

HScroll1.Min = 1

HScroll1.Max = Grid1.Cols - inputcolnum

VScroll1.Min = 1

VScroll1.Max = Grid1.Rows - inputrownum

' 水平和垂直滚动条的范围

Text1.Width = Grid1.ColWidth(0)

Text1.Height = Grid1.RowHeight(0)

' 文本框的宽、高度

Text1.Left = Grid1.Left + Grid1.ColWidth(0)

+ Grid1.GridLineWidth * 12

Text1.Top = Grid1.Top + Grid1.RowHeight(0

实时数据采集系统过去在DOS操作系统下一般是采用汇编语言开发制作。随着Windows操作系统的普及应用，数据采集及工业控制等软件的开发也上升到 Windows环境下。可视化软件开发平台的出现，为软件开发提供了强大的图形界面功能，使得开发出来的各种应用软件具有良好的人机交互功能。汇编语言的特点是功能强、运行速度快，但编程复杂、调试难，而高级语言具有良好的可读性及方便的调试手段。

Visual Basic 是Windows环境下简单、易学、高效的可视化编程语言开发系统，以其所见即所得的可视化界面设计风格和32位面向对象的程序设计等特点，已广泛地应用于各个领域，是很多计算机软件开发人员采用的开发工具。VB不但提供了良好的界面设计能力，而且在微机串口通信方面也有很强的功能。采用 VB开发Winodws下的数据采集和工业控制应用软件十分方便，尤其软件界面设计非常便捷，编程工作量较小，开发周期短，特别适合非计算机专业的工程技术人员掌握和使用。

2．MSComm控件特点

MSComm控件是Microsoft提供的扩展控件，用于支持 VB程序对串口的访问，该控制“隐藏”了大部分串口通讯的底层运行过程和许多烦琐的处理过程，同时支持查询方法和事件驱动通讯的机制，事件驱动通讯是交互方式处理串口事务的一种非常有效的方法，特别适合 Windows程序的编写。在串口通讯过程中，当发送数据、收到数据或产生传输错误时，触发MSComm控件的OnComm事件，然后可以

通过判断 CommEvent属性值获得事件类型，再根据事件类型进行相应数据处理。因此用其实现微机串口的数据通讯相当简单，以很少的程序代码就可以轻松实现串口的访问和数据通讯。

3．实时数据采集示例程序

下面给出的应用实例，通过对一台工业八通道实时检测仪表数据通讯协议进行分析，利用VB6.0开发微机通过串口对多通道工业仪表进行实时数据采集的编程技术。给出的程序代码具有通用性，并有详示，可以直接或稍加改动后用于其它数据采集或实时控制程序中。

3．1 仪表及其数据通讯协议

这台工业用八通道实时检测仪表，最多可同时接八路高精度位移传感器，用于测量多点微小形变或微量位移，仪表测量精度为0.01毫米，测量范围最大值为50毫米。该仪表带有一个9针的RS－232C串口，能与微机进行串口数据通讯，实时传送检测数据，通过微机软件处理可实现工业实时监控。

该仪表的串口数据通讯协议是：数据传输速率为9600bps，1位开始位，8位数据位，1位停止位，无奇偶校验位。仪表每秒通过串口发送200个字节数据，由于接入的位移传感器数量在 1－8路可调，所以发送的每帧数据长度不定长，随传感器数量多少而变化。仪表数据传输首先发送每帧数据的开始标志字节，该字节定义为二进制常数0FAH；然后发送1个字节的通道状态字节，该字节按位顺序每位代表相应的一路通道状态，某位是1则代表该通道接有位移传感器，某位是0则代表该通道未接位移传感器；从第三个字节开始按位移传感器接通的通道顺序发送采集数据字节，每道数据有三个字节，前2个数据字节采用压缩的BCD码编码方式，第1个数据字节是高位，第2个数据字节是低位，即一个字节表示两位十进制数，则两个字节表示四位十进制数，小数点采用固定形式，定义在两字节中间；第3个数据字节为符号字节，该字节第八位为1，即1xxxxxxx则为负数，第八位为0，即0xxxxxxx则为正数。

例如发送的字节数据为：0FAH 0B1H 26H 87H 8H 34H 62H 00H 37H 76H 0H 42H 53H 80H

0FAH为帧开始标志字节,第一道,第五道,第六道,第八道接有位移传感器，表示－26.87 34.62 37.76 －42.53。

3．2 部分参数的技术分析

3．2．1 仪表通讯传输速率为9600bps，则最快速度为1.0417ms发送一个字节；仪表每秒发送200个字节，平均5.0ms发送一个字节，在查询方式或连续读取串口数据时要在程序中添加循环等待程序，等待接收缓冲区收到足够的字节才能进行数据处理。

3．2．2 仪表发送每帧数据长度不定长，为了实现实时监测功能，接收数据的读取要尽可能的快速，则在程序开始运行时设置MSComm1的属性

RThreshold = 26 接收缓冲区收到26个字节产生OnComm事件

InputLen = 1 Input每次读取一个字节

等到程序接收到一帧完整数据后，计算出当前帧数据长度，再将Rthreshold属性修改为帧长度，则接收缓冲区在收到一帧数据后，MSComm控件才会触发一个OnComm事件，这样就会有更多的时间进行数据的计算和处理。

3．2．3 仪表每秒发送200个字节数据，微机收到一完整帧数据至少需要t(ms)时间(只接一道传感器t=25ms；接八道传感器t=130ms)，然后再进行数据处理。如果微机在下一帧数据接收前即t ms内能将数据计算处理完毕，则接收缓冲区内只会保存有一帧数据，不会存有两帧以上数据，接收缓冲区的大小不会影响实时监测效果（接收缓冲区>=一完整帧长度），这时完全可以实现实时监测或实时控制；如果微机在t ms内不能将数据计算处理完毕，接收缓冲区设置的又很大，在数据计算处理完毕前，接收缓冲区内就会保存有两帧以上数据，而且一次工作时间越长，缓冲区内滞留数据帧就越多，数据采集和数据处理之间产生逐渐增大的额外时间差，当接收缓冲区充满后，时

间差不再增大，固定在某一值，部分数据因不能及时采集到接收缓冲区中，数据产生丢失现象，真实工作情况就会和微机处理结果产生较大的时间差，对实时监测和实时控制很不利，这种情况下接收缓冲区的大小就会影响实时监测效果，所以接收缓冲区设置不能过大，让部分数据丢失，以保证数据处理的实时性。

3．2．4 设置MSComm控件的接收数据模式采用二进制方式，即 InputMode=comInputModeBinary，但用Input属性读取数据时，不能直接赋值给 Byte 类型变量，只能通过先赋值给一个 Variant 类型变量，返回一个二进制数据的数组，再转换保存到Byte类型数变量中。

3．2．5 VB中有 Byte类型变量，但没有字节的位处理语句。通道状态字节的位处理要通过对该字节的值运算进行判断，符号字节的位处理则要判断符号字节的值是否大于127，大于127则为负数；压缩的BCD码存入Byte类型变量，VB系统只按十进制数处理，这要通过一个简单算法换算，解压BCD码才能还原成十进制表示数值。假如a是Byte类型变量，Ｗ是Single类型变量，将一个压缩的BCD 码存入 a中，则算法是：

Ｗ=(a＼16)*10 + a-(a＼16)*16

则Ｗ=a-(a＼16)*6

3．3 程序代码

在（通用）（声明）中定义程序所用变量：

Dim ab(4) As Byte 注释：字节数据类型数组，用来存贮接收到的一组字节数据

Dim av As Variant 注释：用来从接收缓冲区读取数据

Dim i As Integer

Dim j As Integer

Dim w As Integer 注释：接收数据个数计数器

Dim b1 As Single

Dim b2 As Single

Dim WW As Single 注释：十进制检测值

Dim TD(8) as Boolean 注释：通道状态数组

Dim Wmax(8) As Single 注释：最大值数组

Dim Wmin(8) As Single 注释：最小值数组

在窗体中添加名为Command1的[开始]按钮和名为MSComm1的MSComm控件。

[开始]按钮的Click事件处理程序主要是对MSComm1控制的参数初始化设置，程序中大部分参数在设计时可在MSComm1控制的属性窗口中设置:

Private Sub Command1_Click() 注释：开始按钮

With MSComm1

.CommPort=2 注释：使用COM2

.Setting="9600,N,8,1" 注释：设置通信口参数

.InBufferSize=40 注释：设置MSComm1接收缓冲区为40字节

.OutBufferSize=2 注释：设置MSComm1发送缓冲区为2字节

.InputMode = comInputModeBinary 注释：设置接收数据模式为二进制形式

.InputLen = 1 注释：设置Input 一次从接收缓冲读取字节数为1

.SThreshold = 1 注释：设置Output 一次从发送缓冲读取字节数为1

.InBufferCount = 0 注释：清除接收缓冲区

.OutBufferCount = 0 注释：清除发送缓冲区

For i=1 to 8

Wmax(i) = -99 注释：最大值赋初值

Wmin(i) = 99 注释：最小值赋初值

Next i

w = 0 注释：数据个数计数器清零

.RThreshold = 1 注释：设置接收一个字节产生OnComm事件

On Error Resume Next 注释：改变错误处理的方式。

Err.Clear

If .PortOpen = False Then 注释：判断通信口是否打开

.PortOpen = True 注释：打开通信口

If Err Then 注释：错误处理

MsgBox "串口通信无效"

Exit Sub

End If

End With

End Sub

为了达到实时数据采集目的，实时数据采集处理程序采用MSComm事件驱动方式。MSComm1_OnComm 的事件处理程序只处理comEvReceive事件，首先判断帧数据的开始字节，关闭OnComm接收事件，然后接收数据字节，将压缩BCD进行还原转换，再接收符号字节，判断数据符号，判断数据最大最小值，最后打开OnComm接收事件，等待下一次OnComm事件产生：

Private Sub MSComm1_OnComm()

With MSComm1

Select Case .CommEvent 注释：判断MSComm1通讯事件

Case comEvReceive 注释：收到Rthreshold个字节产生的接收事件

av = .Input 注释：读取一个接收字节

ab(1) = av(0) 注释：转换保存到字节数据类型数组

If ab(1) = 170 Then 注释：判断是否为数据开始标志，0FAH=170

.RThreshold = 0 注释：关闭OnComm事件接收

W=W+1 注释：计数器加1

av = .Input 注释：读取通道状态字节

ab(0) = av(0) 注释：转换保存到字节数据类型数

For i = 1 To 8 注释：通道状态数组复位

TD(i) = False

Next i

cn = 2 注释：帧长度赋初值，一个开始字，一个状态字

If ab(0) >= 128 Then 注释：判断第八通状态

TD(8) = True 注释：第八道是真

ab(0) = ab(0) - 128 注释：第7位置零