Dynamic Libraries (Windows)

[Petr]

So is it better. So it plays also Divx / Xvid codecs:

Code: (Select All)

Option _Explicit



Declare Dynamic Library "winmm"

    Function mciSendStringA& (lpstrCommand As String, lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As _Offset)

    Function mciGetErrorStringA& (ByVal dwerrsor As Long, lpstrBuffer As String, ByVal uLength As Long)

End Declare





Dim handle&: handle& = _NewImage(800, 600, 32)

Screen handle&

_Title "QB64 Video"



Dim hwnd As _Offset

hwnd = _WindowHandle



Dim filename As String, aliasName As String

filename = "(2014)na.avi"

aliasName = "vid"



Dim cmd As String

Dim errs As Long, N As Long

Dim dummy As String: dummy = Space$(1)



' Open AVI as avivideo, place it as CHILD to QB64PE window

'cmd = "open " + Chr$(34) + filename + Chr$(34) + " type avivideo alias " + aliasName + _

'      " parent " + LTrim$(Str$(hwnd)) + " style child"



cmd = "open " + Chr$(34) + filename + Chr$(34) + " type mpegvideo alias " + aliasName + _

      " parent " + LTrim$(Str$(hwnd)) + " style child"



errs = mciSendStringA&(cmd, dummy, 0, 0): MCI_Check errs, cmd



' Set window size and window postition

cmd = "put " + aliasName + " window at 0 0 800 600"

errs = mciSendStringA&(cmd, dummy, 0, 0): MCI_Check errs, cmd



' Play it

cmd = "play " + aliasName

errs = mciSendStringA&(cmd, dummy, 0, 0): MCI_Check errs, cmd



Do

    _Limit 60

Loop Until InKey$ <> ""



N = mciSendStringA&("stop " + aliasName, dummy, 0, 0)

N = mciSendStringA&("close " + aliasName, dummy, 0, 0)

End





Sub MCI_Check (errsCode As Long, where As String) 'error code handler if error occur

    Dim N As Long

    If errsCode <> 0 Then

        Dim msg As String

        msg = Space$(256)

        N = mciGetErrorStringA&(errsCode, msg, Len(msg))

        Print "MCI errsOR ("; errsCode; "): "; where

        Print RTrim$(msg)

        Sleep

        End

    End If

End Sub