--==vb6中用图片框任意大小播放AVI电影（New）==--

新建工程，增加一个bas模块 加入一个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运行程序

本文地址：http://com.8s8s.com/it/it6727.htm