main.bas

一个漂亮的按钮

Attribute VB_Name = "SubMain"
Option Explicit

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Public Const SWP_NOACTIVATE = &H10
Public Const SWP_NOZORDER = &H4
Public Const SWP_SHOWWINDOW = &H40

Public Const HWND_TOP = 0

Public Const WS_CHILD = &H40000000
Public Const GWL_HWNDPARENT = (-8)
Public Const GWL_STYLE = (-16)

'-------------------------------------
'【VB声明】
'  Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

'【说明】
'  从指定窗口的结构中取得信息

'【返回值】
'  Long，由nIndex决定。零表示出错。会设置GetLastError

'【参数表】
'  hwnd -----------  Long，欲为其获取信息的窗口的句柄

'  nIndex ---------  Long，欲取回的信息
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
'-------------------------------------
'【VB声明】
'  Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

'【说明】
'  返回指定窗口客户区矩形的大小

'【返回值】
'  Long，非零表示成功，零表示失败。会设置GetLastError

'【备注】
'  lpRect的左侧及顶部区域肯定会被这个函数设为零

'【参数表】
'  hwnd -----------  Long，欲计算大小的目标窗口

'  lpRect ---------  RECT，指定一个矩形，用客户区域的大小载入（以像素为单位）
Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'-------------------------------------
'【VB声明】
'  Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

'【说明】
'  在窗口结构中为指定的窗口设置信息

'【返回值】
'  Long，指定数据的前一个值

'【参数表】
'  hwnd -----------  Long，欲为其取得信息的窗口的句柄

'  nIndex ---------  Long，请参考GetWindowLong函数的nIndex参数的说明

'  dwNewLong ------  Long，由nIndex指定的窗口信息的新值
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'-------------------------------------
'【VB声明】
'  Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long

'【说明】
'  指定一个窗口的新父（在vb里使用：利用这个函数，vb可以多种形式支持子窗口。例如，可将控件从一个容器移至窗体中的另一个。用这个函数在窗体间移动控件是相当冒险的，但却不失为一个有效的办法。如真的这样做，请在关闭任何一个窗体之前，注意用SetParent将控件的父设回原来的那个）

'【返回值】
'  Long，前一个父窗口的句柄

'【备注】
'  可用这个函数在运行期将vb控件置入容器控件内部（比如将一个按钮设成图象或窗体控件的子窗口），或者将控件从一个容器控件移至另一个。控件移至另一个父后，它的位置将由新父的坐标系统决定。这样一来，有必要重新规定控件的位置，使其能在目标位置显示出来

'【参数表】
'  hWndChild ------  Long，子窗口的句柄

'  hWndNewParent --  Long，hWndChild的新父
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
'-------------------------------------
'【VB声明】
'  Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

'【说明】
'  这个函数能为窗口指定一个新位置和状态。它也可改变窗口在内部窗口列表中的位置。该函数与DeferWindowPos函数相似，只是它的作用是立即表现出来的（在vb里使用：针对vb窗体，如它们在win32下屏蔽或最小化，则需重设最顶部状态。如有必要，请用一个子类处理模块来重设最顶部状态

'【返回值】
'  Long，非零表示成功，零表示失败。会设置GetLastError

'【备注】
'  窗口成为最顶级窗口后，它下属的所有窗口也会进入最顶级。一旦将其设为非最顶级，则它的所有下属和物主窗口也会转为非最顶级。Z序列用垂直于屏幕的一根假想Z轴量化这种从顶部到底部排列的窗口顺序

'【参数表】
'  hwnd -----------  Long，欲定位的窗口

'  hWndInsertAfter -  Long，窗口句柄。在窗口列表中，窗口hwnd会置于这个窗口句柄的后面。也可能选用下述值之一：
'  HWND_BOTTOM  将窗口置于窗口列表底部
'  HWND_TOP  将窗口置于Z序列的顶部；Z序列代表在分级结构中，窗口针对一个给定级别的窗口显示的顺序
'  HWND_TOPMOST  将窗口置于列表顶部，并位于任何最顶部窗口的前面
'  HWND_NOTOPMOST  将窗口置于列表顶部，并位于任何最顶部窗口的后面

'  x --------------  Long，窗口新的x坐标。如hwnd是一个子窗口，则x用父窗口的客户区坐标表示

'  y --------------  Long，窗口新的y坐标。如hwnd是一个子窗口，则y用父窗口的客户区坐标表示

'  cx -------------  Long，指定新的窗口宽度

'  cy -------------  Long，指定新的窗口高度

