from.frm

OpenPlayer代码

            DoEvents
        Next
   End If
End Sub

Private Sub FileTimer_Timer()
'为防止程序的多重启动,当程序启动时,发现自已已经运行,就把要打开的文件名(如果有)写放
'OpenPlayer.ini|[OpenFile]|FileName=
'里面,这个Timer就是检测ini文件的FileName是否改变,如果改变,就播放这个文件,这样,就可以防止程序多重启动
Dim iniFile As String                                   'ini文件的文件名,为程序安装路径+OpenPlayer.ini
Dim File2Open As String                                 '存放ini文件FileName的值
    '取得ini文件名
    iniFile = App.Path & IIf(Len(App.Path) > 4, "/OpenPlayer.ini", "OpenPlayer.ini")
    
    File2Open = UCase(myReadINI(iniFile, "OpenFile", "FileName", ""))       '取得FileName的值,并转为大写,默认返回值为空
    'File2Open = Left(Trim(File2Open), Len(Trim(File2Open)) - 1)             '去除所有空格
   
    If Len(File2Open) > 3 Then
        Play.OpenFlash (File2Open)                          '播放文件
        '下面快播放区和控制台显示在前面
        Me.WindowState = 0
        SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3             '设置最前面
        SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3             '取消
        If Play.ShockwaveFlash1.Movie <> "" Then
            Play.WindowState = 0
            SetWindowPos Play.hwnd, -1, 0, 0, 0, 0, 3       '设置
            SetWindowPos Play.hwnd, -2, 0, 0, 0, 0, 3       '取消
        End If
        myWriteINI iniFile, "OpenFile", "FileName", ""      '清空ini文件中[FileName]项,这下次准备
    End If
End Sub

Private Sub Form_Initialize()
       
     '设置键盘钩子
    hHook = SetWindowsHookEx(WH_KEYBOARD, AddressOf KeyboardProc, App.hInstance, 0)
    KeyUpDownEnable = True
    
    Me.Show
    
    '===============================
    '设置托盘图标
    '===============================
    '设置TrayIcon的cbSixe的长度
     TrayIcon.cbSize = Len(TrayIcon)
     TrayIcon.hwnd = Me.hwnd
     TrayIcon.uId = vbNull
     TrayIcon.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
     '设置回调的信息
     TrayIcon.ucallbackMessage = WM_MOUSEMOVE
     '设置图标
     TrayIcon.hIcon = Me.Icon
     '设置ToolTipText
     TrayIcon.szTip = "OpenPlayer" & Chr$(0)
     Call Shell_NotifyIcon(NIM_ADD, TrayIcon)
     
     Call initFavorites                  '初始化[收藏夹]列表
     
     StatusFrame.BackColor = &HFFFFFF
    
End Sub

Private Sub Form_Load()
    MakeNoBorderForm Me                 '切除Form的边框
    Th = Hour(Time())                   '时间
    Tm = Minute(Time())
    Ts = Second(Time())
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static Message As Long
    
    'x is the current mouse location along the x-axis
    Message = X / Screen.TwipsPerPixelX
        Select Case Message
            '左键单击
            Case t_WM_LBUTTONUP
                Me.Visible = True
                Me.WindowState = 0
                SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3             '设置
                SetWindowPos Me.hwnd, -2, 0, 0, 0, 0, 3             '取消
                If Play.ShockwaveFlash1.Movie <> "" Then
                    Play.WindowState = 0
                    SetWindowPos Play.hwnd, -1, 0, 0, 0, 0, 3       '设置
                    SetWindowPos Play.hwnd, -2, 0, 0, 0, 0, 3       '取消
                End If
            
            '右键(单击)弹起
            Case t_WM_RBUTTONUP
                '初始化系统托盘菜单
                Me.Visible = True
                If Play.ShockwaveFlash1.Playing Then
                    stopplay.Caption = "停止(&S)"
                Else
                    stopplay.Caption = "播放(&P)"
                End If
                PopupMenu TrayPopup                                 '弹出系统托盘菜单
        End Select

End Sub

Private Sub Form_Unload(Cancel As Integer)

    Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)     '删除系统托盘图标
    UnHook                                          '卸下鼠标(Swflash.ocx)钩子
    running = True                                  '?
    If hHook Then
    Call UnhookWindowsHookEx(hHook)             '卸下键盘钩子
        hHook = 0
    End If
    End                                             '结束程序
    
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
     
    hRgn = CreatePolygonRgn(XY(0), 4, 2)
    lRes = SetWindowRgn(frm.hwnd, hRgn, True)
    
