AVI Dosyalarını PictureBox İçinde Oynatmak


PictureBox içerisinde oynayan Avi dosyası PictureBox boyutuna göre Resize olur

Gerekenler


Formunuza 1 adet buton ve 1 adet PictureBox ekleyin



Aşağıdakileri Modüle kopyalayın


Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

Declare Function mciGetErrorString Lib "winmm" Alias "mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal uLength As Long) As Long

Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Public Const WS_CHILD = &H40000000



Aşağıdakileri de forma kopyalayın


Sub PlayAVIPictureBox(FileName As String, ByVal Window As PictureBox)

Dim RetVal As Long

Dim CommandString As String

Dim ShortFileName As String * 260

Dim deviceIsOpen As Boolean



'Dosya adı shortfilename formatına çevriliyor



RetVal = GetShortPathName(FileName, ShortFileName, Len(ShortFileName))

FileName = Left$(ShortFileName, RetVal)



'Avi oynatıcı açılıyor



CommandString = "Open " & FileName & " type AVIVideo alias AVIFile parent " & CStr(Window.hWnd) & " style " & CStr(WS_CHILD)

RetVal = mciSendString(CommandString, vbNullString, 0, 0&)

If RetVal Then GoTo error

deviceIsOpen = True



'Aviyi PictureBox'a göre yeniden boyutlandır



CommandString = "put AVIFile window at 0 0 " & CStr(Window.ScaleWidth / Screen.TwipsPerPixelX) & " " & CStr(Window.ScaleHeight / Screen.TwipsPerPixelY)

RetVal = mciSendString(CommandString, vbNullString, 0, 0&)

If RetVal <> 0 Then GoTo error



'Dosyayı Oynat



CommandString = "Play AVIFile wait"

RetVal = mciSendString(CommandString, vbNullString, 0, 0&)

If RetVal <> 0 Then GoTo error

'Avi Oynatıcıyı kapat

CommandString = "Close AVIFile"

RetVal = mciSendString(CommandString, vbNullString, 0, 0&)

If RetVal <> 0 Then GoTo error

Exit Sub

error:



'Hata meydana gelmesi durumunda hata açıklaması



Dim ErrorString As String

ErrorString = Space$(256)

mciGetErrorString RetVal, ErrorString, Len(ErrorString)

ErrorString = Left$(ErrorString, InStr(ErrorString, vbNullChar) - 1)



'Zorunluluk halinde dosya kapansın



If deviceIsOpen Then

CommandString = "Close AVIFile"

mciSendString CommandString, vbNullString, 0, 0&

End If



'Uygun açıklama için error kodlarını derleyin



Err.Raise 999, , ErrorString

End Sub

Private Sub Command1_Click()



'aşağıdaki dosyanın yerini kendiniz belirleyin



PlayAVIPictureBox "c:\myfile.avi", Picture1

End Sub