全国计算机等级考试-二级教程【Visual Basic 语言程序设计】全书例题程序代码-第七部分

1、61、例题10.9 在图片框中画一个箭头，当在图片框中移动鼠标时，箭头会随着鼠标光标的移动而改变方向。Private Sub Vane_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Static LastX As Integer Static LastY As Integer If X > LastX Then xaxis = 1 If X < LastX Then xaxis = -1 If Y > LastY Then yaxis = 1 If Y < LastY T

2、hen yaxis = -1 Label1.Caption = Str$(xaxis) + " " + Str$(yaxis) Select Case True Case (xaxis = 1 And yaxis = 1) Vane.Picture = LoadPicture("C:Documents and SettingsAdministrator桌面VB练习用图1.gif") Case (xaxis = 1 And yaxis = -1) Vane.Picture = LoadPicture("C:Documents and Settin

3、gsAdministrator桌面VB练习用图2.gif") Case (xaxis = -1 And yaxis = 1) Vane.Picture = LoadPicture("C:Documents and SettingsAdministrator桌面VB练习用图3.gif") Case (xaxis = -1 And yaxis = -1) Vane.Picture = LoadPicture("C:Documents and SettingsAdministrator桌面VB练习用图4.gif") Case (xaxis = 1 A

4、nd yaxis = 0) Vane.Picture = LoadPicture("C:Documents and SettingsAdministrator桌面VB练习用图5.gif") Case (xaxis = -1 And yaxis = 0) Vane.Picture = LoadPicture("C:Documents and SettingsAdministrator桌面VB练习用图6.gif") Case (xaxis = 0 And yaxis = 1) Vane.Picture = LoadPicture("C:Docume

5、nts and SettingsAdministrator桌面VB练习用图7.gif") Case (xaxis = 0 And yaxis = -1) Vane.Picture = LoadPicture("C:Documents and SettingsAdministrator桌面VB练习用图8.gif") End Select LastX = X LastY = YEnd Sub运行结果：62、例题10.10 编写程序，显示鼠标光标的形状。Private Sub Form_Click() Static x As Integer Cls Print &quo

6、t;Mousepointer Property is mow" x Form1.MousePointer = x x = x + 1 If x = 15 Then x = 0End Sub运行结果：63、例题10.11 在窗体上建立两个控件，拖拉其中一个控件，当把它放到第二个控件上时，该控件消失，单击窗体后再度出现。' 首先在窗体上建立两个图片框，并在第一个图片框中装入一个图标（例如未命名.ico）。然后编写如下过程：Private Sub Form_Load() Picture1.DragIcon = Picture1.Picture Picture1.DragMode =

7、 1End Sub' 使得Picture1消失在Picture2上。Private Sub Picture2_DragDrop(Source As Control, X As Single, Y As Single) Source.Visible = FalseEnd Sub' 单击窗体，使得Picture1重现。Private Sub Form_Click() Picture1.Visible = TrueEnd Sub' 将Picture1拖到窗体上的（X,Y）处。Private Sub Form_DragDrop(Source As Control, X As S

8、ingle, Y As Single) Source.Move X, YEnd Sub运行结果：'在窗体上建立两个控件，拖拉其中一个控件，当把它放到第二个控件上时，该控件消失，单击窗体后再度出现。'首先在窗体上建立两个图片框，并在第一个图片框中装入一个图标（例如未命名.ico）。然后编写如下过程：Private Sub Form_Load() Picture1.DragIcon = Picture1.Picture Picture1.DragMode = 1 Picture2.ForeColor = RGB(255, 0, 0) Picture2.BackColor = RGB

9、(0, 0, 255)End Sub'使得Picture1消失在Picture2上。Private Sub Picture2_DragDrop(Source As Control, X As Single, Y As Single) Source.Visible = FalseEnd Sub'单击窗体，使得Picture1重现。Private Sub Form_Click() Picture1.Visible = TrueEnd Sub'将Picture1拖到窗体上的（X,Y）处。Private Sub Form_DragDrop(Source As Control,

10、X As Single, Y As Single) Source.Move X, YEnd Sub'使得图片1进入图片2区域时产生变色反应。Private Sub Picture2_DragOver(Source As Control, X As Single, Y As Single, State As Integer) Dim temp As Long If State = 0 Or State = 1 Then Beep Beep temp = Picture2.BackColor Picture2.BackColor = Picture2.ForeColor Picture2.

11、ForeColor = temp End IfEnd Sub64、例题11.1 设计一个具有算术运算（+、-、*、/）及清除功能的菜单。从键盘上输入两个数字，利用菜单命令求它们的和、差、积、商，并显示出来。Private Sub Num1_Change() If Num1.Text = "" Then Add.Enabled = False Min.Enabled = False Mul.Enabled = False Div.Enabled = False Else Add.Enabled = True Min.Enabled = True Mul.Enabled = T

12、rue Div.Enabled = True End IfEnd SubPrivate Sub Num2_Change() If Num1.Text = "" Then Add.Enabled = False Min.Enabled = False Mul.Enabled = False Div.Enabled = False Else Add.Enabled = True Min.Enabled = True Mul.Enabled = True Div.Enabled = True End IfEnd SubPrivate Sub Add_Click() x = Val

