| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 635 人关注过本帖
标题:VB6播放音乐文件改为播放avi视频文件代码如何改?
只看楼主 加入收藏
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
结帖率:94.12%
收藏
已结贴  问题点数:20 回复次数:9 
VB6播放音乐文件改为播放avi视频文件代码如何改?
VB6播放音乐文件改为播放avi视频文件代码如何改?
这是原来的代码:
Private Sub Command4_Click()
WindowsMediaPlayer1.URL = App.Path + "/mi/12.mid"
WindowsMediaPlayer1.settings.playCount = &H7FFFFFFF '上一首连续播放
    Command9.Visible = True '换钮
       Command4.Visible = False
End Sub
现在要将12.mid音乐文件改为视频文件12.avi
直接改为12.avi通不过,请问高手这要如何改?
搜索更多相关主题的帖子: 如何 音乐 
2015-11-24 09:59
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
可以听到声音,但看不到播放图像,不知何故?
2015-11-24 10:23
wmf2014
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:216
帖 子:2039
专家分:11273
注 册:2014-12-6
收藏
得分:0 
给代码及实例媒体文件,通常会有大神帮你弄出来的。

能编个毛线衣吗?
2015-11-24 19:04
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
这页的全部代码:就是想将音乐换成视频;
'关闭前面的窗体用
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_TERMINATE = 1
'下面是链接网站用代码(一共有两个部分,第2段见下面Command4)
Private 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
Private Const SW_SHOW = 5
Private bQuestion As Boolean '关闭钮用1222
Dim iw1 As New WshShell 'QQ对话用(3-1)
'需加载 windows script host object model
'以下二级菜单

Private Declare Function GetMenu Lib "user32" _
   (ByVal hwnd As Long) As Long

Private Declare Function GetSubMenu Lib "user32" _
   (ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function SetMenuItemBitmaps Lib "user32" _
   (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
    ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Const MF_BYPOSITION = &H400&


'Private Sub Form_Unload(Cancel As Integer) '二级菜单用
    'Unload FrmMenu
'End Sub

Private Sub frame1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) '二级菜单用

  If Button And vbRightButton Then
     PopupMenu FrmMenu.jrswj
   
      End If
End Sub

Private Sub tp8_Click() '二级菜单用
  End
End Sub
Private Sub Command4_Click()
WindowsMediaPlayer1.URL = App.Path + "/mi/kk.avi"
WindowsMediaPlayer1.settings.playCount = &H7FFFFFFF '上一首连续播放
    Command9.Visible = True '换钮
       Command4.Visible = False
End Sub
Private Sub Command9_Click() '停止播放
WindowsMediaPlayer1.Close
Command9.Visible = False '换钮
       Command4.Visible = True
End Sub
Private Sub Command8_Click() 'QQ对话用(3-2)
    On Error Resume Next
    If getQQpath = "" Then
        MsgBox "你没有安装QQ,请先安装QQ", vbOKOnly Or vbInformation, Me.Caption
        Exit Sub
    Else
        iw1.Run "tencent://message/?uin=791465768&Site=jrs123&Menu=yes"
    End If
End Sub

'判断是否安装QQ 'QQ对话用(3-3)
Private Function getQQpath() As String
    getQQpath = iw1.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Tencent\QQ\Install")
End Function
Private Sub Command7_Click()
Dim web As String '链接网站用,网址放在Combo1的属性Text中
  web = Combo1.Text
  ShellExecute 0&, vbNullString, web, vbNullString, vbNullString, 0
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) '关闭钮用1222
    'If UnloadMode = 0 Then bQuestion = True
End Sub
Private Sub Command10_Click()
Load xj15009b
xj15009b.Show
End Sub

Private Sub Command11_Click()
Dim web As String '链接网站用,网址放在Combo1的属性Text中
  web = Combo2.Text
  ShellExecute 0&, vbNullString, web, vbNullString, vbNullString, 0
End Sub


Private Sub Command16_Click()
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
strWinName = "奥林匹克运动会邮票集"
hLong = FindWindow(vbNullString, strWinName)
If hLong Then
GetWindowThreadProcessId hLong, LpID
Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
TerminateProcess Ltem, 0
hLong = 0
End If
Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\olpk.exe", vbMaximizedFocus
bQuestion = False '关闭钮用(3)
    'Unload Me
End Sub

Private Sub Command2_Click()
 Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj14.exe", vbMaximizedFocus
 bQuestion = False '关闭钮用1222
