cover.frm

一个漂亮的按钮

VERSION 5.00
Begin VB.Form frmCover 
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   ClientHeight    =   2910
   ClientLeft      =   3600
   ClientTop       =   2550
   ClientWidth     =   3480
   ControlBox      =   0   'False
   FillStyle       =   0  'Solid
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   194
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   232
   ShowInTaskbar   =   0   'False
   WindowState     =   2  'Maximized
   Begin VB.Timer tmrMoveBalls 
      Interval        =   50
      Left            =   1440
      Top             =   1200
   End
End
Attribute VB_Name = "frmCover"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'--------------------------------------------
'           一个完备的屏保程序的实例
'--------------------------------------------
'             洪恩在线  求知无限
'--------------------------------------------
'说明：
'   1）支持屏保参数设置，动态改变小球数目
'   2）编译成.scr文件后，拷入windows目录下
'      即可在显示属性中调用
'   3）支持命令行参数
'--------------------------------------------
'以下的六个子过程，都用来判断屏保是否应该终止
'Sub Form_Click()用户单击鼠标时
'Sub Form_DblClick()用户双击鼠标时
'Sub Form_KeyDown用户按下某一个键时
'Sub Form_KeyPress用户按某一个键时
'Sub Form_MouseDown用户按下鼠标时
'Sub Form_MouseMove用户移动鼠标时
'如果处于全屏屏保状态，则终止屏保程序
'--------------------------------------------
Option Explicit
Private Sub Form_Click()
    If RunMode = rmScreenSaver Then Unload Me
End Sub

Private Sub Form_DblClick()
    If RunMode = rmScreenSaver Then Unload Me
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If RunMode = rmScreenSaver Then Unload Me
End Sub


Private Sub Form_KeyPress(KeyAscii As Integer)
    If RunMode = rmScreenSaver Then Unload Me
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If RunMode = rmScreenSaver Then Unload Me
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Static x0 As Integer
Static y0 As Integer
    If RunMode <> rmScreenSaver Then Exit Sub
    
    '如果鼠标在极小范围内移动，不退出屏保
    If ((x0 = 0) And (y0 = 0)) Or _
        ((Abs(x0 - x) < 5) And (Abs(y0 - y) < 5)) _
        Then
            x0 = x
            y0 = y
            Exit Sub
    End If

    Unload Me
End Sub

'
Private Sub Form_Resize()
    '读取设置信息，这些信息存储在注册表中
    LoadConfig

    '初始化balls数组
    InitializeBalls
End Sub

'当我们退出屏保程序时，必须把鼠标状态改回为可见
Private Sub Form_Unload(Cancel As Integer)
    If RunMode = rmScreenSaver Then ShowCursor True
End Sub

'每隔50毫秒移动小球一次
Private Sub tmrMoveBalls_Timer()
Dim i As Integer
Dim wid As Single
Dim hgt As Single

    '擦除小球
    For i = 1 To NumBalls
        With Balls(i)
            FillColor = BackColor
            Circle (.BallX, .BallY), .BallR, BackColor
        End With
    Next i

    '移动并重画小球
    wid = ScaleWidth
    hgt = ScaleHeight
    For i = 1 To NumBalls
        With Balls(i)
            
            '如果没有碰壁，则按路线运动
            .BallX = .BallX + .BallVx
            
            '当小球圆心坐标值小于其半径值时（碰左边壁时），反弹，并把运动方向参数 BallVx 置反
            '这样小球会反向运动
            If .BallX < .BallR Then
                .BallX = 2 * .BallR - .BallX
                .BallVx = -.BallVx
            
            '或当小球球心坐标值大于屏幕宽与半径差值（碰右边壁时），反弹
            '并把运动方向参数 BallVx 置反，这样小球会反向运动
            ElseIf .BallX > wid - .BallR Then
                .BallX = 2 * (wid - .BallR) - .BallX
                .BallVx = -.BallVx
            End If
            
            '参照X项解释去理解，X、Y方向的运动的综合，便是小球的实际运动轨迹
            .BallY = .BallY + .BallVy
            If .BallY < .BallR Then
                .BallY = 2 * .BallR - .BallY
                .BallVy = -.BallVy
            ElseIf .BallY > hgt - .BallR Then
                .BallY = 2 * (hgt - .BallR) - .BallY
                .BallVy = -.BallVy
            End If
            
            '在（BallX、BallY）坐标处，以BallR为半径，以BallClr为填充色，重画小球
            FillColor = .BallClr
            Circle (.BallX, .BallY), .BallR, .BallClr
        End With
    Next i
End Sub