VB上机练习题（五）.doc

《VB上机练习题（五）.doc》由会员分享，可在线阅读，更多相关《VB上机练习题（五）.doc（9页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。

1、VB上机练习题（五）(设计性)-2实验1：添加“关于”对话框。创建一个工程，移除普通的Form窗体，添加一个“关于对话框”（About Dialog）窗体，不用输入任何程序代码，然后运行这个程序，仔细观察体会程序中的各种信息。实验2：创建一个工程，移除普通的Form窗体，添加一个“登录对话框”（Login Dialog）窗体，不用输入任何代码，然后运行这个程序，这是一个验证密码的程序，默认的密码是“Password”，试一试修改这个密码。实验3：创建一个工程，移除普通的Form窗体，添加一个“展示屏幕”（Splash Dialog）窗体，不用输入任何代码，然后运行这个程序，观察效果。可以参考高

2、教教材例4.19的内容。实验4：创建一个工程，移除普通的Form窗体，添加一个“日积月累”（Tip of the Day）窗体，不用输入任何代码，然后运行这个程序，观察效果。实验5：实现全屏幕图形界面。提示：将窗体的边框设置为无边框，将窗体的显示模式设置为极大化来实现。即设置属性：BorderStyle=None WindowState=Maximized实验6：设计一个程序，每次单击窗体时可以更换一幅背景图片，同时调节背景图像大小适应窗体的大小，双击窗体退出程序。提示：更换背景图片可以用通用对话框来实现；调节背景图像大小用窗体的PaintPicture方法。窗体尺寸变化时背景图片也相应变化。

3、参考代码如下：Private Sub Form_Paint() 在窗体上绘制图像 Me.PaintPicture Me.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeightEnd SubPrivate Sub Form_Resize() Form_PaintEnd Sub实验7： 对于一个比较小的图像，在窗体或是图像控件中显示时，如何实现图像的平铺？提示：用图片框控件Picture1存放用于窗体背景平铺的图像源。设置Picture.Visible=False参考代码如下：Private Sub Form_Paint() Dim PicW_Sng As Sin

4、gle Dim PicH_Sng As Single Dim x As Single Dim y As Single 获取图像的尺寸 PicW_Sng = Picture1.ScaleWidth PicH_Sng = Picture1.ScaleHeight 绘制平铺图像 y = 0 Do While y ScaleHeight x = 0 Do While x ScaleWidth PaintPicture Picture1.Picture, x, y x = x + PicW_Sng Loop y = y + PicH_Sng LoopEnd SubPrivate Sub Form_Res

5、ize() Form_PaintEnd Sub实验8：如何制作闪烁的窗体标题栏？提示：调用Windows的API函数FlashWindow可以实现标题栏闪烁，通过给定不同的参数值决定窗体标题栏是否闪烁。FlashWindow函数声明如下(可以通过API文字浏览器获得)：Declare Function FlashWindow Lib user32 Alias FlashWindow (ByVal hwnd As Long, ByVal bInvert As Long) As Long其中hwnd指定要闪烁显示的窗体的句柄；bInvert确定是否切换窗体标题，bInvert=True(非零)表示

6、切换窗口标题，bInvert=False则返回初始状态。函数返回一个Long型数值，表征窗体所处状态，如果返回非零值则窗体处于活动状态。程序举例：使用两个命令按钮（Flash_Btn 和NoFlash_Btn）控制窗体标题栏是否闪烁，使用计时器（Timer1）的时间间隔控制窗体的闪烁频率。参考代码： 窗体的通用/声明部分Private Declare Function FlashWindow Lib user32 (ByVal hwnd As Long, ByVal bInvert As Long) As LongPrivate Sub Form_Load() Timer1.Interval

7、= 200 设定计时器间隔 Timer1.Enabled = False 初始时计时器无效 NoFlash_Btn.Enabled = False “标题栏不闪烁”按钮无效End SubPrivate Sub Flash_Btn_Click() Timer1.Enabled = True 计时器有效 NoFlash_Btn.Enabled = True “标题栏不闪烁”按钮有效 Flash_Btn.Enabled = False “标题栏闪烁”按钮无效End SubPrivate Sub NoFlash_Btn_Click() Timer1.Enabled = False 计时器无效 Flas

8、h_Btn.Enabled = True “标题栏闪烁”按钮有效 NoFlash_Btn.Enabled = False “标题栏不闪烁”按钮无效End SubPrivate Sub Timer1_Timer() FlashWindow Me.hwnd, 1 调用函数使窗体标题栏闪烁End Sub实验9：如何实现简单的动画窗体，让程序运行开始和结束时的窗体动起来？提示：用计时器（Fly_Timer）来控制窗体的位置与大小，从而实现动画效果。参考代码（实现窗体飞入屏幕的动画效果）： 窗体的通用/声明部分Dim End_X As IntegerDim End_Y As IntegerDim Spe

9、ed_X As IntegerDim Speed_Y As Integer 编写计时器事件Private Sub Fly_Timer_Timer()If Abs(Me.Left - End_X) = Form1.Width - 200 Then Form1.Width = Form1.Width + 200 If Y = Form1.Height - 800 Then Form1.Height = Form1.Height + 200End Sub实验13：如何限制鼠标移动区域。程序举例：希望用户鼠标不离开程序窗口。参考代码：Option Explicit 声明类型Private Type R

