1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
| Option Strict Off
Option Explicit On
Imports VB = Microsoft.VisualBasic
Friend Class Form1
Inherits System.Windows.Forms.Form
'Добавьте CommandButton и PictureBox на форму
Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
Private Declare Function mciGetErrorString Lib "winmm" Alias "mciGetErrorStringA" (ByVal dwError As Integer, ByVal lpstrBuffer As String, ByVal uLength As Integer) As Integer
Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Integer) As Integer
Const WS_CHILD As Integer = &H40000000
Sub PlayAVIPictureBox(ByRef FileName As String, ByVal Window As System.Windows.Forms.PictureBox)
Dim RetVal As Integer
Dim CommandString As String
Dim ShortFileName As New vb6.FixedLengthString(260)
'Retrieve short file name format
RetVal = GetShortPathName(FileName, ShortFileName.Value, Len(ShortFileName.Value))
FileName = VB.Left(ShortFileName.Value, RetVal)
'Open the device
CommandString = "Open " & FileName & " Type AVIVideo Alias AVIFile parent " & CStr(Window.Handle.ToInt32) & " style " & CStr(WS_CHILD)
RetVal = mciSendString(CommandString, vbNullString, 0, 0)
If RetVal Then GoTo error_Renamed
'remember that the device Is now Open
deviceIsOpen = True
'Resize the movie To PictureBox size
CommandString = "Put AVIFile window at 0 0 " & CStr(VB6.PixelsToTwipsX(Window.ClientRectangle.Width) / VB6.TwipsPerPixelX) & " " & CStr(VB6.PixelsToTwipsY(Window.ClientRectangle.Height) / VB6.TwipsPerPixelY)
RetVal = mciSendString(CommandString, vbNullString, 0, 0)
If RetVal <> 0 Then GoTo error_Renamed
CommandString = "Play AVIFile wait"
RetVal = mciSendString(CommandString, vbNullString, 0, 0)
If RetVal <> 0 Then GoTo error_Renamed
CommandString = "Close AVIFile"
RetVal = mciSendString(CommandString, vbNullString, 0, 0)
If RetVal <> 0 Then GoTo error_Renamed
Exit Sub
error_Renamed:
Dim ErrorString As String
ErrorString = Space(256)
mciGetErrorString(RetVal, ErrorString, Len(ErrorString))
ErrorString = VB.Left(ErrorString, InStr(ErrorString, vbNullChar) - 1)
If deviceIsOpen Then
CommandString = "Close AVIFile"
mciSendString(CommandString, vbNullString, 0, 0)
End If
Err.Raise(999, , ErrorString)
End Sub
Private Sub Button1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Button1.Click
OpenFileDialog1.ShowDialog()
PlayAVIPictureBox(OpenFileDialog1.FileName, Picture1)
End Sub |
(
