VB实例源码

End Select End Sub 【例7-9】

Private Sub Form_Click()

If Command1.DragMode = 0 Then Command1.DragMode = 1 Else

Command1.DragMode = 0 End If End Sub 【例7-11】

Private Sub Picture2_DragDrop(Source As Control,X As Single,Y As Single) If TypeOf Source Is PictureBox Then Picture2.Picture=Source.Picture End If End Sub 【例7-12】

Private Sub Picture1_DragOver(Source As Control,X As Single,_ Y As Single,State As Integer) Select Case State Case0

Source.DragIcon=LoadPicture(App.Path & \ Case1

Source.DragIcon=LoadPicture() End Select End Sub 【例7-13】

（2）编写文本框的MouseDown事件过程，代码如下：

Private Sub Text1_MouseDown(Button As Integer,Shift As Integer,_ X As Single,Y As Single) Text1.Drag1 End Sub

过程中使用Drag方法启动文本框的拖放操作； （3）编写文本框的事件过程，代码如下：

Private Sub Text1_MouseUp(Button As Integer,Shift As Integer,_ X As Single,Y As Single) Text1.Drag 2 End Sub

过程中使用Drag方法结束文本框的拖放操作

（4）编写窗体的DragDrop事件过程，代码如下：

Private Sub Form_DragDrop(Source As Control,X As Single,Y As Single) Source.Move(X-Source.Width/2),(Y-Source.Height/2) End Sub

21

实训

（3）在Form1的窗体模块的代码窗口的最顶部（通用声明段）声明模块级变量paint，用来存储逻辑型数据。代码如下：

Private paint As Boolean

（4）定义各鼠标事件过程。

①事件过程Form_MouseDown的代码如下：

Private Sub Form_MouseDown(Button As Integer, Shift As Integer,_ X As Single, Y As Single) paint = True '允许绘图

DrawWidth = 1 '设置绘图线宽 PSet (X, Y) '使用画点方法 End Sub ② 事件过程Form_MouseMove的代码如下：

Private Sub Form_MouseMove(Button As Integer,Shift As Integer,_ X As Single,Y As Single) If paint Then

If Button = 1 Then '按住的是左键

MousePointer = 1 '指针设置成箭头形状，表示画笔 DrawWidth = 4

Line-(X,Y),Visual BasicBlue '使用画点方法 End If

If Button = 2 Then '按住的是右键

MousePointer = 11 '指针设置成箭头形状，表示橡皮擦 DrawWidth = 16

Line -(X, Y),Visual BasicWhite End If End If End Sub ③ 事件过程Form_MouseUp的代码如下：

Private Sub Form_MouseUp(Button As Integer,Shift As Integer,_ X As Single,Y As Single) paint = False '表示不允许鼠标绘图 MousePointer = 1 End Sub ④ 事件过程Form_DblClick的代码如下： Private Sub Form_DblClick() Cls End Sub

（4）定义各键盘事件过程Form_KeyPress，代码如下： Private Sub Form_KeyPress(KeyAscii As Integer)

22

Print Chr(KeyAscii); End Sub

第8章 课前体验

（3）编写程序代码

①为窗体Form1编写代码

命令按钮的单击事件过程如下： Private Sub Command1_Click() Form1.Hide Form2.Show

Form2.Caption = Form1.Text1 + \的打字练习！\ ’Form1.Text1为用户名End Sub

②为窗体Form2编写代码

“重新登录”按钮Command1的单击事件过程如下： Private Sub Command1_Click() Form2.Hide Form1.Show End Sub

“清屏”按钮Command2的单击事件过程如下： Private Sub Command2_Click() Text1.Text = \End Sub

“关闭”按钮Command3的单击事件过程如下： Private Sub Command3_Click() End End Sub

【例8-2】

X As Single,Y As Single) If Button=2 Then

PopupMenu play End If End Sub

【例8-3】

（1）“文件(&F)”主菜单中各菜单项的事件过程

Private Sub mnuClear_Click() Cls End Sub

Private Sub mnuExit_Click() End

23

End Sub

该过程的功能是退出应用程序。 （2）“格式(&S)”主菜单中各菜单项的事件过程 Private Sub mnuBold_Click() If mnuBold.Checked=True Then Text1.FontBold=False mnuBold.Checked=False Else

Text1.FontBold=True mnuBold.Checked=True End If End Sub

该过程在用户选择“格式”主菜单下的“粗体”菜单项时执行，实现将文本框中的文字变为粗体显示，如果文字已经是粗体显示，则将文字变为正常显示。

Private Sub mnuUnder_Click()

If mnuUnder.Checked = True Then Text1.FontUnderline = False mnuUnder.Checked = False Else

Text1.FontUnderline = True mnuUnder.Checked = True End If End Sub

该过程在用户选择“格式”主菜单下的“下画线”菜单项时执行，实现将文本框中的文字添加下画线，如果文字已经具有下画线，则将文字的下画线取消。

Private Sub mnuItalic_Click()

If mnuItalic.Checked = True Then Text1.FontItalic = False mnuItalic.Checked = False Else

Text1.FontItalic = True mnuItalic.Checked = True End If End Sub

该过程在用户选择“格式”主菜单下的“倾体”菜单项时执行，实现将文本框中的文字变为斜体显示，如果文字已经是斜体显示，则将文字变为正常显示。

（3）“前景颜色(&Q)”子菜单中各菜单项的事件过程 Private Sub mnuRed_Click() Text1.ForeColor = vbRed End Sub

Private Sub mnuBlue_Click() Text1.ForeColor = vbBlue End Sub

24

（4）“帮助(&H)”主菜单项中各菜单项的事件过程 Private Sub mnuAbout_Click()

MsgBox\菜单设计实例\关于\End Sub

Private Sub mnuSoft_Click()

MsgBox\如有任何问题，请与作者联系！\使用帮助\End Sub

【例8-4】

（1）编写弹出式菜单“娱乐”中各菜单项的事件过程 ·①“画图”菜单项的事件过程 Private Sub menuPaint_Click()

Shell(\End Sub

·②“纸牌”菜单项的事件过程 Private Sub menuPoker_Click()

Shell (\End Sub

（2）编写下拉式菜单“办公”中各菜单项的事件过程 ①单击“电子文档“菜单项的事件过程 Private Sub menuWord_Click()

Shell(\End Sub

·②单击“电子表格”菜单项的事件过程 Private Sub menuExcel_Click()

Shell(\End Sub

【例8-6】

（2）编写命令按钮Command1(浏览)的单击事件过程：

Private Sub Command1_Click()

CommonDialog1.Filter = \图片文件|*.bmp;*.jpg;*.gif\

CommonDialog1.ShowOpen '或CommonDialog1.Action = 1 Picture1.Picture = LoadPicture(CommonDialog1.FileName) End Sub

（3）编写命令按钮Command2(保存)的单击事件过程：

Private Sub Command2_Click() CommonDialog1.InitDir = \

CommonDialog1.FileName = \

CommonDialog1.Filter = \文件|*.bmp\

CommonDialog1.ShowSave '或CommonDialog1.Action = 2 SavePicture Picture1.Picture, CommonDialog1.FileName End Sub

25