10、ECT Left As Long Top As Long Right As Long Bottom As LongEnd Type 声明函数Private Declare Function ClipCursor Lib user32 (lpRect As Any) As LongDim Form_Rect As RECT 限制鼠标在窗体内活动Private Sub Form_Load() With Form_Rect .Left = Me.Left Screen.TwipsPerPixelX .Top = Me.Top Screen.TwipsPerPixelY .Right = (Me.Le

11、ft + Me.Width) Screen.TwipsPerPixelX .Bottom = (Me.Top + Me.Height) Screen.TwipsPerPixelY End With ClipCursor Form_Rect Release_Btn.Enabled = TrueEnd Sub 解除鼠标限制Private Sub Release_Btn_Click() ClipCursor Form_Rect Release_Btn.Enabled = FalseEnd Sub 退出之前确保解除鼠标限制Private Sub Exit_Btn_Click() If Release_

12、Btn.Enabled = True Then Release_Btn_Click End If EndEnd Sub实验14：在很多演示程序中，鼠标会自动移动并进行单击等操作，如何实现？提示：使用API中控制光标的函数SetCursor、GetCursor、GetCursorPos、SetCursorPos可以模拟实现鼠标的自动移动以及单击等操作，为了将模拟的鼠标动作传递到窗体上，还需要使用PostMessage函数。PostMessage函数将一条消息投递到指定窗口的消息队列。投递的消息会在Windows事件处理过程中得到处理。程序举例：实现鼠标的自动移动和单击等操作。运行界面如图所示。参

13、考代码： 窗体的通用/声明部分Option ExplicitPrivate Declare Function GetTickCount Lib kernel32 () As LongPrivate Declare Function GetCursorPos Lib user32 (lpPoint As POINTAPI) As LongPrivate Declare Function SetCursorPos Lib user32 (ByVal X As Long, ByVal Y As Long) As LongPrivate Declare Function PostMessage Lib

14、 user32 Alias PostMessageA (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As LongPrivate Const MK_CONTROL = &H8 键盘Ctrl键Private Const MK_LBUTTON = &H1 鼠标左键Private Const MK_MBUTTON = &H10 鼠标中键Private Const MK_RBUTTON = &H2 鼠标右键Private Const WM_MBUTTONDOWN = &H207

15、鼠标中键按下Private Const WM_MBUTTONUP = &H208 鼠标中键抬起Private Const WM_LBUTTONDOWN = &H201 鼠标左键按下Private Const WM_LBUTTONUP = &H202 鼠标左键抬起Private Const WM_LBUTTONDBLCLK = &H203 鼠标左键双击Private Const WM_MOUSEMOVE = &H200 鼠标移动Private Const WM_RBUTTONDBLCLK = &H206 鼠标右键双击Private Const WM_RBUTTONDOWN = &H204 鼠标右

16、键按下Private Const WM_RBUTTONUP = &H205 鼠标右键抬起Private Const HWND_BROADCAST = &HFFFF& 用来对所有的窗口传送消息Private Type POINTAPI X As Long Y As LongEnd Type 根据lParam 参数取得对应的X,Y坐标Private Function GetPointXY(ByVal lParam As Long) As POINTAPI GetPointXY.X = lParam And &HFFFF GetPointXY.Y = (lParam And &HFFFF0000)

17、/ (2 16)End Function 将位置坐标转换为 Twips单位Private Function XY2Twips(ByRef pos As POINTAPI) pos.X = pos.X * Screen.TwipsPerPixelX pos.Y = pos.Y * Screen.TwipsPerPixelYEnd Function 移动光标Private Sub MoveCursor(ByVal X As Integer, ByVal Y As Integer) SetCursorPos X, Y Me.Caption = X: & X & ,Y: & YEnd Sub 延时Pu

18、blic Sub Pause(HowLong As Long) Dim tick As Long tick = GetTickCount() Do DoEvents Loop Until tick + HowLong GetTickCountEnd Sub 移动光标Private Sub MouseMove() Dim X As Long, Y As Long Dim pos As POINTAPI Dim demopos As POINTAPI 演示按钮区域的左上角 demopos.X = (TestCmd.Left + TestCmd.Width / 2 + Me.Left) / Scre

19、en.TwipsPerPixelX demopos.Y = (TestCmd.Top + TestCmd.Height / 2 + Me.Top + 300) / Screen.TwipsPerPixelY 得到当前光标位置 GetCursorPos pos 循环，将光标移动到 demopos 位置 For X = pos.X To demopos.X Step -1 Pause 4 MoveCursor X, pos.Y Next For Y = pos.Y To demopos.Y Step -1 Pause 10 MoveCursor demopos.X, Y NextEnd Sub 单

20、击演示按钮开始演示Private Sub DemoCmd_Click() Dim lParam As Long Dim pos As POINTAPI Dim i As Integer Dim h As Long 移动光标 Call MouseMove 得到当前光标位置 GetCursorPos pos lParam = CLng(pos.X) + CLng(pos.Y) * (2 16) h = TestCmd.hwnd 传递鼠标按下操作 Call PostMessage(h, WM_LBUTTONDOWN, MK_LBUTTON, lParam) lblTip.Caption = 光标按下 DoEvents 延时 Pause 1000 传递鼠标抬起操作 Call PostMessage(Me.TestCmd.hwnd, WM_LBUTTONUP, MK_LBUTTON, lParam) Me.lblTip.Caption = 光标抬起End Sub Private Sub TestCmd_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) MsgBox HELLOEnd Sub