|
例1、pset方法。（满天星）
Private Sub Form_Load()
Show
DrawWidth = 2
Randomize
For i = 1 To 1000
x = Form1.ScaleWidth * Rnd
y = Form1.ScaleWidth * Rnd
r = Int(255 * Rnd)
g = Int(255 * Rnd)
b = Int(255 * Rnd)
Form1.PSet (x, y), RGB(r, g, b)
For n = 1 To 50000: Next n
Next i
End Sub
Private Sub display()
Show
DrawWidth = 2
Randomize
For i = 1 To 100000
x = Form1.ScaleWidth * Rnd
y = Form1.ScaleWidth * Rnd
r = Int(255 * Rnd)
g = Int(255 * Rnd)
b = Int(255 * Rnd)
Form1.PSet (x, y), RGB(r, g, b)
For n = 1 To 500: Next n
Next i
End Sub
Private Sub Timer1_Timer() '把定时器的interval设置成500，即0.5秒定时
Cls '清屏
Call display
End Sub
运行是发现电脑变慢，查看进程占用竟然达到50%！
看来浪费系统资源的不一定要是大软件. |
|
例2、画圆。（Circle函数的使用）
Private Sub Command1_Click()
If Command1.Caption = "演示" Then
Command1.Caption = "停止"
Else
Command1.Caption = "演示"
End If
Timer1.Enabled = Not Timer1.Enabled
End Sub
Private Sub draw_circle()
Dim radius
r = Rnd * 255
g = Rnd * 255
b = Rnd * 255
xpos = ScaleWidth / 2
ypos = ScaleHeight / 2
radius = ((xpos) * 0.7 + 1) * Rnd ' 得到一个随机的半径
Circle (xpos, ypos), radius, RGB(r, g, b)
End Sub
Private Sub Command2_Click()
If Command1.Caption = "演示" Then
Cls
End If
End Sub
Private Sub Form_Load()
Timer1.Enabled = Not Timer1.Enabled '关闭定时器
End Sub
Private Sub Timer1_Timer() '将定时器的interval值设定成20
Call draw_circle
End Sub
|
|
例3、shape控件的6种图形的不同的填充方案。
Private Sub Form_activate()
Dim i As Integer
Print
Print " 0 1 2 3 4 5"
Shape1(0).Shape = 0
Shape1(0).FillStyle = 2
For i = 1 To 5
'Load Shape1
Shape1(i).Left = Shape1(i - 1).Left + 750
Shape1(i).Shape = i
Shape1(i).FillStyle = i + 2
Shape1(i).Visible = True
Next i
End Sub
|
|
例4、个性电子钟。（line控件和定时器的使用）
Private Sub Form_Load() '设置窗体的大小和位置
Timer1.Interval = 100
Width = 4000 '设置窗体的大小
Height = 4000 '设置窗体的大小
Left = Screen.Width / 2 - Width / 2 '设置窗体的位置
Top = Screen.Height / 2 - Height / 2 '设置窗体的位置
End Sub
Private Sub form_resize()
Dim i, angle
Static flag As Boolean
If flag = False Then 'flag防止第二次生成控件
flag = True
For i = 0 To 14 '生成控件数组
If i > 0 Then Load Line1(i)
Line1(i).Visible = True
Line1(i).BorderWidth = 5
Line1(i).BorderColor = RGB(128, 0, 0)
'设置每一个控件的颜色
Next i
End If
For i = 0 To 14
Scale (-1, 1)-(1, -1)
angle = i * 2 * Atn(1) / 3 '画出12个时间点的刻度
Line1(i).X1 = 0.9 * Cos(angle) '刻度的长度为0.1
Line1(i).Y1 = 0.9 * Sin(angle)
Line1(i).X2 = Cos(angle)
Line1(i).Y2 = Sin(angle)
Next i
End Sub
Private Sub Timer1_Timer()
'Call form_resize
Const shi = 0
Const fen = 13
Const miao = 14
Dim angle1, angle2, angle3
Static temp
If Second(Now()) = temp Then Exit Sub
temp = Second(Now)
angle1 = 0.5236 * (15-Hour(Now) -Minute(Now)/60) '画时针
Line1(shi).X1 = 0
Line1(shi).Y1 = 0
Line1(shi).X2 = 0.3 * Cos(angle1)
Line1(shi).Y2 = 0.3 * Sin(angle1)
angle2=0.1047 * (75 - Minute(Now)-Second(Now)/60) '画分针
Line1(fen).X1 = 0
Line1(fen).Y1 = 0
Line1(fen).X2 = 0.7 * Cos(angle2)
Line1(fen).Y2 = 0.7 * Sin(angle2)
angle3 = 0.5236 * (75 - Second(Now)) / 5 '画秒针
Line1(miao).X1 = 0
Line1(miao).Y1 = 0
Line1(miao).X2 = 0.8 * Cos(angle3)
Line1(miao).Y2 = 0.8 * Sin(angle3)
Form1.Caption = Str(Now()) '在窗口标题栏显示精确的数字化时间
End Sub
|
例5、print #语句向顺序文件中写入数据。
Private Sub Form_click()
Open "d:\1.txt" For Output As #1
Print #1, "I love you!"; Spc(1); "Visual Basic!"
Print #1, Tab(5); "1"; "1"
Print #1, "1"; "1" '紧凑格式输出字符型数据
Print #1, 1; 2; 3; 4 '紧凑格式输出整形数据
Print #1, "现在是"; Date; Spc(2); Time
Close #1
End Sub
Private Sub Form_Dblclick()
Open "d:\1.txt" For Output As #1
Print #1, "I love you!"; "Visual Basic"
Print #1, "2"; "2"
Print #1, "2"; "2"
Close #1
End Sub
在D盘打开相应文件，效果如下：
例6、write与Input语句的使用。
Private Sub Command1_Click()
Open "d:\存款单.txt" For Append As #1
Order = InputBox("请输入序号（输入0结束）", "存款单")
While Order <> "0"
cnt = Val(InputBox("请输入金额", "存款单"))
ltime = Val(InputBox("请输入存款期限", "存款单"))
bank = (InputBox("请输入银行", "存款单"))
ldate = Date
' tt = Str$(Time)
Write #1, Order, cnt, ltime, bank, ldate
Order = InputBox("请输入序号（输入0结束）", "存款单")
Wend
Close #1
End Sub
Private Sub Command2_Click()
Cls
Print Tab(15); "存款单"
Print
Open "d:\存款单.txt" For Input As #2
Do While Not EOF(2)
Input #2, Order, cnt, ltime, bank, ldate
Print Order; " "; cnt; ; ltime; " "; bank, ldate
Loop
Close #2
End Sub
例7、菜单编辑器的使用。（简单文本编辑器）
Private Sub EditCopy_Click()
Clipboard.Clear '清空剪贴板
Clipboard.SetText Text1.SelText '将文本框中的内容复制到剪贴板中
EditPaste.Enabled = True '使粘贴菜单项变得有效
End Sub
Private Sub EditCut_Click()
Clipboard.Clear
Clipboard.SetText Text1.SelText
Text1.SelText = ""
EditPaste.Enabled = True
End Sub
Private Sub EditPaste_Click()
Text1.SelText = Clipboard.GetText '将剪贴板中的数据贴到文本框中
End Sub
例8、菜单数组。
Private Sub EditArray_Click(Index As Integer)
If Index = 0 Then
Clipboard.Clear
Clipboard.SetText Text1.SelText
Text1.SelText = ""
EditArray(2).Enabled = True
End If
If Index = 1 Then
Clipboard.SetText Text1.SelText
EditArray(2).Enabled = True
End If
If Index = 2 Then
Text1.SelText = Clipboard.GetText
End If
End Sub
例9、计算器程序。
'Option Explicit
Dim num1 '输入的第一个数
Dim num2 '输入的第二个数
Dim strnum1 As String, strnum2 As String '输入的第一个、第二个数的字符形式
Dim firstnum As Boolean '判断是否是数字开头
Dim pointflag As Boolean '判断是否有小数点
Dim runsign As Integer '存储输入的运算符号
Dim calflag As Boolean '判断是否已有运算符号
Private Sub Form_Load()
Dim equal As Single
num1 = 0
num2 = 0
strnum1 = ""
strnum2 = ""
firstnum = True
runsign = 0
calflag = False
End Sub
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0 To 9 '0-9
If firstnum Then
strnum1 = Str(Index)
firstnum = False
Else
strnum1 = strnum1 + Str(Index)
End If
Text1.Text = strnum1
Case 11 '小数点
If Not pointflag Then
If firstnum Then
strnum1 = "0."
firstnum = False
Else
strnum1 = strnum1 + "."
End If
Else
Exit Sub
End If
pointflag = True
Text1.Text = strnum1
Case 10 '+/-
If Sgn(Val(strnum1)) = 1 Then
strnum1 = "-" & strnum1
ElseIf Sgn(Val(strnum1)) = -1 Then
strnum1 = Right(strnum1, Len(strnum1) - 1)
Else
strnum1 = "0."
End If
Text1.Text = strnum1
Case 12 To 15 '加减乘除
firstnum = True '是数字的开头
pointflag = False '已有小数点
If calflag Then '如果已有运算符号
Call run
Else
calflag = True '已经有运算符号
strnum2 = strnum1
strnum1 = ""
End If
runsign = Index - 11
Case 17 '等于号
If Not calflag Then
Text1.Text = strnum1 '如果没有运算符号
equal = Val(strnum2)
firstnum = True
pointflag = False
Else
Call run
calflag = False
End If
Case 16 '清除
num1 = 0
num2 = 0
strnum1 = ""
strnum2 = ""
firstnum = True
pointflag = False
Text1.Text = "0."
End Select
End Sub
'Option Explicit
Public Sub run() '运算
'Dim equal
num1 = Val(strnum2)
num2 = Val(strnum1)
Select Case runsign
Case 1
equal = num1 + num2
Case 2
equal = num1 - num2
Case 3
equal = num1 * num2
Case 4
equal = num1 / num2
End Select
strnum2 = Str(equal)
strnum1 = strnum2
Text1.Text = strnum2
End Sub
Private Sub Label1_Click()
End Sub
例10、串口接收软件。（将接收到的数据显示在文本框）
Option Explicit
Dim inputsignal
Private Sub form_load()
MSComm1.Settings = "9600,n,8,1" '串口的相关参数设置
MSComm1.CommPort = 1 '串口1
MSComm1.InputLen = 0 '表示一次读取所有数据
MSComm1.InBufferSize = 512
MSComm1.InBufferCount = 0
MSComm1.OutBufferSize = 512
MSComm1.OutBufferCount = 0
MSComm1.RThreshold = 1 '每接收一个字符触发一次oncomm事件
MSComm1.SThreshold = 1
MSComm1.PortOpen = True '打开串口
End Sub
Private Sub mscomm1_oncomm()
Select Case MSComm1.CommEvent
Case comEvReceive
inputsignal = MSComm1.Input
Text1.Text = (inputsignal) & (Text1.Text)
Case Else
End Select
End Sub
例11、简易网页浏览器。
首先要添加Microsoft internet controls，使用其中的WebBrowser1控件。
Private Sub Command1_Click()
WebBrowser1.Navigate Text1.Text '用于打开所要浏览的网页
End Sub
Private Sub Command2_Click(Index As Integer)
Select Case Index
Case 0 '后退
On Error GoTo errback
WebBrowser1.GoBack
Exit Sub
errback:
MsgBox "没有课后退的网页！", vbCritical, "信息提示"
Case 1 '前进
On Error GoTo errforward
WebBrowser1.GoForward
Exit Sub
errforward:
MsgBox "没有可以下载的网页！", vbCritical, "信息提示"
Case 2 '停止
WebBrowser1.Stop
Case 3 '刷新
WebBrowser1.Refresh
Case 4 '搜索
On Error GoTo errsearch
WebBrowser1.GoSearch
errsearch:
MsgBox "没有找到相关的网页", vbInformation, "信息提示"
Case 5 '主页
WebBrowser1.GoHome
End Select
End Sub
例12、串口调试助手（待完善）
Option Explicit
Dim inputsignal
Dim text_temp As String
Dim flag_dis As Boolean '是否停止显示标志量
Dim rx_count As Single '接收到的字符数
Dim tx_count As Single '发送除去的字符数
'关闭程序
Private Sub Command6_Click()
MSComm1.PortOpen = False '关闭串口
Unload Me '关闭程序
End Sub
''''''''初始化
Private Sub form_load()
MSComm1.Settings = "9600,n,8,1" '串口的相关参数设置
MSComm1.CommPort = 1 '串口1
MSComm1.InputLen = 0 '表示一次读取所有数据
MSComm1.InBufferSize = 5120
MSComm1.InBufferCount = 0
MSComm1.OutBufferSize = 5120
MSComm1.OutBufferCount = 0
MSComm1.RThreshold = 1 '每接收一个字符触发一次oncomm事件
MSComm1.SThreshold = 1
MSComm1.PortOpen = True '打开串口
Shape1.Shape = 2
Shape1.Visible = True
Shape1.FillStyle = 0 '全部填充
Shape1.FillColor = QBColor(12) '红色
flag_dis = False
Timer2.Enabled = True
Timer2.Interval = 250
rx_count = 0
tx_count = 0
Label14.Caption = rx_count '接收到的字符数
Label15.Caption = tx_count '发送出去的字符数
'串口选择
Combo1.AddItem "COM1"
Combo1.AddItem "COM2"
Combo1.AddItem "COM3"
Combo1.AddItem "COM4"
'波特率
Combo2.AddItem "300"
Combo2.AddItem "600"
Combo2.AddItem "1200"
Combo2.AddItem "2400"
Combo2.AddItem "4800"
Combo2.AddItem "9600"
Combo2.AddItem "19200"
Combo2.AddItem "38400"
Combo2.AddItem "43000"
Combo2.AddItem "115200"
'校验位
Combo3.AddItem "N"
Combo3.AddItem "E"
Combo3.AddItem "O"
'数据位
Combo4.AddItem "8"
Combo4.AddItem "7"
Combo4.AddItem "6"
'停止位
Combo5.AddItem "1"
Combo5.AddItem "2"
End Sub
'自动发送
Private Sub Check1_Click()
If Check1.Value Then
If Text2.Text <> "" Then
Timer1.Interval = Text3.Text
Timer1.Enabled = True
End If
End If
End Sub
'手动发送
Private Sub Command1_Click()
MSComm1.Output = Text2.Text
tx_count = tx_count + Len(Text2.Text)
End Sub
'打开\关闭串口
Private Sub Command2_Click()
If Command2.Caption = "打开串口" Then
Command2.Caption = "关闭串口"
MSComm1.PortOpen = True
Shape1.FillColor = QBColor(12) '红色
Else
Command2.Caption = "打开串口"
MSComm1.PortOpen = False
Shape1.FillColor = QBColor(8) '黑色
End If
End Sub
'清空接收区
Private Sub Command3_Click()
Text1.Text = ""
End Sub
'停止显示
Private Sub Command4_Click()
If flag_dis = False Then
flag_dis = True
Command4.Caption = "继续显示"
Else
flag_dis = False
Command4.Caption = "停止显示"
End If
End Sub
'串口响应事件
Private Sub mscomm1_oncomm()
Select Case MSComm1.CommEvent
Case comEvReceive
inputsignal = MSComm1.Input
rx_count = Len(Trim(inputsignal)) + rx_count
If flag_dis = True Then
text_temp = Text1.Text '将接收区的文本信息锁存
Text1.Text = text_temp
Else
Text1.Text = (Text1.Text) & (inputsignal)
End If
Case Else
End Select
End Sub
Private Sub Timer1_Timer()
If MSComm1.PortOpen = True Then '如果串口处于打开的状态
If Check1.Value Then
If Text2.Text <> "" Then
Timer1.Interval = Text3.Text
Timer1.Enabled = True
MSComm1.Output = Text2.Text
End If
End If
End If
End Sub
Private Sub Timer2_Timer()
Label14.Caption = rx_count
Label15.Caption = tx_count
End Sub
发送界面
接收界面
下载链接：
 |
