求助！~！在Picture1上播放视频时，右键显示菜单怎样才能不被Picture1控件遮住？？
MCI指定视频在Picture1控件上播放，在Picture1或者视频窗体上点击右键时，弹出菜单！但是没有反应，好像Picture1遮住了看不到，应该怎么右键显示菜单出来？？求助！~！！！！非常感谢！！ --------------------编程问答-------------------- 标准模块Module1.bas如下：Option Explicit
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const GWL_WNDPROC As Long = -4
Public Const WM_RBUTTONDOWN As Long = &H204&
Public prevWndProc As Long, mciHwnd As Long
'回调函数
'自定义窗口处理程序，用于截获右击视频播放窗口的Windows消息系统
Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Select Case Msg
Case WM_RBUTTONDOWN '弹出右键菜单
Form1.PopupMenu Form1.File
Case Else '操作系统预定义窗口处理程序
WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
End Select
End Function
窗体Form1模块如下：
'窗体上放一个控件Picture1--------------------编程问答-------------------- Public Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'建立一个“文件”菜单，名称是“File”。再建立一个子菜单“打开文件”，名称是“Openfile”
Option Explicit
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Const WS_CHILD As Long = &H40000000
Dim MCIfile As String '要播放的多媒体文件名
Dim sMCI As String '转换后的短文件名
'MCIfile：多媒体文件
'Pict：图片框PictureBox
'MCI视频图像缩放函数
Private Function mciVideoStretch(ByVal MCIfile As String, Pict As PictureBox)
On Error Resume Next
Dim strMCI As String
strMCI = "put " & MCIfile & " window at 0 0 " & Pict.ScaleWidth & " " & Pict.ScaleHeight
Call mciSendString(strMCI, vbNullString, 0, 0)
End Function
Private Sub Form_Load()
Dim ErrorCode As Long, ReturnString As String * 256
On Error Resume Next
Form1.ScaleMode = 3
Picture1.ScaleMode = 3
mciSendString "stop MEDIA", vbNullString, 0, 0
mciSendString "close MEDIA", vbNullString, 0, 0
MCIfile = "E:\TDDOWNLOAD\[朝鲜经典电影之二十九.看不见的战线].Invisible.Front.1970.DVDRip.XviD-tslhh.avi" '事先加载一个多媒体文件
'将长文件名转换成短文件名,mciSendString不支持长文件名
sMCI = String(LenB(MCIfile), Chr(0))
GetShortPathName MCIfile, sMCI, Len(sMCI)
MCIfile = Left(sMCI, InStr(sMCI, Chr(0)) - 1)
'注意里面的格
ErrorCode = mciSendString("open " & Trim(MCIfile) & " Type " & "MPEGVideo" & _
" alias MEDIA parent " & Picture1.hwnd & " style " & WS_CHILD & " WAIT", ReturnString, 256, 0)
'取得播放图像的句柄mciHWnd
ErrorCode = mciSendString("STATUS MEDIA WINDOW HANDLE WAIT", ReturnString, 256, 0)
ReturnString = Left$(ReturnString, InStr(1, ReturnString, vbNullChar) - 1)
If ErrorCode = 0 Then
If Val(ReturnString) <> 0 Then
mciHwnd = CLng(ReturnString) '得到播放图像句柄mciHWnd
End If
End If
'开始播放
mciSendString "play MEDIA", vbNullString, 0, 0
prevWndProc = GetWindowLong(mciHwnd, GWL_WNDPROC)
Call SetWindowLong(mciHwnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Private Sub Form_Resize()
Picture1.Move 0, 0, Form1.ScaleWidth, Form1.ScaleHeight
Call mciVideoStretch("MEDIA", Picture1)
End Sub
'关闭窗体停止播放
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
SetWindowLong mciHwnd, GWL_WNDPROC, prevWndProc
prevWndProc = 0
mciSendString "stop MEDIA", vbNullString, 0, 0
mciSendString "close MEDIA", vbNullString, 0, 0
End Sub
Public Declare Function mciGetDeviceID Lib "winmm.dll" Alias "mciGetDeviceIDA" (ByVal lpstrName As String) As Long
Public Declare Function waveOutGetVolume Lib "winmm.dll" (ByVal uDeviceID As Long, lpdwVolume As Long) As Long
Public Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "USER32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function GetWindowRect Lib "USER32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Const GWL_WNDPROC As Long = -4
Public Const WM_RBUTTONDOWN As Long = &H204&
Public hWndMusic As Long
Public prevWndProc As Long
'打开MCI设备，FILENAME为文件名,传值代表成功与否
Public Function OpenMusic(FileName As String, Optional hwnd As Long) As Boolean
OpenMusic = False
Dim ShortPathName As String * 255
Dim RefShortName As String
Dim RefInt As Long
Dim MciCommand As String
Dim DriverID As String
Dim ErrorCode As Long, ReturnString As String * 256
CloseMusic '关闭 已经打开的歌曲 才可以打开新的歌曲
'获取短文件名
GetShortPathName FileName, ShortPathName, 255
RefShortName = Left(ShortPathName, InStr(1, ShortPathName, Chr(0)) - 1)
'MCI命令
DriverID = GetDriverID(RefShortName)
If DriverID = "RealPlayer" Then
PlayType = RealPlay
Exit Function
End If
MciCommand = "open " & RefShortName & " type " & DriverID & " alias NOWMUSIC"
If DriverID = "AVIVideo" Or DriverID = "MPEGVideo" Or DriverID = "MPEGVideo2" Then
MciCommand = "open " & RefShortName & " type " & DriverID & " alias NOWMUSIC"
If hwnd = 0 Then
hwnd = Form1.Picture1.hwnd
MciCommand = MciCommand + " parent " & hwnd & " style child"
'mciSendString "put NOWMUSIC window at 0 0 [Form1.Picture1.Width Form1.Picture1.Height]", 0&, 0, 0
Form1.Show
LrcForm.Hide
'取得播放图像的句柄mciHWnd
ErrorCode = mciSendString("STATUS NOWMUSIC WINDOW HANDLE WAIT", ReturnString, 256, 0)
ReturnString = Left$(ReturnString, InStr(1, ReturnString, vbNullChar) - 1)
If ErrorCode = 0 Then
If Val(ReturnString) <> 0 Then
hWndMusic = CLng(ReturnString) '得到播放图像句柄mciHWnd
End If
End If
prevWndProc = GetWindowLong(hWndMusic, GWL_WNDPROC)
Call SetWindowLong(hWndMusic, GWL_WNDPROC, AddressOf WndProc)
Else
MciCommand = MciCommand + " style overlapped "
End If
Else
MciCommand = "open " & RefShortName & " type MPEGVideo alias NOWMUSIC"
Form1.Hide
End If
RefInt = mciSendString(MciCommand, vbNull, 0, 0)
mciSendString "set NOWMUSIC time format milliseconds", vbNullString, 0, 0
If RefInt = 0 Then
OpenMusic = True
LrcForm.LRC1.Sotp '关闭 已经打开的歌词
SongName = Trim$(Mid$(FileName, InStrRev(FileName, "\") + 1, Len(FileName))) & " " '滤除前面的路径
Naccuracy = 0 '还原歌词调整值 为 0
End If
End Function
Public Function WndProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
On Error Resume Next
Select Case Msg
Case WM_RBUTTONDOWN '弹出右键菜单
menu.PopupMenu menu.Video
Case Else '操作系统预定义窗口处理程序
WndProc = CallWindowProc(prevWndProc, hwnd, Msg, wParam, lParam)
End Select
End Function
'播放文件
Public Function PlayMusic() As Boolean
Dim RefInt As Long
Dim Result As String
PlayMusic = False
'mciSendString "put NOWMUSIC window at Form1.Picture1.hwnd", 0&, 0&, 0&
RefInt = mciSendString("play NOWMUSIC", vbNull, 0, 0)
If RefInt = 0 Then
Result = PutMPEG(Val(0), Val(0), Val(0), Val(0))
PlayMusic = True: DownloadLrc '加载 或下 载歌词
SetVolume ((Main.Button1(6).Left - 3480)) / 720 * 1000 '计算当前音量大小 '最大为1000
'检测播放速度 800 慢 1200 快
If menu.SpeedDown.Checked Then SetSpeed 800
If menu.SpeedUp.Checked Then SetSpeed 1200
'检测声道 默认 立体
If menu.AudioLeft.Checked Then SetAudioSource L '左声道
If menu.AudioRight.Checked Then SetAudioSource R
End If
End Function
Public Function mciVideoStretch(ByVal MCIfile As String, Pict As PictureBox) 'MCI视频图像缩放函数
On Error Resume Next
Dim strMCI As String
strMCI = "put " & MCIfile & " window at 0 0 " & Pict.ScaleWidth & " " & Pict.ScaleHeight
Call mciSendString(strMCI, vbNullString, 0, 0)
End Function
'获取媒体的长度
Public Function GetMusicLength() As Long
Dim RefStr As String * 80
mciSendString "status NOWMUSIC length", RefStr, 80, 0
GetMusicLength = Val(RefStr)
End Function
'关闭媒体
Public Function CloseMusic() As Boolean
Dim RefInt As Long
CloseMusic = False
RefInt = mciSendString("close NOWMUSIC", vbNull, 0, 0)
If RefInt = 0 Then CloseMusic = True
End Function
大侠，按你的程序我测试过是行的，但是应用到我的程序中，试了好几次没反应，能不能帮忙看看我这段代码哪里错了？？非常感谢！ --------------------编程问答-------------------- 你这个问题的原因是因为实际显示视频的窗口并不是图片框,只是基于图片框的位置与大小创建的另一个专用窗口.
因此你在这个位于上层的窗口上点右键当然是没有用的.
而东方之珠的解决方案是使用子类化技术拦截那个实际播放窗口中的鼠标消息,实现鼠标响应.
你自己用起来如果没用,就跟踪一下"取得播放图像的句柄mciHWnd"这部分的代码,看看是否成功取得了它的句柄. --------------------编程问答-------------------- 谢谢~我跟踪了一下"取得播放图像的句柄mciHWnd"这部分的代码，确实没有成功取得它的句柄，那我想请问一下应该怎么来实现呢？？因为我对VB本身就不是很懂！ --------------------编程问答-------------------- If Val(ReturnString) <> 0 Then
hWndMusic = CLng(ReturnString) '得到播放图像句柄mciHWnd
End If
我跟踪的时候这段代码没有成功取得它的句柄。 --------------------编程问答--------------------
1、测试一下多媒体文件是否正确打开。查看一下返回值ErrorCode是否为0。
2、测试一下返回字符串ReturnString，若不为空，它就是播放图像句柄mciHWnd，字符串要转换成Long型才能用。
MCI播放多媒体文件效率较高，代码精炼。但是缺点也是不言而喻的，必须指定MCI设备名。举个例子，同样都是AVI视频文件，早期的AVI要指定MCI设备AVIVideo才能播放，现在最新的DVDRip格式的AVI必须指定MCI设备MPEGVideo才能正确播放（MPEGVideo2没有试过）。
--------------------编程问答-------------------- 要是用MCI命令没成功获取到播放窗口的句柄,也可以试试用FindWindowEx来取,我这里是测试成功的:
mciHwnd = FindWindowEx(Picture1.hwnd, 0&, "MCIQTZ_Window", vbNullString) '得到播放图像句柄mciHWnd
这一句加在GetWindowLong之前即可.
其中"MCIQTZ_Window"是播放窗口的类名,这个值是我通过SPY++查得的,不清楚是否总是这个类名,你可以自己用SPY++在播放视频时看一下. --------------------编程问答--------------------
不知道你怎么搞的？我一楼代码测试成功后才贴出来的。
1、下面这个API调用是打开多媒体文件。如果打开成功，其返回值ErrorCode应为0。
'
注意里面的格
ErrorCode = mciSendString("open " & Trim(MCIfile) & " Type " & "MPEGVideo" & _
" alias MEDIA parent " & Picture1.hwnd & " style " & WS_CHILD & " WAIT", ReturnString, 256, 0
2、多媒体文件打开成功后，在mciSendString参数ReturnString中返回播放窗口句柄。如果成功返回值ErrorCode应该为0。
'取得播放图像的句柄mciHWnd
ErrorCode = mciSendString("STATUS MEDIA WINDOW HANDLE WAIT", ReturnString, 256, 0)
补充：VB , 多媒体