'Unload Me
End Sub

Private Sub Command3_Click()
 Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj16.exe", vbMaximizedFocus
 bQuestion = False '关闭钮用1222
'Unload Me
End Sub

Private Sub Command5_Click()
 Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj14.exe", vbMaximizedFocus
 bQuestion = False '关闭钮用1222
'Unload Me
End Sub

Private Sub Command6_Click()
 Shell "rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\xj16.exe", vbMaximizedFocus
 bQuestion = False '关闭钮用1222
'Unload Me
End Sub

Private Sub Image1_Click()
Load xj1501
xj1501.Show
End Sub
Private Sub Image2_Click()
Load xj1502
xj1502.Show
End Sub

Private Sub Image20_Click()
Load xj1505
xj1505.Show
End Sub

Private Sub Image21_Click()
Load xj1506
xj1506.Show
End Sub

Private Sub Image3_Click()
Load xj1503
xj1503.Show
End Sub
Private Sub Image4_Click()
Load xj1504
xj1504.Show
End Sub
Private Sub Image9_Click()
Load xj15001
xj15001.Show
End Sub
Private Sub Image6_Click()
Load xj15002a
xj15002a.Show
End Sub
Private Sub Image5_Click()
Load xj15001
xj15001.Show
End Sub
Private Sub Image11_Click()
Load xj15001
xj15001.Show
End Sub
Private Sub Image7_Click()
Load xj15001
xj15001.Show
End Sub
Private Sub Image10_Click()
Load xj15002a
xj15002a.Show
End Sub
Private Sub Image8_Click()
Load xj15001
xj15001.Show
End Sub
Private Sub Image12_Click()
Load xj15001
xj15001.Show
End Sub
Private Sub Image13_Click()
Load xj15009a
xj15009a.Show
End Sub
Private Sub Image14_Click()
Load xj15010a
xj15010a.Show
End Sub
Private Sub Image15_Click()
Load xj15001
xj15001.Show
End Sub
Private Sub Image16_Click()
Load xj15012a
xj15012a.Show
End Sub
Private Sub Image17_Click()
Load xj15013a
xj15013a.Show
End Sub
Private Sub Image19_Click()
Load xj15014a
xj15014a.Show
End Sub
Private Sub Image18_Click()
Load xj15001
xj15001.Show
End Sub
Private Sub Command1_Click()
Dim Ltem As Long
Dim LpID As Long
Dim hLong     As Long
Dim strWinName     As String
If MsgBox("你要退出《第15届奥运会邮票集》吗?", vbYesNo + vbExclamation, "系统询问") = vbYes Then
   Unload Me
   End
   Else
   Cancel = True
    End If
'bQuestion = True '关闭钮用(6特)  退出系统,单页用此句代码
    'Unload Me
End Sub
Private Sub Form_Load() '留言栏,注意MyApp编号
    'Text6.Text = Inet1.OpenURL("http://www.)
    Text1.Text = GetSetting("MyApp15a01", "保存留言", "内容", "") '留言栏用,有2个部分,下面还有对应的一部分
    Text2.Text = GetSetting("MyApp15a02", "保存留言", "内容", "")
    Text3.Text = GetSetting("MyApp15a03", "保存留言", "内容", "")
    Text4.Text = GetSetting("MyApp15a04", "保存留言", "内容", "")
    Text5.Text = GetSetting("MyApp15a05", "保存留言", "内容", "")
        Hook Me.hwnd
End Sub

Private Sub form_resize() '滚动条与鼠标事件用
    If Frame1.Height > Me.Height Then
        VScroll1.Visible = True
    Else
        VScroll1.Visible = False
    End If
    If Frame1.Width > Me.Width Then
        HScroll1.Visible = True
    Else
        HScroll1.Visible = False
    End If
    HScroll1.Left = 0
    HScroll1.Top = Me.ScaleHeight - HScroll1.Height
    VScroll1.Left = Me.ScaleWidth - VScroll1.Width
    VScroll1.Top = 0
    HScroll1.Width = Me.ScaleWidth
    VScroll1.Height = Me.ScaleHeight
    If VScroll1.Visible = True Then
        If HScroll1.Visible = True Then
           HScroll1.Width = Abs(Me.ScaleWidth - VScroll1.Width)
           VScroll1.Height = Abs(Me.ScaleHeight - HScroll1.Height)

        End If
    End If
    HScroll1.Max = (Frame1.Width - Me.Width) + 3 * VScroll1.Width
    VScroll1.Max = (Frame1.Height - Me.Height) + 3 * HScroll1.Height
    HScroll1.ZOrder
    VScroll1.ZOrder
    Frame1.Left = (Me.ScaleWidth - Frame1.Width) / 2
