Dynamic Libraries (Windows)

[Petr]

@Pete

First question. Does the video that doesn't play play in VLC, or WMP, or a media player? What operating system are you using for that?

Attached is an MJPG video with ADPCM sound (output of a program written in QB64PE without C language) - the quality is terrible but it's for the purpose of testing the function for you. This video plays in this player for me. How does it work for you? Do you have the necessary codecs on your computer? There were 2 small bugs in that program that test the error return code, but that doesn't affect the playback itself. Try it and let me know.

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 = "aaa_dop.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 e, cm



' 4) Play

cm = "play " + aliasName

e = mciSendStringA&(cm, dummy, 0, 0): MCI_Check e, 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

ZIP file contains 20 seconds AVI (MJPG/ADPCM)