'  wFlags ---------  Long，包含了旗标的一个整数
Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'-------------------------------------
'【VB声明】
'  Private Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long

'【说明】
'  控制鼠标指针的可视性

'【返回值】
' Long，显示计数（参考注解）

'【备注】
'  windows维持着一个内部显示计数；倘若bShow为TRUE，那么每调用一次这个函数，计数就会递增1；
'  反之，如bShow为FALSE，则计数递减1。只有在这个计数大于或等于0的情况下，指针才会显示出来

'【参数表】
'  bShow ----------  Long，TRUE（非零）显示指针，FALSE隐藏
Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
'-------------------------------------
'【VB声明】
'  Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'【说明】
'  寻找窗口列表中第一个符合指定条件的顶级窗口（在vb里使用：FindWindow最常见的一个用途是获得ThunderRTMain类的隐藏窗口的句柄；该类是所有运行中vb执行程序的一部分。获得句柄后，可用api函数GetWindowText取得这个窗口的名称；该名也是应用程序的标题）

'【返回值】
'  Long，找到窗口的句柄。如未找到相符窗口，则返回零。会设置GetLastError

'【参数表】
'  lpClassName ----  String，指向包含了窗口类名的空中止（C语言）字串的指针；或设为零，表示接收任何类

'  lpWindowName ---  String，指向包含了窗口文本（或标签）的空中止（C语言）字串的指针；或设为零，表示接收任何窗口标题
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'-------------------------------------
'定义全局变量
Public Const rmConfigure = 1        '
Public Const rmScreenSaver = 2      '
Public Const rmPreview = 3          '
Public RunMode As Integer           '当前所处的模式，做是否退出屏保判断用

'自定义的Ball类型，包含小球参数，BallClr为小球颜色，BallR为半径，BallX、BallY为球心坐标，
'BallVx、BallVy为小球运动方向参数（即小球每次移动的方向和幅度），改变它可以改变小球速度
Public Type Ball
    BallClr As Long
    BallR As Single
    BallX As Single
    BallY As Single
    BallVx As Single
    BallVy As Single
End Type

'同时出现的小球的数量
Public NumBalls As Integer
'存储每一个小球参数的数组
Public Balls() As Ball

'此变量的作用是判断并保证只有此应用程序的一个实例运行
Private Const APP_NAME = "BouncingBalls"

'判断是否只有此应用程序的一个实例正在运行运行
Private Sub CheckShouldRun()

    If Not App.PrevInstance Then Exit Sub

    'FindWindow函数作用是搜索当前是否运行了指定的应用程序，如果已有实例运行，则退出
    If FindWindow(vbNullString, APP_NAME) Then End

    '设置窗体的Caption属性为"BouncingBalls"，以便其他实例找到自己
    frmCover.Caption = APP_NAME
End Sub

'从注册表中读取原有设置，GetSetting函数的用法详见“历史记录的例子”中的讲解
Public Sub LoadConfig()
    NumBalls = CInt(GetSetting(APP_NAME, _
        "Settings", "NumBalls", "1"))
End Sub

'初始化小球的子过程
Public Sub InitializeBalls()

'定义小球参数的上下界
Const MIN_CLR = 1
Const MAX_CLR = 15
Const MIN_BALLR = 0.03
Const MAX_BALLR = 0.05
Const MIN_VX = 0.005
Const MAX_VX = 0.025
Const MIN_VY = 0.005
Const MAX_VY = 0.025

Dim i As Integer
Dim wid As Single
Dim hgt As Single
Dim minx As Single
Dim maxx As Single
Dim miny As Single
Dim maxy As Single
Dim minr As Single
Dim maxr As Single
Dim minvx As Single
Dim maxvx As Single
Dim minvy As Single
Dim maxvy As Single

    '初始化小球参数
    If NumBalls <= 0 Then
        '清除Balls数组
        Erase Balls
    Else
        '重新定义Balls数组
        ReDim Balls(1 To NumBalls)

        '取得随机的小球位置，大小，速度等参数
        wid = frmCover.ScaleWidth
        hgt = frmCover.ScaleHeight
        minr = MIN_BALLR * wid
        maxr = MAX_BALLR * wid
        minvx = MIN_VX * wid
        maxvx = MAX_VX * wid
        minvy = MIN_VY * wid
        maxvy = MAX_VY * wid
        Randomize
        '并写入Balls数组
        For i = 1 To NumBalls
            With Balls(i)
                .BallClr = QBColor(Int((MAX_CLR - MIN_CLR + 1) * Rnd + MIN_CLR))
                .BallR = Int((maxr - minr + 1) * Rnd + minr)
                minx = .BallR
                maxx = wid - .BallR
                miny = .BallR
                maxy = hgt - .BallR
                .BallX = Int((maxx - minx + 1) * Rnd + minx)
                .BallY = Int((maxy - miny + 1) * Rnd + miny)
                .BallVx = Int((maxvx - minvx + 1) * Rnd + minvx)
                .BallVy = Int((maxvy - minvy + 1) * Rnd + minvy)
                If Int(2 * Rnd) = 1 Then .BallVx = -.BallVx
                If Int(2 * Rnd) = 1 Then .BallVy = -.BallVy
            End With
        Next i
    End If
    '控制小球运动的Timer控件可用
    frmCover.tmrMoveBalls.Enabled = (NumBalls > 0)