| 文件: |
串口调试助手.rar |
| 大小: |
6KB |
| 下载: |
下载 | |
例13、winsock控件的使用。（获取本机名和IP）
先添加Microsoft winsock control 6.0（sp5）项
Private Sub Form_Load()
Text1.Text = Winsock1.LocalHostName
Text2.Text = Winsock1.LocalIP
End Sub
例14、计算机端口扫描。（winsock控件）
'text1 本机 IP
'text2 端口范围开头
'text3端口范围结束
'text4线程数
'text5开放端口
'command1扫描
'command2清除
Option Explicit
Dim portnum As Long
Dim start As String
'扫描按钮
Private Sub Command1_Click()
If Text1.Text = "" Or Text2.Text = "" Then
MsgBox "端口号不能为空!"
Exit Sub
End If
Winsock1.Close
start = True
Call scanports
Text5.Text = Text5.Text & vbCrLf & "端口" & Text2.Text & "-" & Text3.Text & "已经扫描成功！"
MsgBox "扫描成功！"
End Sub
'端口扫描模块
Public Sub scanports()
Dim portto As Long
portnum = Text2.Text
portto = Text3.Text
On Error GoTo vigo
Do
portnum = portnum + 1
DoEvents
If start = True Then
Winsock1.Close
DoEvents
Winsock1.LocalPort = portnum
DoEvents
Text4.Text = portnum
Winsock1.Listen
DoEvents
Else
portnum = 0
Exit Sub
End If
Winsock1.Close
DoEvents
Loop Until portnum >= portto
portnum = 0
vigo:
If Err.Number = 10048 Then
Text5.Text = Text5.Text & vbCrLf & "端口" & Winsock1.LocalPort & "开放中！"
Resume Next
End If
End Sub
Private Sub Command2_Click()
Text5.Text = ""
End Sub
'初始化窗体
Private Sub Form_Load()
Text1.Text = Winsock1.LocalIP
Text2.Text = 0
Text3.Text = 600
End Sub
关于本程序中vbcrlf的用法：
vbcrlf的意思常数 值 描述
vbCr Chr(13) 回车符。
vbCrLf Chr(13) & Chr(10) 回车符与换行符。
vbFormFeed Chr(12) 换页符；在 Microsoft Windows 中不适用。
vbLf Chr(10) 换行符。
vbNewLine Chr(13) & Chr(10) 或 Chr(10) 平台指定的新行字符；适用于任何平台。
vbNullChar Chr(0) 值为 0 的字符。
vbNullString 值为 0 的字符串 与零长度字符串 ("") 不同；用于调用外部过程。 vbTab Chr(9) 水平附签。
vbVerticalTab Chr(11) 垂直附签；在 Microsoft Windows 中
例15、获取按键的ASCII码值。
Private Sub Form_keypress(keyascii As Integer)
Me.Caption = Str(keyascii)
End Sub
将在程序窗体的标题栏显示所按按键的ASCII码值。