End Sub



Private Sub FrameNumberLabel_Click()
    '显示当前帧数
End Sub

Private Sub html_Click()
'显示生成HTML代码的窗口
    SetWindowPos Play.hwnd, -2, 0, 0, 0, 0, 3     '取消
    SetWindowPos ControlForm.hwnd, -2, 0, 0, 0, 0, 3   '取消
    FormHTML.Show 1
End Sub

Private Sub Image1_Click(Index As Integer)
    '列表窗口的标题栏
End Sub

Public Sub ImgSearch_Click()
'搜索
    Call ListButton_Click(2)                        '显示搜索列表框
    SearchFile (List(4).hwnd)                       '搜索文件并添加到搜索列表框
    
End Sub

Private Sub Label2_Click(Index As Integer)
    '属性窗口的标题栏
End Sub

Private Sub ProgressTimer_Timer()
Dim dPercent  As Double                                     '百分比
Dim X As Long                                               '线Line用的X坐标的一个量
Dim strPercentStr As String                                         '要在进度条上显示的文字

    If Play.ShockwaveFlash1.Movie <> "" Then                '有动画正在播放,
        If TotalFrames = 1 Then TotalFrames = 2             '如果帧数为一个,设为2,否则,出错!
        
        '进度条的设置|位置,颜色
        dPercent = Play.ShockwaveFlash1.FrameNum / (TotalFrames - 1)
        ProgressFlagLabel.Left = 300 + 2000 * dPercent
        X = ProgressFlagLabel.Left - ProgressEventLabel.Left + ProgressFlagLabel.Width / 2
        Line2(0).BorderColor = RGB(255, (255 - X / 9), 100)
        Line2(1).X1 = Line2(0).X1 + X
        Line2(0).X2 = Line2(0).X1 + X
       
        FrameNumberLabel.Left = BlackLabel.Left + BlackLabel.Width - FrameNumberLabel.Width - 30            '调整当前帧Label的位置
        FrameNumberLabel.Caption = "第" & Play.ShockwaveFlash1.FrameNum + 1 & "帧 "                         '显示当前帧数
     
        '如果长度小于5,则在后面加空格,否则菜单的大小会动,可能无法显示
        strPercentStr = Round(dPercent * 100, 1) & "%"
        If Len(strPercentStr) < 5 Then strPercentStr = strPercentStr & " "
        If Len(strPercentStr) < 5 Then strPercentStr = strPercentStr & " "
        If Len(strPercentStr) < 5 Then strPercentStr = strPercentStr & " "
     
        FrameNumberLabel.ToolTipText = "完成：" & strPercentStr                                             '当前帧Label的ToolTipText
        jd.Caption = "进度：" & strPercentStr                                                               '在播放窗口的菜单上显示进度
        ControlForm.played.Caption = "完成:" & strPercentStr & "播放到第:" & (Play.ShockwaveFlash1.FrameNum + 1) & "帧"      '在播放窗口的菜单上显示进度
    End If
    
End Sub



Private Sub Label4_Click()
    '显示快进/慢进的设置对话框
    FormSpeed.Show
End Sub



Private Sub List_DblClick(Index As Integer)
'列表框由6个ListBox组成,其中
'List(0)/播放列表,List(1)[收藏夹],List(2)[搜索列表]  用来显示,用于存放文件名
'List(3),List(4),List(5)作为后台,用于存相对应文件名的路径

    If List(Index).ListIndex > -1 Then
    '双击列表框 播放被选中的文件
           Play.ShockwaveFlash1.Stop                                        '停止当前播放的文件
           Play.OpenFlash (List(Index + 1).List(List(Index).ListIndex))     '播放被选中的文件
           Play.ShockwaveFlash1.Play                                        '播放
           ControlForm.SpeedTimer.Enabled = False                                '关闭快进/慢进定时器
           
           '如果不是播放列表框,则在播放列表框中添加选中项
           'If Index > 0 Then
           '     List(0).AddItem ("[" & List(0).ListCount + 1 & "]" & Right(List(Index).List(List(Index).ListIndex), Len(List(Index).List(List(Index).ListIndex)) - InStr(List(Index).List(List(Index).ListIndex), "]")))
           '     List(1).AddItem (List(Index + 1).List(List(Index).ListIndex))
           'End If
    End If
End Sub


