form1.frm

OpenPlayer代码

VERSION 5.00
Object = "{D27CDB6B-AE6D-11CF-96B8-444553540000}#1.0#0"; "SWFLASH.OCX"
Begin VB.Form Form1 
   BackColor       =   &H80000007&
   BorderStyle     =   0  'None
   Caption         =   "SuperScreenSaver1.0"
   ClientHeight    =   2040
   ClientLeft      =   4740
   ClientTop       =   1800
   ClientWidth     =   4290
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   2040
   ScaleWidth      =   4290
   ShowInTaskbar   =   0   'False
   Visible         =   0   'False
   Begin VB.Timer PlayTimer 
      Interval        =   2000
      Left            =   1500
      Top             =   990
   End
   Begin VB.Frame Loading 
      BackColor       =   &H00FF0000&
      BorderStyle     =   0  'None
      ForeColor       =   &H00FF0000&
      Height          =   375
      Left            =   180
      TabIndex        =   1
      Top             =   450
      Width           =   3045
      Begin VB.Label Title 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "Loading..."
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   14.25
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H000000FF&
         Height          =   285
         Left            =   60
         TabIndex        =   2
         Top             =   60
         Width           =   1665
      End
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   1
      Left            =   690
      Top             =   1020
   End
   Begin ShockwaveFlashObjectsCtl.ShockwaveFlash ShockwaveFlash1 
      CausesValidation=   0   'False
      Height          =   615
      Left            =   180
      TabIndex        =   0
      Top             =   60
      Width           =   1395
      _cx             =   4196765
      _cy             =   4195389
      Movie           =   ""
      Src             =   ""
      WMode           =   "Window"
      Play            =   -1  'True
      Loop            =   -1  'True
      Quality         =   "High"
      SAlign          =   ""
      Menu            =   -1  'True
      Base            =   ""
      Scale           =   "ShowAll"
      DeviceFont      =   0   'False
      EmbedMovie      =   0   'False
      BGColor         =   ""
      SWRemote        =   ""
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim isHook As Boolean                           '是否已经设置回调
Dim hFlashhwnd1 As Long                         'Shockwaveflash的Hwnd
Dim strIniFile As String                        'ini文件的路径
Dim mScale As String                            '动画播放时的大小模式
Dim strHeight As String                         '动画播放时的大-高
Dim strWidth As String                          '动画播放时的大-宽
Dim fColor As String                            'Flash背景色
Dim mColor As String                            '窗口背景色
Dim TimerEnable As String
Dim Interval As String
Dim fTitle As String                            '显示的标题

Sub init()
'读取ini文件
On Error Resume Next
   mScale = myReadINI(strIniFile, "SuperScreenSaver Config", "mScale", "Defult")
   strHeight = myReadINI(strIniFile, "SuperScreenSaver Config", "mHeight", "300")
   strWidth = myReadINI(strIniFile, "SuperScreenSaver Config", "mWidth", "400")
   fColor = myReadINI(strIniFile, "SuperScreenSaver Config", "fColor", "Defult")
   mColor = myReadINI(strIniFile, "SuperScreenSaver Config", "mColor", "Defult")
   Interval = myReadINI(strIniFile, "SuperScreenSaver Config", "Interval", "2000")
   fTitle = myReadINI(strIniFile, "SuperScreenSaver Config", "TitleText", "SuperScreenSaver 1.0 (C) 小鱼儿工作室 2002 ")
End Sub

