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

来源:互联网 发布:猴子seo 编辑:程序博客网 时间:2024/05/29 17:02
  1. 新建工程,增加一个bas模块
  2. 加入一个MCI控件,一个command按钮和一个图片框,设置form的
    ScaleMode property为 Pixels (3).
  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 



  1. 按f5运行程序


Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=5690