saver03.frm

一套经典的asp教程 本人受益颇多 特推荐之 直接解压无密码

VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00000000&
   BorderStyle     =   0  'None
   ClientHeight    =   3195
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   Begin VB.Timer Timer1 
      Interval        =   10
      Left            =   1560
      Top             =   2280
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "欢迎使用大嘴巴的电脑！"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   24
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   495
      Left            =   1440
      TabIndex        =   0
      Top             =   1680
      Width           =   5280
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Const WS_CHILD = &H40000000
Const GWL_HWNDPARENT = (-8)
Const GWL_STYLE = (-16)
Const HWND_TOPMOST = -1&
Const HWND_TOP = 0&
Const HWND_BOTTOM = 1&

Const SWP_NOSIZE = &H1&
Const SWP_NOMOVE = &H2
Const SWP_NOZORDER = &H4
Const SWP_NOREDRAW = &H8
Const SWP_NOACTIVATE = &H10
Const SWP_FRAMECHANGED = &H20
Const SWP_SHOWWINDOW = &H40
Const SWP_HIDEWINDOW = &H80
Const SWP_NOCOPYBITS = &H100
Const SWP_NOOWNERZORDER = &H200
Const SWP_DRAWFRAME = SWP_FRAMECHANGED
Const SWP_NOREPOSITION = SWP_NOOWNERZORDER

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Private Declare Sub 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)

Dim X0 As Single, Y0 As Single ' 用来记录鼠标的位置

Private Sub Form_Load()
    If UCase(Left(Command, 2)) = "/A" Then   ' 密码设置
        MsgBox "此一屏幕保护程序未提供“密码保护”功能!"
        Unload Me: End
    End If
    
    If UCase(Left(Command, 2)) = "/C" Then ' 设置值
        Form2.Show vbModal
        Unload Me: End
    End If
        
    If UCase(Left(Command, 2)) = "/P" Then ' 小屏幕
        Dim hwndDsp As Long
        Dim r As RECT
        
        hwndDsp = Val(Mid(Command, 3))
        GetClientRect hwndDsp, r
        Me.Caption = "Preview"
        Style = GetWindowLong(Me.hwnd, GWL_STYLE)
        Style = Style Or WS_CHILD
        SetWindowLong Me.hwnd, GWL_STYLE, Style
        
        SetParent Me.hwnd, hwndDsp
        SetWindowLong Me.hwnd, GWL_HWNDPARENT, hwndDsp
        SetWindowPos Me.hwnd, HWND_TOP, 0&, 0&, r.Right, r.Bottom, SWP_NOZORDER Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
    End If
    
    If App.PrevInstance Then    ' 已经在执行中
        Unload Me: End
    End If
        
    ' 读取系统登录区的设置值，然后设置给 Label1
    Label1.Caption = GetSetting("saver03", "saver03", "Content", "欢迎使用大嘴巴的电脑！")
    Label1.Font.Name = GetSetting("saver03", "saver03", "FontName", "细明体")
    Label1.Font.Size = GetSetting("saver03", "saver03", "FontSize", 12)
    Label1.Font.Bold = GetSetting("saver03", "saver03", "Bold", 0)
    Label1.Font.Italic = GetSetting("saver03", "saver03", "Italic", 0)
    Label1.Font.Underline = GetSetting("saver03", "saver03", "Underline", 0)
    Label1.Font.Strikethrough = GetSetting("saver03", "saver03", "StrikeThrough", 0)
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    ' 第一次发生鼠标事件时，将位置记录于 (X0,Y0)
    If X0 = 0 And Y0 = 0 Then X0 = x: Y0 = y
    
    ' 如果鼠标位置改变，就载出窗体
    If x <> X0 Or y <> y Then Unload Me: End
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Unload Me: End   ' 载出窗体
End Sub

Private Sub Form_Resize()
    ' 将文字的位置设置于表右边界的中央位置
    Label1.Left = Form1.ScaleWidth
    Label1.Top = (Form1.ScaleHeight - Label1.Height) / 2
End Sub

Private Sub Label1_Click()

End Sub

Private Sub Timer1_Timer()
    ' 左移文字宽度的 1/20
    Label1.Left = Label1.Left - Label1.Width / 20
    
    If Label1.Left + Label1.Width < 0 Then  ' 如果超过左边界
        Label1.Left = Form1.ScaleWidth      ' 移到右边界
    End If
End Sub