13、(Num1.Text) + Val(Num2.Text) Result.Caption = Str$(x)End SubPrivate Sub Min_Click() x = Val(Num1.Text) - Val(Num2.Text) Result.Caption = Str$(x)End SubPrivate Sub Mul_Click() x = Val(Num1.Text) * Val(Num2.Text) Result.Caption = Str$(x)End SubPrivate Sub Div_Click() x = Val(Num1.Text) / Val(Num2.Text

14、) Result.Caption = Str$(x)End SubPrivate Sub Clean_Click() Num1.Text = "" Num2.Text = "" Result.Caption = "" Num1.SetFocus '输入光标移动到文本框Num1End SubPrivate Sub Quit_Click() EndEnd Sub运行结果：65、例题11.2 设计一个菜单，该菜单含有一个主菜单和若干子菜单项。当单击子菜单项时，分别显示十进制、八进制和十六进制数，并在相应的菜单项前加上对号。Priva

15、te Sub Clean_Click() TexBox.Text = "" Octv.Checked = False Dec.Checked = False Hexv.Checked = False Clean.Checked = True Quit.Checked = False Label4.Caption = "" Label5.Caption = "" Label6.Caption = ""End SubPrivate Sub Dec_Click() Answer = Val(TexBox.Text) Oc

16、tv.Checked = False Dec.Checked = True Hexv.Checked = False Clean.Checked = False Quit.Checked = False Label4.Caption = Format(Answer)End SubPrivate Sub Hexv_Click() Answer = Val(TexBox.Text) Octv.Checked = False Dec.Checked = False Hexv.Checked = True Clean.Checked = False Quit.Checked = False Label

17、6.Caption = Hex$(Answer)End SubPrivate Sub Octv_Click() Answer = Val(TexBox.Text) Octv.Checked = True Dec.Checked = False Hexv.Checked = False Clean.Checked = False Quit.Checked = False Label5.Caption = Oct$(Answer)End SubPrivate Sub Quit_Click() EndEnd Sub运行结果：66、例题11.3 编写程序，实现菜单项的增减操作。Dim Menucoun

18、ter As IntegerPrivate Sub AddAp_Click() msg$ = "Enter file path" Temp$ = InputBox$(msg$, "Add Application") Menucounter = Menucounte + 1 '下标值增加1 Load AppName(Menucounter) '用Load语句建立控件数组的新元素，并把输入的应用程序的名字设置为该元素的Caption属性（即菜单项）。 AppName(Menucounter).Caption = Temp$ AppName(M

19、enucounter).Visible = TrueEnd SubPrivate Sub DelAp_Click() Dim N As Integer, I As Integer msg$ = "Enter number to delete:" N = InputBox(msg$, "Delete Application") If N > Menucounter Or N < 1 Then MsgBox "超出范围！" Exit Sub End If For I = N To Menucounter - 1 AppName

20、(I).Caption = AppName(I + 1).Caption Next I Unload AppName(Menucounter) Menucounter = Menucounter - 1End SubPrivate Sub AppName_Click(Index As Integer) x = Shell(AppName(Menucounter).Caption, 1)End Sub运行结果：67、例题11.4 建立一个弹出式菜单，用来改变文本框中字体的属性。Private Sub font20_Click() Text1.FontSize = 18End SubPrivate

21、 Sub Form_Load() Text1.Text = "可视化高级程序设计语言"End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 Then PopupMenu popFormat End IfEnd SubPrivate Sub popBold_Click() Text1.FontBold = TrueEnd SubPrivate Sub popFormat_Click() Text1.FontNa

22、me = "宋体"End SubPrivate Sub popItalic_Click() Text1.FontItalic = TrueEnd SubPrivate Sub popUnder_Click() Text1.FontUnderline = TrueEnd SubPrivate Sub Quit_Click() EndEnd Sub运行结果：68、例题12.1 编写程序，建立“打开”和“保存”对话框。在窗体上画一个通用对话框控件，其Name属性为CommonDialog1（默认值）；再画两个命令按钮，其Name属性分别为Command1和Command2；然后编

23、写两个事件过程。建立“打开”对话框的事件过程如下：（1）建立“打开”对话框命令流：Private Sub Command1_Click() CommonDialog1.FileName = "" CommonDialog1.Flags = vbOFNFileMustExist CommonDialog1.Filter = "All Files|(*.*)|*.exe|(*.exe)|*.txt|(*.txt)" CommonDialog1.FilterIndex = 3 CommonDialog1.DialogTitle = "Open Fil

24、e(*.txt)" CommonDialog1.Action = 1 If CommonDialog1.FileName = "" Then MsgBox "No File Selected !", 37, "Checking" Else '对所选择的文件进行处理。 Open CommonDialog1.FileName For Input As #1 Do While Not EOF(1) Input #1, a$ Print a$ Loop End IfEnd Sub运行结果：按“取消”按钮后（2）建立“保存”对话框命令流：Private Sub Command2_Click() CommonDialog1.CancelError = True CommonDialog1.DefaultExt = "TXT" CommonDialog1.FileName = "lbw.txt" CommonDialog1.Filter = "Text files(*.txt)|*.TXT|All File