form2.frm

OpenPlayer代码

End Sub

'质量
Private Sub FF1_Click()
    FF1.Checked = True
    FF2.Checked = False
    FF3.Checked = False
    Form1.ShockwaveFlash1.Quality = 0
End Sub
Private Sub FF2_Click()
    FF1.Checked = False
    FF2.Checked = True
    FF3.Checked = False
    Form1.ShockwaveFlash1.Quality = 2
End Sub
Private Sub FF3_Click()
  FF1.Checked = False
  FF2.Checked = False
  FF3.Checked = True
  Form1.ShockwaveFlash1.Quality = 1
End Sub

Sub ShowChr()
'显示立体字
    Dim i As Integer
    Dim oControl As Object
    Dim Author As String
   
    For i = 1 To 30
        Set oControl = Controls.Add("VB.label", "RL" & i)
        With oControl
            .AutoSize = True
            .BackStyle = 0
            .FontSize = "15"
            .FontBold = True
            .Left = 1700 + i * 7
            .Top = 200 + i * 7
            .ForeColor = RGB(255 - i * 8, 255 - i * 8, 255 - i * 3) '交换R、G、B各值位置会有不同效果
            '不要修改!!!!!!!!!!!!!!
            .Caption = "献 给 我 最 爱 的 小 鱼 儿"
            .Visible = True
            DoEvents
        End With
    Next
                
    For i = 1 To 30
        Set oControl = Controls.Add("VB.label", "RLL" & i)
        With oControl
            .Left = 500 + i * 7
            .Top = 600 + i * 7
            .ForeColor = RGB(255 - (5 * i / 2) - 10, 255 - (5 * i / 2) - 10, 255 + i - 10)  '交换R、G、B各值位置会有不同效果
            .AutoSize = True
            .BackStyle = 0
            .FontSize = "29"
            .FontBold = True
            .Caption = "ＳimpleＰlayer Ver 1.0"
            .Visible = True
            DoEvents
        End With
    Next
    If Form1.ShockwaveFlash1.Movie <> "" Then
        Author = getNote(Form1.ShockwaveFlash1.Movie).strAuthor
    Else
        Author = getNote(Filename).strAuthor
    End If
    For i = 1 To 30 Step 2
        Set oControl = Controls.Add("VB.label", "RLLL" & i)
        With oControl
            .AutoSize = True
            .BackStyle = 0
            .FontSize = "14"
            .FontBold = True
            .ForeColor = RGB(i * 4, 255 - i * 8, 255 - i * 6)   '交换R、G、B各值位置会有不同效果
            .Caption = "Flash作者：" & Author
            .Visible = True
            .Top = 1650 + i * 7
            .Left = (Me.Width - .Width) / 2 + i * 7
            DoEvents
        End With
    Next
    
    For i = 1 To 30 Step 2
        Set oControl = Controls.Add("VB.label", "RLLLL" & i)
        With oControl
            .AutoSize = True
            .BackStyle = 0
            .FontSize = "12"
            .FontBold = True
            .Left = 900 + i * 7
            .Top = 2200 + i * 7
            .ForeColor = RGB(255 - i * 8, 255 - i * 8, 255 - i * 3) '交换R、G、B各值位置会有不同效果
            .Caption = "(c)Copyright 2001,2002  小鱼儿工作室  余泽涛 "
            .Visible = True
            DoEvents
        End With
    Next
         
End Sub

Private Sub Form_Load()
    SetWindowPos Me.hWnd, -1, 0, 0, 0, 0, 3
    If isShowed = False Then
        ShowChr
        isShowed = True
    End If
    MakeNoBorderForm Me                         '去除窗口边框
End Sub


Private Sub Form_LostFocus()
    Me.Visible = False                          '隐藏,不能Unload!菜单还要用到
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.Visible = False                          '隐藏,不能Unload!菜单还要用到
End Sub

Private Sub Form_Unload(Cancel As Integer)
    isShowed = False
End Sub

Private Sub FullScreen_Click()
'全屏控制,
    If isFullScreen = False Then
        isFullScreen = True
        With Form1
            .Left = 0
            .Top = 0
            .Height = Screen.Height
            .Width = Screen.Width
            .ShockwaveFlash1.Height = Screen.Height - 150
            .ShockwaveFlash1.Width = Screen.Width - 150
        End With
    Else
        isFullScreen = False
         With Form1
            .Height = MHeight * 15 + 150
            .Width = MWidth * 15 + 150
            .ShockwaveFlash1.Height = MHeight * 15
            .ShockwaveFlash1.Width = MWidth * 15
            .Left = (Screen.Width - .Width) / 2
            .Top = (Screen.Height - .Height) / 2
         End With
    End If
    Form1.DrawBorder
End Sub

Private Sub Label1_Click()
      ShellExecute 0, "open", "http://OpenPlayer.51.net", 0, 0, 1
End Sub

