香港新浪網 MySinaBlog
« 上一篇 | 下一篇 »
Emily | 2nd May 2006, 14:38 PM | Network / Media, UserForm / Object | (2139 Reads)

用 Excel 播放 Flash

各位有沒有看過 Playing video on a Userform -  via the MCI API ?

介紹 肖岗 的 "用 Excel 播放 Flash"

 

'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime  : 2/5/2006 14:45
' Author    :
' Purpose   :
'---------------------------------------------------------------------------------------

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'---------------------------------------------------------------------------------------
' Module    : ThisWorkbook
' DateTime  : 2/5/2006 14:46
' Author    :
' Purpose   :
'---------------------------------------------------------------------------------------
Private Sub Workbook_Open()
    UserForm1.Show
End Sub
'---------------------------------------------------------------------------------------
' Module    : UserForm1
' DateTime  : 2/5/2006 14:47
' Author    :
' Purpose   :
'---------------------------------------------------------------------------------------
' ShockwaveFlash屬性取值及說明
' Loop
' True:允許迴圈播放
' False:不允許迴圈播放
' Menu
' True:允許顯示右鍵快顯功能表
' False:不允許顯示右鍵快顯功能表
' Movie
' 所要播放的動畫檔的路徑和檔案名
' Playing
' True: 播放
' False:停止
' Quality
' 0:低解析度( 即Quality2:Low)
' 1:高解析度( 即Quality2:High)
' 2:自動降低解析度 ( 即Quality2:AutoLow)
' 3:自動升高解析度( 即Quality2:AutoHigh)
' Quality2
' 見上 , 和Quality變化一致
' ScaleMode
' 0:全部顯示(即Scale:Showall)
' 1:無邊界(即Scale:NoBorder)
' 2:自動適應控制項大小(即Scale:ExactFit)
' Scale
' 見上 , 和ScaleMode變化一致

Dim MouseOver
Dim MousePress

' 調用電子郵件
Private Sub Label2_Click()
    ShellExecute 0&, vbNullString, "mailto:xiaog@citiz.net", vbNullString, vbNullString, vbNormalFocus
End Sub
 

Private Sub Label2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label2.Font.Underline =
True
End Sub
 

' 播放
Private Sub CommandButton1_Click()
    ShockwaveFlash1.Play
    CommandButton1.Enabled =
False
    CommandButton2.Enabled = True
End Sub

Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton1.BackColor = &HFFC0C0
    MouseOver =
True
End Sub

Private Sub CommandButton1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MousePress Then Exit Sub
    CommandButton1.BackColor = &HFF8080
    MousePress =
True
End Sub

' 停止
Private Sub CommandButton2_Click()
    ShockwaveFlash1.Stop
    CommandButton2.Enabled =
False
    CommandButton1.Enabled = True
End Sub
 

Private Sub CommandButton2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton2.BackColor = &HFFC0C0
    MouseOver =
True
End Sub

Private Sub CommandButton2_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MousePress Then Exit Sub
    CommandButton2.BackColor = &HFF8080
    MousePress =
True
End Sub

'上一幀
Private Sub CommandButton3_Click()
    ShockwaveFlash1.Back
End Sub

Private Sub CommandButton3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton3.BackColor = &HFFC0C0
    MouseOver =
True
End Sub

Private Sub CommandButton3_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MousePress Then Exit Sub
    CommandButton3.BackColor = &HFF8080
    MousePress =
True
End Sub
 

' 下一幀
Private Sub CommandButton4_Click()
    ShockwaveFlash1.Forward
End Sub

Private Sub CommandButton4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton4.BackColor = &HFFC0C0
    MouseOver =
True
End Sub

Private Sub CommandButton4_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MousePress Then Exit Sub
    CommandButton4.BackColor = &HFF8080
    MousePress =
True
End Sub

' 打開文件
Private Sub CommandButton5_Click()
    
On Error Resume Next
    With
CommonDialog1
        .CancelError =
True
        .DialogTitle = "打開文件"          ' 標題
        .Filename = ""                             ' 缺省為空
        .Filter = "Flash 文件|*.swf"         ' 文件濾器
        .Flags = cdlOFNCreatePrompt + cdlOFNHideReadOnly
        .ShowOpen                                
' 打開對話方塊
    End With
    If
Err = cdlCancel Then Exit Sub
    TextBox1.Text = CommonDialog1.Filename
    
    ' 設置按鈕和Swflash.ocx控制項的狀態
    CommandButton2.Enabled = True
    CommandButton3.Enabled = True
    CommandButton4.Enabled = True
    ShockwaveFlash1.Visible = True
    ShockwaveFlash1.Playing = True
    ShockwaveFlash1.Movie = TextBox1.Text
    CommandButton1.Enabled =
False
End Sub

Private Sub CommandButton5_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton5.BackColor = &HFFC0C0
    MouseOver =
True
End Sub

Private Sub CommandButton5_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MousePress Then Exit Sub
    CommandButton5.BackColor = &HFF8080
    MousePress =
True
End Sub

Private Sub CommandButton6_Click()
    
' 放大畫面
    ShockwaveFlash1.Zoom (50)
End Sub

Private Sub CommandButton6_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton6.BackColor = &HFFC0C0
    MouseOver =
True
End Sub
 

Private Sub CommandButton6_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MousePress Then Exit Sub
    CommandButton6.BackColor = &HFF8080
    MousePress =
True
End Sub

Private Sub CommandButton7_Click()
   
 ' 縮小畫面
    ShockwaveFlash1.Zoom (200)
End Sub

Private Sub CommandButton7_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton7.BackColor = &HFFC0C0
    MouseOver =
True
End Sub

Private Sub CommandButton7_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton7.BackColor = &HFF8080
    MousePress =
True
End Sub

Private Sub CommandButton8_Click()
    Unload Me
End Sub

Private Sub CommandButton8_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton8.BackColor = &HFFC0C0
    MouseOver =
True
End Sub

Private Sub CommandButton8_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    
If MouseOver Then Exit Sub
    CommandButton8.BackColor = &HFF8080
    MousePress =
True
End Sub


' 當用戶拖動滑動條時 , 將播放幀數設置為滑動條中的值
Private Sub Slider1_Scroll()
    ShockwaveFlash1.FrameNum = Slider1.Value
End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Label2.Font.Underline =
False
    If Not MouseOver Then Exit Sub
    MouseOver = False
    MousePress = False
    CommandButton1.BackColor = &H8000000B
    CommandButton2.BackColor = &H8000000B
    CommandButton3.BackColor = &H8000000B
    CommandButton4.BackColor = &H8000000B
    CommandButton5.BackColor = &H8000000B
    CommandButton6.BackColor = &H8000000B
    CommandButton7.BackColor = &H8000000B
    CommandButton8.BackColor = &H8000000B
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    
'Application.Quit
End Sub

'

'

繁體下載: http://cat14051.sinagirl.com/ExcelPlayFlash.zip

原文下載: http://www.officefans.net/cdb/attachment.php?aid=2969