Sub FixScr()
'====================================================
'设置窗口
'====================================================
    Dim fh As FlashHeader
    fh = getFlashHeader(Filename)
    
    Me.Show
    '如果文件太大的话,分离出来要一定的时间,在这里先显示一个Loading,在窗口的中心
    Loading.Left = (Me.Width - Loading.Width) / 2
    Loading.Top = (Me.Height - Loading.Height) / 2

    '读取ini内容
    Call init
    
    With ShockwaveFlash1
        '颜色
        If mColor = "DEFULT" Then
            .BackgroundColor = RGB(fh.bColorB, fh.bColorG, fh.bColorR)
        Else
            .BackgroundColor = &H0
        End If
        '大小
        If mScale = "DEFULT" Then
            .Height = fh.lMHeight * 15
            .Width = fh.lMWidth * 15
        Else
            If mScale = "FULLSCREEN" Then
                .Height = Screen.Height
                .Width = Screen.Width
            Else
                .Height = CLng(strHeight) * 15
                .Width = CLng(strWidth) * 15
            End If
        End If
        '位置
        .Top = (Screen.Height - .Height) / 2
        .Left = (Screen.Width - .Width) / 2
    End With
  
    '窗口颜色
    If fColor = "USERDEFUL" Then
        Me.BackColor = RGB(fh.bColorR, fh.bColorG, fh.bColorB)
    Else
        Me.BackColor = &H0
    End If

End Sub

Private Sub Form_Load()
    On Error Resume Next
    Dim fExeFileName As String

    Me.Visible = True
    Me.Move 0, 0, Screen.Width, Screen.Height       '全屏显示
    ShowCursor False                                '隐藏鼠标

    '取得ini文件名
    strIniFile = App.Path & IIf(Len(App.Path) < 4, App.EXEName & ".ini", "\" & App.EXEName & ".ini")
    '取得屏幕保护程序的文件名
    fExeFileName = App.Path & IIf(Len(App.Path) < 4, App.EXEName & ".scr", "\" & App.EXEName & ".scr")
    '分离出swf 文件
    Filename = exe2swf(fExeFileName)
    
    '如果返回的文件名小于4(一个正确的文件名至少要四个如E:\4)
    If Len(Filename) < 4 Then
           ShowCursor True
           Me.Visible = False
           MsgBox "  文件已经被破坏！    " & vbCrLf, vbOKOnly + vbCritical, "SuperPlayer 1.0 小鱼儿工作室"
           Call EndSaver
    End If

    Call FixScr



    'Hook鼠标事件
    hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, 0)


    ShockwaveFlash1.Visible = True
    ShockwaveFlash1.Movie = Filename
    ShockwaveFlash1.Play
    Loading.Top = Me.Height - Loading.Height            '把Loading移到最下面,并作为Title
    Title.Caption = fTitle                              '显示标题
    Loading.BackColor = &H0                             '背景色为黑色
    Title.ForeColor = &HFFFFFF                          '前景色为白色
    Loading.Width = Title.Left + Title.Width            '宽
    Loading.Left = (Me.Width - Loading.Width) / 2       '横位置

 
    '设置PlayTimer
    If IsNumeric(Interval) Then PlayTimer.Interval = CInt(Interval)
    
    '隐藏鼠标
    ShowCursor False
    
    '取得并保存鼠标位置,
    GetCursorPos mouse
    oldX = mouse.X
    oldY = mouse.Y

    beEnd = False
    Timer1.Enabled = True
End Sub


Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    beEnd = True
End Sub

Private Sub PlayTimer_Timer()
   '防止因用Action而使动画停止播放
   ShockwaveFlash1.Play
End Sub

Private Sub Timer1_Timer()
    '取得鼠标的位置并与旧位置比较
    Dim l As Long
    GetCursorPos mouse
    If Abs(oldX - mouse.X) > 2 Or Abs(oldY - mouse.Y) > 2 Or beEnd Then
        '发生变化时,退出
        Call ExitSaver
    End If
End Sub

Sub ExitSaver()
    Dim PW As String
    Dim ValueType As Long
    
    ShowCursor True
    '退出时,是否要密码?写在注册表中
    PW = Query_Reg_Value("Control Panel\desktop", "ScreenSaveUsePassword", ValueType)
    
    If Asc(PW) = 1 Then
       Timer1.Enabled = False
       Form5.Show 1
    Else
       Call EndSaver
    End If
End Sub