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

    技术2022-05-11  122

    新建工程,增加一个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运行程序

    最新回复(0)