甘肃农业大学信息科学技术学院：Visual?Basic?程序设计（二）：Example-7

【例7-1】 设计一个能进行加、减运算和清空文本框信息的菜单。
Private Sub mnuAddItem_Click()
Text3.Text = Val（Text1） + Val（Text2）
End Sub
Private Sub mnuSubItem_Click()
Text3.Text = Val（Text1） - Val（Text2）
End Sub
Private Sub mnuQuitItem_Click()
End
End Sub
Private Sub mnuClsItem_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
【例7-2】 通过弹出式菜单实现字体、字号的变化。
Private Sub mnuFontSong_Click()
Text1.FontName = "宋体"
End Sub
Private Sub mnuFontFang_Click()
Text1.FontName = "仿宋_GB2312"
End Sub
Private Sub mnuFontHei_Click()
Text1.FontName = "黑体"
End Sub
Private Sub mnuFontKai_Click()
Text1.FontName = "楷体_GB2312"
End Sub
Private Sub Text1_MouseDown（Button As Integer,Shift As Integer,X As Single,
Y As Single）
If Button = 2 Then
PopupMenu mnuFont
End If
End Sub
Private Sub mnuSize12_Click()
Text1.FontSize = "12"
End Sub
Private Sub mnuSize16_Click()
Text1.FontSize = "16"
End Sub
Private Sub mnuSize20_Click()
Text1.FontSize = "20"
End Sub
Private Sub mnuSize24_Click()
Text1.FontSize = "24"
End Sub
Private Sub Form_MouseDown（Button As Integer,Shift As Integer,X As Single,
Y As Single）
If Button = 2 Then PopupMenu mnuSize
End Sub
【例7-3】 编写程序，建立“打开”和“另存为”对话框
Private Sub Command1_Click()
CommonDialog1.FileName=""
CommonDialog1.Flags = 4
CommonDialog1.Filter ="All Files|*.*|（*.txt）|*.txt |（*.exe） |*.exe"
CommonDialog1.FilterIndex = 1
CommonDialog1.DialogTitle = "打开"
CommonDialog1.Action = 1
'如果没有选择任何文件则FileName返回值为空
If CommonDialog1.FileName = "" Then
MsgBox "您没有选择任何文件"
Else
Cls '清除当前窗体显示内容
Form1.Print CommonDialog1.FileName
End If
End Sub
【例7-4】 为一按钮的Click事件编写程序，显示颜色对话框，并把窗体的背景色设置为选择的颜色。
Private Sub Command1_Click()
CommonDialog1.ShowColor
Form1.BackColor = CommonDialog1.Color
End Sub
【例7-5】 用字体对话框设置文本框中显示的字体。
Private Sub Command1_Click()
CommonDialog1.Flags = 3
CommonDialog1.ShowFont
Text1.FontName = CommonDialog1.FontName
Text1.FontSize = CommonDialog1.FontSize
Text1.FontBold = CommonDialog1.FontBold
Text1.FontItalic = CommonDialog1.FontItalic
Text1.FontUnderline = CommonDialog1.FontUnderline
Text1.FontStrikethru = CommonDialog1.FontStrikethru
End Sub
【例7-6】 建立打印对话框。
Private Sub Command1_Click()
firstp = 1
lastp = 100
CommonDialog1.Flags = 8
CommonDialog1.ShowPrinter
CommonDialog1.Min = firstp
CommonDialog1.Max = lastp
End Sub
【例7-7】 利用工具栏来实现字体变化。
Private Sub Form_Resize()
With Text1
,Top = Toolbar1.Height
,Left = 0
,Height = Form1.ScaleHeight - Toolbar1.Height
,Width = Form1.ScaleWidth
End With
End Sub
Private Sub Toolbar1_ButtonClick（ByVal Button As MSComctlLib.Button）
n = Button.Index
Select Case n
Case 1
Text1.FontBold = Not Text1.FontBold
Case 2
Text1.FontItalic = Not Text1.FontItalic
Case 3
Text1.FontUnderline = Not Text1.FontUnderline
End Select
End Sub
【例7-8】 创建一个安装软件进度器。
Private Sub Command1_Click()
ProgressBar1.Value = 0
StartTime = 0
Timer1.Enabled = True
Command1.Enabled = False
End Sub
Private Sub Timer1_Timer()
Dim Percent
If StartTime! = 0 Then
StartTime = Timer
End If
Percent = 100 * （Timer - StartTime） / 90
If Percent < 100 Then
ProgressBar1.Value = Percent
Label1.Caption = "正在安装..."
Else
ProgressBar1.Value = 100
Label1.Caption = "已经安装完毕!"
Beep
Timer1.Enabled = False
Command1.Enabled = True
End If
End Sub
【例7-9】 多文档界面的建立。
Dim fcount As Integer
Private Sub MDIForm_Load()
fcount = 1
Form1.Show
End Sub
Private Sub newfile_Click()
Dim nform As New Form1 '定义窗体变量
fcount = fcount + 1
nform.Caption = "文档" & Str（fcount） '设置新窗体的标题
nform.Show '显示新窗体
End Sub
Private Sub openfile_Click()
CommonDialog1.Flags = 4
CommonDialog1.Filter = "All Files|*.*|（*.txt）|*.txt| （*.exe）|*.exe"
CommonDialog1.FilterIndex = 1
CommonDialog1.DialogTitle = "打开"
CommonDialog1.Action = 1
End Sub
【例7-10】 记事本的设计
Dim num As Integer
Private Sub Filehide()
mnuFileH（0）.Visible = True
num = num + 1
If num > 4 Then
num = 1
mnuFileH（num）.Visible = True
mnuFileH（num）.Caption = CommonDialog1.FileName
Else
mnuFileH（num）.Visible = True
mnuFileH（num）.Caption = CommonDialog1.FileName
End If
End Sub
Private Sub Form_Resize()
With RichTextBox1
,Top = Toolbar1.Height
,Left = 0
,Height = Form1.ScaleHeight - Toolbar1.Height
,Width = Form1.ScaleWidth
End With
End Sub
Private Sub mnuFileN_Click（Index As Integer）
Dim fso As New FileSystemObject,fil As TextStream
Select Case Index
Case 0
RichTextBox1.Text = ""
Form1.Caption = "未命名"
Case 1
CommonDialog1.DialogTitle = "打开"
CommonDialog1.ShowOpen
fname = CommonDialog1.FileName
If fname <> "" Then
RichTextBox1.Text = ""
Set fil = fso.OpenTextFile（fname）
b = ""
b = fil.ReadAll
RichTextBox1.Text = Left（b,20000）
End If
Form1.Caption = fname
Call Filehide
Case 2
CommonDialog1.DialogTitle = "保存"
If Form1.Caption = "未命名" Or Form1.Caption = "" Then
CommonDialog1.ShowSave
fname = CommonDialog1.FileName
Call Filehide
Else
fname = Form1.Caption
End If
If fname <> "" Then
Set fil = fso.CreateTextFile（fname,True）
fil.Write RichTextBox1.Text
Form1.Caption = fname
End If
Case 3
CommonDialog1.DialogTitle = "另存为"
CommonDialog1.ShowSave
fname = CommonDialog1.FileName
If fname <> "" Then
Set fil = fso.CreateTextFile（fname,True）
fil.Write RichTextBox1.Text
Form1.Caption = fname
Call Filehide
End If
End Select
RichTextBox1.SetFocus
End Sub
Private Sub mnuFileExit_Click() '退出
Unload Me
End Sub
单击“文件”菜单历史记录选项的过程代码为：
Private Sub mnuFileH_Click（Index As Integer）
Dim fso As New FileSystemObject,fil As TextStream
fname = mnuFileH（Index）.Caption
RichTextBox1.Text = ""
Set fil = fso.OpenTextFile（fname）
b = ""
b = fil.ReadAll
RichTextBox1.Text = Left（b,20000）
Form1.Caption = fname
End Sub
“编辑”菜单各选项的单击事件代码为：
Private Sub mnuEditT_Click（Index As Integer）
Select Case Index
Case 0 '剪切
Clipboard.SetText RichTextBox1.SelRTF
RichTextBox1.SelRTF = ""
Case 1 '复制
Clipboard.SetText RichTextBox1.SelRTF
Case 2 '粘贴
RichTextBox1.SelRTF = Clipboard.GetText
Case 3 '清除
RichTextBox1.SelRTF = ""
Case 5 '字体
On Error Resume Next
CommonDialog1.ShowFont
If Err = cdlCancel Then
Else
RichTextBox1.SelFontName = CommonDialog1.FontName
RichTextBox1.SelFontSize = CommonDialog1.FontSize
RichTextBox1.SelBold = CommonDialog1.FontBold
RichTextBox1.SelItalic = CommonDialog1.FontItalic
RichTextBox1.SelUnderline = CommonDialog1,FontUnderline
RichTextBox1.SelStrikeThru = CommonDialog1.FontStrikethru
RichTextBox1.SelColor = CommonDialog1.Color
End If
Case 7 '全选
RichTextBox1.SelStart = 0
RichTextBox1.SelLength = Len（RichTextBox1.Text）
End Select
End Sub
"帮助"菜单的代码为：
Private Sub mnuHelpH_Click（Index As Integer）
Select Case Index
Case 0
CommonDialog1.ShowHelp
Case 2
MsgBox "Notpad 1.0 demo,2001,8",,"版本信息"
End Select
End Sub
工具栏中各选项代码为：
Private Sub Toolbar1_ButtonClick（ByVal Button As MSComctlLib,Button）
n = Button.Index
Select Case n
Case 2
Call mnuFileN_Click（0）
Case 3
Call mnuFileN_Click（1）
Case 4
Call mnuFileN_Click（2）
Case 6
Call mnuEditT_Click（0）
Case 7
Call mnuEditT_Click（1）
Case 8
Call mnuEditT_Click（2）
Case 10
RichTextBox1.SelBold = Not RichTextBox1.SelBold
Case 11
RichTextBox1.SelItalic = Not RichTextBox1.SelItalic
Case 12
RichTextBox1.SelUnderline = Not RichTextBox1.
SelUnder line
End Select
End Sub