加入一个MCI控件，一个command按钮和一个图片框，设置form的
ScaleMode property为 Pixels (3).
.BAS 文件代码:
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Type MCI_OVLY_RECT_PARMS
dwCallback As Long
rc As RECT
End Type
Global Const MCI_OVLY_WHERE_SOURCE = &H20000
Global Const MCI_OVLY_WHERE_DESTINATION = &H40000
Global Const MCI_WHERE = &H843
Declare Function mciSendCommand Lib "winmm.dll" _
Alias "mciSendCommandA" ( _
ByVal wDeviceID As Long, _
ByVal uMessage As Long, _
ByVal dwParam1 As Long,
dwParam2 As Any) As Long
Declare Function mciGetErrorString Lib "winmm.dll" _
Alias "mciGetErrorStringA" ( _
ByVal dwError As Long, _
ByVal lpstrBuffer As String, _
ByVal uLength As Long) As Long
Command1_Click()事件:
Sub Command1_Click ()
Const MB_OK = 0
Const MB_ICONSTOP = 16
Dim Retval&, Buffer$
Dim dwParam2 As MCI_OVLY_RECT_PARMS
MMControl1.Command = "Close"
MMControl1.Filename = "WndSurf1.avi" '
MMControl1.hWndDisplay = Picture1.hWnd
MMControl1.Command = "Open"
'初始化
dwParam2.dwCallback = MMControl1.hWnd
dwParam2.rc.Left = 0
dwParam2.rc.Top = 0
dwParam2.rc.Right = 0
dwParam2.rc.Bottom = 0
'发送消息
Retval& = mciSendCommand(MMControl1.DeviceID, MCI_WHERE,
MCI_OVLY_WHERE_SOURCE, dwParam2)
If Retval& <> 0 Then '错误发生.
Buffer$ = Space$(100)
'Get a description of the error:
Retval& = mciGetErrorString(Retval&, Buffer$, Len(Buffer$))
MsgBox Trim$(Buffer$), MB_OK + MB_ICONSTOP, "ERROR"
Else
'改变picture box大小:
Picture1.Width = dwParam2.rc.right - dwParam2.rc.left
Picture1.Height = dwParam2.rc.bottom - dwParam2.rc.top
'播放电影
MMControl1.Wait = True ' Wait for the next command to complete
MMControl1.Command = "play" 'Play the video clip
MMControl1.Command = "close"
End If
End Sub
按f5运行程序
延伸阅读
文章来源于领测软件测试网 https://www.ltesting.net/
