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

最新推荐文章于 2024-09-16 13:01:49 发布

原创最新推荐文章于 2024-09-16 13:01:49 发布 · 1.5k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#vb #avi #buffer #command #function #string

博客介绍了VB工程的创建与运行步骤。先新建工程并增加一个bas模块，接着加入MCI控件、command按钮和图片框，设置form的ScaleMode property为Pixels (3)，给出.BAS文件代码及Command1_Click()事件，最后按f5运行程序。

新建工程，增加一个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