from.frm

OpenPlayer代码

            Caption         =   "低(&L)"
         End
         Begin VB.Menu FF2 
            Caption         =   "媒体(&M)"
         End
         Begin VB.Menu FF3 
            Caption         =   "高(&H)"
            Checked         =   -1  'True
         End
      End
      Begin VB.Menu s2 
         Caption         =   "-"
      End
      Begin VB.Menu file 
         Caption         =   "文件"
         Begin VB.Menu F5 
            Caption         =   "打开(&O)..."
         End
         Begin VB.Menu copyto 
            Caption         =   "另存为(&S)..."
         End
         Begin VB.Menu CreateExe 
            Caption         =   "编译为程序(&E)..."
         End
         Begin VB.Menu html 
            Caption         =   "生成HTML文件(&H)..."
         End
         Begin VB.Menu WallPaper 
            Caption         =   "当前帧设为墙纸(&W)..."
         End
         Begin VB.Menu MFSavePic 
            Caption         =   "当前帧另存为位图(&P)..."
         End
         Begin VB.Menu ScreenSaver 
            Caption         =   "编译成屏幕保护程序(&V)..."
         End
      End
      Begin VB.Menu s6 
         Caption         =   "-"
      End
      Begin VB.Menu ShowContol 
         Caption         =   "控制台..."
      End
      Begin VB.Menu MovieNote 
         Caption         =   "电影文件信息(&I)..."
      End
      Begin VB.Menu MClose 
         Caption         =   "关闭当前动画(&C)"
      End
      Begin VB.Menu about 
         Caption         =   "关于(&A)..."
      End
   End