Private Sub List_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    '93为菜单键的KeyCode,显示菜单
    If KeyCode = 93 Then
        Call List_MouseUp(Index, 2, 0, 100, 100)
    End If
    If KeyCode = 13 Then
        List_DblClick (Index)
    End If
End Sub



Private Sub List_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lXPoint As Long
    Dim lYPoint As Long
    Dim lIndex As Long
    '
    If List(Index).ListIndex > -1 Then  ' 如果没有按钮被按下
        lXPoint = CLng(X / Screen.TwipsPerPixelX)
        lYPoint = CLng(Y / Screen.TwipsPerPixelY)
        With List(Index)
            ' 获得当前的光标所在的的屏幕位置确定标题位置
            lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ((lYPoint * 65536) + lXPoint))
            ' 显示提示行或清除提示行
            If (lIndex >= 0) And (lIndex <= .ListCount) Then
               .ListIndex = lIndex
            End If
        End With
    End If
End Sub

Private Sub List_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'使ListBox每一项都有一个ToolTip
Dim lXPoint As Long
Dim lYPoint As Long
Dim lIndex As Long

    If List(Index).ListIndex > -1 Then  ' 如果没有按钮被按下
        lXPoint = CLng(X / Screen.TwipsPerPixelX)
        lYPoint = CLng(Y / Screen.TwipsPerPixelY)
        With List(Index)
            ' 获得当前的光标所在的的屏幕位置确定标题位置
            lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ((lYPoint * 65536) + lXPoint))
            ' 显示提示行或清除提示行
            If (lIndex >= 0) And (lIndex <= .ListCount) Then
                .ToolTipText = List(Index + 1).List(lIndex)
            Else
                .ToolTipText = ""
            End If
        End With
    End If
    
End Sub

Private Sub List_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '列表框上鼠标右键,弹出菜单
    If Button = 2 Then
        Select Case Index
            Case 0                                  '播放列表框
                 Call PopUpPlayMenu(1)
            Case 2                                  '收藏夹
                 PopupMenu FavoritesPopup
            Case 4                                  '搜索列表
                 If List(4).ListIndex > -1 Then
                 '初始化
                     MSAdd2Fav.Enabled = True
                     MSMovieInfo.Enabled = True
                     MSPlay.Enabled = True
                     MSSearch.Caption = "重新搜索(&S)"
                 Else
                     MSAdd2Fav.Enabled = False
                     MSMovieInfo.Enabled = False
                     MSPlay.Enabled = False
                 End If
                 PopupMenu SearchPopup
         End Select
    End If
       
End Sub

Private Sub ListButton_Click(Index As Integer)
    '设置按钮的颜色,全部先设为白色,然后再设置被单击的按钮的颜色为黑色
    For i = 0 To 2
       ListButton(i).BackColor = &HFFFFFF
       ListButton(i).ForeColor = &H0
       List(i * 2).Visible = False
    Next
  
  ListButton(Index).BackColor = &H0
  ListButton(Index).ForeColor = &HFFFFFF
  List(Index * 2).Visible = True                    '切换(显示)列表框
  
  StatusFrame.Visible = False                       '隐藏搜索状态栏
  
  Select Case Index
         Case 0
              Label2(1).Caption = "播放列表"
         Case 1
              Label2(1).Caption = "收藏夹"
         Case 2
              Label2(1).Caption = "搜索列表"
              If running Then                       '如果正在搜索,
                    StatusFrame.Visible = True      '显示搜索状态
              End If
  End Select
End Sub

Private Sub ListButton_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '右键菜单
    If Button = 2 Then
        Select Case Index
            Case 0
               Call ListButton_Click(Index)
               PopUpPlayMenu (0)
            Case 1
            Case 2
         End Select
     End If
End Sub

Private Sub MCMouseDownMoveForm_Click()
    '显示/去除 [当鼠标按下时移动窗口]的菜单项前面的"√"
    MCMouseDownMoveForm.Checked = Not MCMouseDownMoveForm.Checked
    MMouseDownMoveForm.Checked = Not MMouseDownMoveForm.Checked
End Sub

Private Sub meexit_Click()
    '结束程序
    Call MFormQuit_Click
End Sub

Private Sub MFavDelAll_Click()
'删除收藏夹中所有的项
Dim lFileNum As Long
Dim strFileName As String

    If MsgBox("相真的要删除Flash收藏夹的所有内容吗？", vbYesNo + vbQuestion, "全部删除...") = vbYes Then
        List(2).Clear                                       '清除列表框
        List(3).Clear