Private Sub Loop1_Click()
    If Loop1.Checked Then
       Loop1.Checked = False
       Form1.ShockwaveFlash1.Loop = False
    Else
       Loop1.Checked = True
       Form1.ShockwaveFlash1.Loop = True
    End If
End Sub


Private Sub Mail_Click()
     ShellExecute 0, "open", "mailto:[e-mail]?subject=余泽涛，你好--" & Date, 0, 0, 1
End Sub

Private Sub MEnabelMove_Click()
    MEnabelMove1.Checked = Not MEnabelMove1.Checked
    MEnabelMove.Checked = Not MEnabelMove.Checked
End Sub

Private Sub MEnabelMove1_Click()
    MEnabelMove1.Checked = Not MEnabelMove1.Checked
    MEnabelMove.Checked = Not MEnabelMove.Checked
End Sub

Private Sub ontop_Click()
'总在最前面
    If Not onTop.Checked Then
        SetWindowPos Form1.hWnd, -1, 0, 0, 0, 0, 3   '设置
        onTop.Checked = True
    Else
        onTop.Checked = False
        SetWindowPos Form1.hWnd, -2, 0, 0, 0, 0, 3   '取消
    End If
End Sub

Private Sub Open_Click()
'找开播放文件
    On Error Resume Next
    Dim swfFileName As String
    
    swfFileName = ShowOpenDialog(Me, "Flash Movie", "*.swf;*.spl", "打开...")
    If swfFileName <> "" Then
        Form1.OpenFlash (swfFileName)
        If bEXE And UCase(Right(Filename, 4)) <> ".SWF" Then
            If fso.FileExists(Filename) Then
                fso.DeleteFile (Filename)
            End If
        End If
        bEXE = False
    End If
    ReturnPlay.Visible = True
End Sub

Private Sub play_Click()
'播放/停止
    If Form1.ShockwaveFlash1.Playing = True Then
       Form1.ShockwaveFlash1.Playing = False
       play.Caption = "播放(&P)"
    Else
       Form1.ShockwaveFlash1.play
       play.Caption = "停止(&S)"
    End If
End Sub

Private Sub ReturnPlay_Click()
    ReturnPlay.Visible = False
    bEXE = True
    Call Form1.Form_Load
End Sub

Private Sub Rewind_Click()
'重置
   Form1.ShockwaveFlash1.Rewind
End Sub

Private Sub ShowAll_Click()
'显示全部
   Zoom = 0
   Form1.ShockwaveFlash1.Zoom (0)
End Sub

Private Sub stopplay_Click()
'停止播放
   Form1.ShockwaveFlash1.Stop
End Sub

Private Sub SuperPlayer_Click()
    Dim OPEXE As String
    
    OPEXE = App.Path & IIf(Len(App.Path) < 4, "OpenPlayer.exe", "\OpenPlayer.exe")
    Shell OPEXE, vbNormalFocus
End Sub

Private Sub Timer1_Timer()
'结束程序
  UnHook
  On Error Resume Next
  If bEXE And UCase(Right(Filename, 4)) <> ".SWF" Then
     If fso.FileExists(Filename) Then
         fso.DeleteFile (Filename)
     End If
  End If
  Set fso = Nothing
  TerminateProcess GetCurrentProcessId, 0
  End
End Sub

Private Sub ZoomIn_Click()
'放大
    Zoom = Zoom + 1
    Form1.ShockwaveFlash1.Zoom (50)
End Sub

Private Sub ZoomOut_Click()
'缩小
    Zoom = Zoom - 1
    Form1.ShockwaveFlash1.Zoom (200)
End Sub

Public Sub MakeNoBorderForm(frm As Form)
    Dim rctClient As RECT, rctFrame As RECT
    Dim hRgn As Long
    Dim lRes As Long
    ReDim XY(3) As POINTAPI
    
    '获得窗口矩形区域
    
    '将窗口矩形坐标转换为屏幕坐标
    Dim lpTL As POINTAPI, lpBR As POINTAPI
    lpTL.X = frm.Left / 15
    lpTL.Y = frm.Top / 15
    ScreenToClient frm.hWnd, lpTL
    rctClient.Left = Abs(lpTL.X)
    rctClient.Top = Abs(lpTL.Y)
    
    frm.ScaleMode = 1 'Twip
    
    rctClient.Right = frm.ScaleWidth / 15 + Abs(lpTL.X)
    rctClient.Bottom = frm.ScaleHeight / 15 + Abs(lpTL.Y)
    
    
    '建立要切割的数组
    XY(0).X = rctClient.Left
    XY(0).Y = rctClient.Top
    XY(1).X = rctClient.Right
    XY(1).Y = rctClient.Top
    XY(2).X = rctClient.Right
    XY(2).Y = rctClient.Bottom
    XY(3).X = rctClient.Left
    XY(3).Y = rctClient.Bottom
    
    LeftPos = rctClient.Left * 15
    TopPos = rctClient.Top * 15
   
    
    hRgn = CreatePolygonRgn(XY(0), 4, 2)
    lRes = SetWindowRgn(frm.hWnd, hRgn, True)
End Sub