End Sub
Private Sub Form_Unload(Cancel As Integer)
    Dim Ltem As Long
    Dim LpID As Long
    Dim hLong As Long
    Dim pForm As Form
    Const strWinName As String = "第15届"
    If bQuestion Then
        If MsgBox("你要退出《第15届奥运会邮票集》吗?", vbYesNo + vbExclamation, "系统询问") <> vbYes Then
            Cancel = True
            Exit Sub
        Else
            hLong = FindWindow(vbNullString, strWinName)
            If hLong Then
                GetWindowThreadProcessId hLong, LpID
                Ltem = OpenProcess(PROCESS_TERMINATE, False, LpID)
                TerminateProcess Ltem, 0
                hLong = 0
            End If
        End If
    End If
    UnHook Me.hwnd '鼠标滚轮事件用
    For Each pForm In Forms
        Unload pForm
    Next
End Sub
Private Sub HScroll1_Change() '滚动条与鼠标事件用
  Frame1.Left = -HScroll1.Value
End Sub

Private Sub Label12_Click()
Load xj15qw
xj15qw.Show
End Sub

Private Sub Label3_Click()
Load xj15sm
xj15sm.Show
End Sub

Private Sub VScroll1_Change() '滚动条与鼠标事件用
    Frame1.Top = -VScroll1.Value
End Sub
Private Sub VScroll1_GotFocus()
    Command1.SetFocus
End Sub
Private Sub Text1_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text1.Text = myValue
        SaveSetting "MyApp15a01", "保存留言", "内容", myValue
    End If
End Sub

Private Sub Text2_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text2.Text = myValue
        SaveSetting "MyApp15a02", "保存留言", "内容", myValue
    End If

End Sub
Private Sub Text3_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text3.Text = myValue
        SaveSetting "MyApp15a03", "保存留言", "内容", myValue
    End If

End Sub
Private Sub Text4_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text4.Text = myValue
        SaveSetting "MyApp15a04", "保存留言", "内容", myValue
    End If

End Sub
Private Sub Text5_Click()
Dim message, title, defaultValue As String
    Dim myValue As String
    message = ""   '设置提示信息
    title = "请输入您的答案"                      '设置标题
    defaultValue = ""                           '设置默认值
    myValue = InputBox(message, title, defaultValue, 100, 100)
   '显示输入对话框
   If myValue = "" Then
    Else
        Text5.Text = myValue
        SaveSetting "MyApp15a05", "保存留言", "内容", myValue
    End If

End Sub

2015-11-24 20:14
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
视频文件我是用KK屏幕录像软件随便录了一段,就是想在这页面上能不能播放视频,现在是声音能出来,就是没有播放窗口
这个页面也有播放视频的按钮,那是联到网站上的链接,现在是想让软件自带视频节目
2015-11-24 20:26
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
图片附件: 游客没有浏览图片的权限,请 登录注册
2015-11-24 20:29
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
第十五届奥运会邮票集软件
第十五届奥运会邮票集.rar (1.76 MB)
2015-11-24 20:36
xiangyue0510
Rank: 14Rank: 14Rank: 14Rank: 14
等 级:贵宾
威 望:86
帖 子:941
专家分:5244
注 册:2015-8-10
收藏
得分:2 
这个真没做过,帮顶
2015-11-25 16:11
wmf2014
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:216
帖 子:2039
专家分:11273
注 册:2014-12-6
收藏
得分:18 
能看到视频,你的WindowsMediaPlayer尺寸过小,还必须要有视频文件,帮你弄个12.avi的视频,并调整WindowsMediaPlayer尺寸和位置后,你运行即可看到效果,原理搞清后,如何添置自己需要的代码,你自己弄吧,祝编程快乐!
第十五届奥运会邮票集.zip (3.7 MB)

能编个毛线衣吗?
2015-11-25 17:12
jrs123
Rank: 2
等 级:论坛游民
威 望:1
帖 子:627
专家分:14
注 册:2006-9-5
收藏
得分:0 
谢谢版主的帮助
2015-11-25 21:12
快速回复:VB6播放音乐文件改为播放avi视频文件代码如何改?
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.022107 second(s), 10 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved