Dynamic Libraries (Windows)

[Petr]

This version is more stable, none child / parent handle. Previous version freeze after 2 minutes (divX video), this not, is stable:

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 cm As String, e As Long

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



' 1) Open

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

e = mciSendStringA&(cm, dummy, 0, 0): MCI_Check e, cm



' 2) Attach to QB64 window handle (more stable than parent/style child)

cm = "window " + aliasName + " handle " + LTrim$(Str$(hwnd))

e = mciSendStringA&(cm, dummy, 0, 0): MCI_Check e, cm



' 3) Set destination rect (not "put window at")

cm = "put " + aliasName + " destination at 0 0 800 600"

e = mciSendStringA&(cm, dummy, 0, 0): MCI_Check Err, cm



' 4) Play

cm = "play " + aliasName

e = mciSendStringA&(cm, dummy, 0, 0): MCI_Check Err, cm



Do

    _Limit 60

    _Display ' let s messages going and window as active (QB64 help)

Loop Until InKey$ <> ""

Dim N As Long

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

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

End



Sub MCI_Check (errsCode As Long, where As String)

    Dim n As Long

    If errsCode <> 0 Then

        Dim msg As String

        msg = Space$(256)

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

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

        Print RTrim$(msg)

        Sleep

        End

    End If

End Sub