End Sub


'保存屏保设置信息到注册表，SaveSetting函数的使用方法详见“使用历史记录的例子”
Public Sub SaveConfig()
    SaveSetting APP_NAME, "Settings", "NumBalls", Format$(NumBalls)
End Sub

'开始程序
Public Sub Main()
Dim args As String
Dim preview_hwnd As Long
Dim preview_rect As RECT
Dim window_style As Long

    '得到命令行参数，类似于TC2.0中的同类内容
    '返回命令行的参数部分，该命令行用于装入Visual Basic开发的可执行程序。
    '说明:当从命令行装入 Visual Basic 时，/cmd 之后的命令行的任何部分作为命令行的参数传递给程序。
    args = UCase$(Trim$(Command$))

    '检测命令行
    Select Case Mid$(args, 1, 2)
        Case "/C"        '如果命令行是“scrsaver/c”运行模式为-设置屏保参数
            RunMode = rmConfigure
        Case "", "/S"    '如果命令行是“scrsaver/s”运行模式为-屏保
            RunMode = rmScreenSaver
        Case "/P"        '如果命令行是“scrsaver/p”运行模式为-预览
            RunMode = rmPreview
        Case Else        '如果是其他形式，运行模式为-屏保
            RunMode = rmScreenSaver
    End Select

    '在不同的运行模式下运行
    Select Case RunMode
        Case rmConfigure    '显示“自制屏保-设置”对话框
            frmConfig.Show
        
        Case rmScreenSaver  '运行屏保
            '检验是否有其他实例运行
            CheckShouldRun

            Load frmCover
            frmCover.Show
            
            '鼠标设置为不可见
            ShowCursor False

        Case rmPreview      '运行于预览模式，以下代码看不懂，不懂装懂吧
            '得到预览区域的窗口句柄
            preview_hwnd = GetHwndFromCommand(args)

            '返回指定窗口客户区矩形的大小
            GetClientRect preview_hwnd, preview_rect

            Load frmCover

            '将窗体的Caption属性设为"Preview"
            frmCover.Caption = "Preview"

            '得到frmCover窗体的信息
            window_style = GetWindowLong(frmCover.hwnd, GWL_STYLE)

            '将预览模式下的frmCover窗体style设为 子窗体 ？
            window_style = (window_style Or WS_CHILD)

            '重设frmCover窗体style为 window_style
            SetWindowLong frmCover.hwnd, GWL_STYLE, window_style

            '不懂 Set the window's parent so it appears
            ' inside the preview area.
            SetParent frmCover.hwnd, preview_hwnd

            '不懂 Save the preview area's hWnd in
            ' the form's window structure.
            SetWindowLong frmCover.hwnd, _
                GWL_HWNDPARENT, preview_hwnd

            '不懂 Show the preview.
            SetWindowPos frmCover.hwnd, _
                HWND_TOP, 0&, 0&, _
                preview_rect.Right, _
                preview_rect.Bottom, _
                SWP_NOZORDER Or SWP_NOACTIVATE Or _
                    SWP_SHOWWINDOW
    End Select
End Sub

'从命令行参数中得到预览窗体句柄的函数
Private Function GetHwndFromCommand(ByVal args As String) As Long
Dim argslen As Integer
Dim i As Integer
Dim ch As String

    '取得命令行的最右字符
    args = Trim$(args)
    argslen = Len(args)
    For i = argslen To 1 Step -1
        ch = Mid$(args, i, 1)
        If ch < "0" Or ch > "9" Then Exit For
    Next i

    GetHwndFromCommand = CLng(Mid$(args, i + 1))
End Function

'------------------------------------------
'       是不是给此屏保程序加上密码呢？
'               看你的了！
'------------------------------------------