End
Attribute VB_Name = "ControlForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'===============================================
'设为墙纸的声明
'用法
'参数bmpfile是设为墙纸功能的唯一一个参数,为要设为墙纸的*.bmp文件的路径
'SystemParametersInfo SPI_SETDESKWALLPAPER, 0, bmpfile, SPIF_UPDATEINIFILE
'===============================================
'获取和设置数量众多的windows系统参数
Private Declare Function SystemParametersInfo Lib "user32" _
    Alias "SystemParametersInfoA" (ByVal uAction As Long, _
    ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long
                                                
Const SPI_SETDESKWALLPAPER = 20                 '设为墙纸常量
Const SPIF_UPDATEINIFILE = &H1                  '更新 Win.ini 常量
Const SPIF_SENDWININICHANGE = &H2               '更新 Win.ini 并通知所有的程序
'===============================================End

Dim FormX As Integer                            '鼠标按下时鼠标在窗口的 X 位置/Twip    1Pix=15Twip
Dim FormY As Integer                            '鼠标按下时鼠标在窗口的 Y 位置/Twip
Dim MouseX As Integer                           '鼠标按下时鼠标在屏幕的 X 位置/Pix
Dim MouseY As Integer                           '鼠标按下时鼠标在屏幕的 Y 位置/Pix
Dim bFormFlag As Boolean                        '鼠标是否在"标题栏(实际是一个Label控件)"按下/True为按下/False为没有按下
Dim bProgressMouseDown As Boolean               '鼠标是否在进度条(的Label)上按下
'Dim LeftPos As Integer, TopPos As Integer


Private Sub About_Click()
    '显示关于对话框
    FormAbout.Show
End Sub

Private Sub AboutMe_Click()
    '显示关于对话框
    FormAbout.Show
End Sub

Private Sub Add2Favorites_Click()
'添加到收藏夹
Dim MovieName As String, MovieFileName As String            '作品名,文件名

    '取得基本的文件名,如果用getNote无法取得作品名,就用它作为作品名
    MovieName = Right(List(0).List(List(0).ListIndex), Len(List(0).List(List(0).ListIndex)) - InStr(List(0).List(List(0).ListIndex), "]"))
    MovieFileName = List(1).List(List(0).ListIndex)         '取得文件名
    AddToFavorites MovieName, MovieFileName                 '调用AddToFavorites,添加到收藏夹
    
End Sub

Private Sub AddFile_Click()
    '添加文件到播放列表框,多选
    Call getMulitSelectFiles(Me, "Flash Movie", "*.swf;*spl;*.spf", "选择文件...")
End Sub

Private Sub AddFolder_Click()
'添加一个目录中所有的*.swf文件到播放列表框中
Dim strFolder As String                                                     '要添加的目录
    strFolder = BrowseForFolder(Me.hwnd, "添加目录(包含子目录)")            '浏目录的对话框,得到一个目录的路径
    If strFolder <> "" Then                                                 '如得不是取消,则
        strFolder = IIf(Len(strFolder) > 3, strFolder & "\", strFolder)     '如果不是驱动器的根目录,最后没有"\",要添加上去,否则会出错
        Call AddToFolder(strFolder, List(0).hwnd)                           '搜索所有的*.swf文件,并添加到播放列表框中
    End If
    
End Sub

Private Sub AuthorLabel_Click()
    '显示作者名
End Sub

Private Sub BlackLabel_Click()
    '显示出一种立体感,无其它用途
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        
    End If
End Sub

Private Sub MCDisableSortKey_Click()
    MCDisableSortKey.Checked = Not MCDisableSortKey.Checked
    bDisableSortKey = Not bDisableSortKey
End Sub

Private Sub MClose_Click()
    Play.ShockwaveFlash1.Movie = ""
    Unload Play
End Sub

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



Private Sub ShowContol_Click()
ControlForm.Show
End Sub

Private Sub StatusLabel_Click()
'显示搜索/添加文件夹 状态 的Label,下面有一个Frame
'用Frame是为了防止Label显示到ListBox外面
End Sub

Private Sub SuperPlayerIco_Click()
    '显示关于对话框
    FormAbout.Show
End Sub

Private Sub SystemButtonImage_Click(Index As Integer)

    Select Case Index
        Case 0                                              '系统菜单(用自定义的)
            PopupMenu SysPopup
            
        Case 1                                              '关闭(退出程序)
            Call Shell_NotifyIcon(NIM_DELETE, TrayIcon)     '删除系统托盘图标
            UnHook                                          '卸下鼠标(Swflash.ocx)钩子
            running = True                                  '?
            If hHook Then
                Call UnhookWindowsHookEx(hHook)             '卸下键盘钩子
                hHook = 0
            End If
            End                                             '结束程序
            
        Case 2                       '最小化窗口
            SendMessage Me.hwnd, WM_SYSCOMMAND, SC_MINIMIZE, 0
            Me.Visible = False
            
        Case 3                       '显示/最小化 播放区
            If Play.ShockwaveFlash1.Movie <> "" And Play.WindowState = 1 Then
                Play.Show
                Play.WindowState = 0                        '正常状态
            Else
                Play.WindowState = 1                        '最小化状态
            End If
    End Select
    
End Sub

Private Sub SystemButtonImage_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '交换图片
    SystemButtonImage(Index).Picture = b1(Index).Picture
End Sub

Private Sub SystemButtonImage_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '还原图片
     SystemButtonImage(Index).Picture = b0(Index).Picture
End Sub


Private Sub CloseButtonIamge_Click(Index As Integer)
'显示/关闭   属性/ 列表 窗口
    
    If Index = 0 Then                                       '显示/关闭   属性窗口
        With PropertiyFrame
            If .Visible Then                                '隐藏PropertiyFrame,即属性窗口
                .Visible = False
                Image1(1).Top = .Top
                Me.Height = Me.Height - .Height
            Else                                            '显示PropertiyFrame,即属性窗口
                .Visible = True
                Image1(1).Top = .Top + .Height
                Me.Height = Me.Height + .Height
            End If
            CloseButtonIamge(1).Top = Image1(1).Top + 30
            ListFrame.Top = Image1(1).Top + Image1(1).Height
            Label2(1).Top = Image1(1).Top + 60
        End With
    Else                                                    '显示/关闭   列表窗口
        With ListFrame
            If .Visible Then                                '隐藏ListFrame,即列表窗口
                .Visible = False
                Me.Height = Me.Height - .Height + 50
            Else                                            '显示ListFrame,即列表窗口
                .Visible = True
                Me.Height = Me.Height + .Height - 50
            End If
        End With
     End If
    MakeNoBorderForm Me                                     '调整后,调用MakeNoBorderForm 重画窗口,去除边框
End Sub


Private Sub CloseButtonIamge_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'交换图片
    If Index = 0 Then
        If PropertiyFrame.Visible Then
            CloseButtonIamge(Index).Picture = b1(2).Picture
        Else
            CloseButtonIamge(Index).Picture = b1(0).Picture
        End If
    Else
        If ListFrame.Visible Then
            CloseButtonIamge(Index).Picture = b1(2).Picture
        Else
            CloseButtonIamge(Index).Picture = b1(0).Picture
        End If
    End If
End Sub

Private Sub CloseButtonIamge_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
'交换图片
 If Index = 0 Then
    If PropertiyFrame.Visible Then
        CloseButtonIamge(Index).Picture = b0(0).Picture
    Else
        CloseButtonIamge(Index).Picture = b0(2).Picture
    End If
 Else
    If ListFrame.Visible Then
        CloseButtonIamge(Index).Picture = b0(0).Picture
    Else
        CloseButtonIamge(Index).Picture = b0(2).Picture
    End If
 End If
End Sub




Private Sub ComboAddr_Click()
'地址栏,ComboAddr,里面有播放过的文件的路径
    If ComboAddr.Text <> "" Then
        Play.OpenFlash (ComboAddr.Text)             '单击播放被选中的文件
    End If
End Sub

Private Sub ComboAddr_GotFocus()
    KeyUpDownEnable = False
End Sub

Private Sub ComboAddr_LostFocus()
    KeyUpDownEnable = True
End Sub


Private Sub ComboAddr_KeyPress(KeyAscii As Integer)
    SendMessage ComboAddr.hwnd, CB_SHOWDROPDOWN, True, 0            '拉下Combo的下拉部分
    If KeyAscii = 13 And ComboAddr.Text <> "" Then                  '回车键按下且文件内容不为空
        KeyAscii = 0                                                '
        Play.OpenFlash (ComboAddr.Text)                             '播放文本框中的文件,Play.OpenFlash()会自动检测文件的有效性
    End If
End Sub



Private Sub copyto_Click()
'右键菜单中的"文件-另存为",把文件保存为另一个文件
Dim Filename As String                                      ' 保存时用的文件名

    '显示文件选择对话框
    Filename = ShowSaveDialog(Play, "Flash Movie", "*.swf", "保存文件...", "swf", Play.ShockwaveFlash1.Movie)
    If Filename <> "" Then
        FileCopy Play.ShockwaveFlash1.Movie, Filename       '拷贝文件
    End If
    
End Sub

Private Sub CreateExe_Click()
    SetWindowPos Play.hwnd, -2, 0, 0, 0, 0, 3       '取消播放窗口在最前面,防止弹出的窗口被遮住
    SetWindowPos ControlForm.hwnd, -2, 0, 0, 0, 0, 3     '取消控制台窗口在最前面
    OUTTYPE = "EXE"                                 '设置输出类型,这里设为EXE,另一种是SCR(屏保)
    FCreateEXE.Show 1                               '弹出创建EXE文件的窗口
End Sub


Private Sub CtrlImage_Click(Index As Integer)
'==================================
'控制按钮
'==================================
    Select Case Index
        Case 0              '打载文件
            Call OpenFile
        Case 1              '播放动画
            Call playFlash
        Case 2              '重置动画,使其处于初始状态,
            Call RewindFlash
        Case 3              '暂停播放动画
            Call stopFlash
        Case 4              '下一帧
            Call Forward
        Case 5              '上一帧
            Call Back
    End Select
    
End Sub

Private Sub CtrlImage_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '交换控制的按钮的图片
    CtrlImage(Index).Picture = CtrlSwapImage(Index).Picture
End Sub

Private Sub CtrlImage_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    '还原控制的按钮的图片
    CtrlImage(Index).Picture = CtrlImageBase(Index).Picture
End Sub

Private Sub DelAll_Click()
'删除播放列表中所有项
    List(0).Clear
    List(1).Clear
End Sub

Private Sub DelOne_Click()
'删除选中项
Dim Index As Integer
Dim i As Integer
    If List(0).ListIndex > -1 Then
        Index = List(0).ListIndex
        List(1).RemoveItem (Index)
        List(0).RemoveItem (Index)
        If List(0).ListCount > Index Then
            List(0).ListIndex = Index
        Else
            If List(0).ListCount > 0 Then
                List(0).ListIndex = Index - 1
            End If
        End If
        '重新排列序号
        For i = 0 To List(0).ListCount - 1
            List(0).List(i) = "[" & i + 1 & "]" & Mid(List(0).List(i), InStr(List(0).List(i), "]") + 1)