MCI Video Wrapper

[Petr Schreiber]

MCI Video Wrapper

Set of functions based on Multimedia Control Interface.
Include file allows to play movie files inside ThinBasic UI windows or even controls.
This function set is used in multiple ThinBasic projects, but I thought it is good idea to keep latest version on one place ... here :)

Author: Mike Hartlef, few modifications by Psch


Latest update
27-06-2008

[ErosOlmi]

This interface can be considered for a dedicated module.
I will see if I can work on this for next thinBasic release.

Eros

[kryton9]

THanks Petr and Mike. Glad it will be a new module for us Eros in future releases.

[Michael Hartlef]

Thanks Petr for the modifications. Never thought that this include file would deserve its own topic.

[kryton9]

It does as we learn how to use a video texture with sound too for other effects, like talking big heads on screen in future Big Brother Government type games :) Always nice to see those kind of screens in movies and games at least for me... very symbolic and mood setting.

[catventure]

Hi Mike, Petr.

The "mciVideo.inc" file does not seem compatible with latest preview thinbasic 1.7.0.0 released 08 Nov 2008...

I get error report:

Error Code: 4
Error Description: Equal Sign Expected
Line Number: 58
Code: FUNCTION OPENMOVIE (MVHWND AS LONG, MVFILENAME AS STRING) AS LONG

Token Found: WANTREPEATMOVIE

This does not happen in TB Stable Release 1.6.0.10

Regards,
catventure.

[ErosOlmi]

catventure,

here it is working fine with latest thinbasic 1.7.0.0 preview version.
Example attached. Let me know if it is working on your side.

Eros

[catventure]

Hi Eros,

Yes. That example you posted works OK.
I will see if I can track down the source of the problem.

Cheers,
catventure.

[Petr Schreiber]

Hi Catventure,

the include file works for me too.
It must be something before you include it ( maybe ? ).


Petr

[catventure]

Hi,

This wrapper is great for use in TAB adventure writing program and allows the writer/creator ro make .wmv video files to show in games.


On Vista I can play different size vids in my program and youtube vids for instance as long as they converted in .wmv format for the mcivideo.INC commands to work.
And they are positioned and sized correctly by my below bits of code.

HOWEVER - For some reason that I can't figure this code is not displaying the video in the box at the correct size or position in the demo I posted on some people's systems!!




'Plays movie in listview control
'========================
'========================


IF INSTR( checkact, "playmovie2" ) = 1 AND displaymode = 2 THEN
Local filename As String
filename = APP_SourcePath + gfxfolder + Mid$( checkact, 11 )
IF FILE_EXISTS( filename ) = %FALSE THEN
MSGBOX hwnd, filename + " does not exist.", %MB_ICONERROR OR %MB_OK, "TAB Warning"
EXIT FUNCTION
ELSE

Local hCanvas As Long

Control Handle hwnd, %id_listview2 To hCanvas

Local twidth, theight As Long




Dialog Get Size hcanvas To twidth, theight

MENU SET STATE hpopup1, BYCMD %ID_OPEN, %MF_DISABLED OR %mf_grayed
MENU SET STATE hpopup1, BYCMD %ID_NEWGAME, %MF_DISABLED OR %mf_grayed
MENU SET STATE hpopup1, BYCMD %ID_SAVEGAME, %MF_DISABLED OR %mf_grayed
MENU SET STATE hpopup1, BYCMD %ID_LOADGAME, %MF_DISABLED OR %mf_grayed
MENU SET STATE hpopup1, BYCMD %transcript, %MF_DISABLED OR %mf_grayed
MENU Set State hpopup1, ByCMD %transcriptoff,%MF_DISABLED Or %MF_GRAYED
MENU Set State hpopup1, ByCMD %id_exitgame, %MF_DISABLED Or %MF_GRAYED


OpenMovie( hCanvas, filename )
PlayMovie( )
PlaceMovie( 0, 0, twidth*2, theight*2 )

movieon = 1
Dialog Disable hwnd

Do
Control Set Focus hwnd,%id_richedit4
IF GETWINDOWKEYSTATE( hwnd, %vk_escape ) THEN
videoescapekey
EXIT DO
END IF
If IsMoviePlaying( ) = %FALSE And movieon > 0 Then
videoescapekey




END IF
LOOP UNTIL movieon = 0
EXIT FUNCTION
END IF
END IF
'==========================





' Tried using label control INSTEAD and also with label control on top of listview control as below




'Plays movie in LABEL control overlaid over listbox control
'==============================================
'===============================================




IF INSTR( checkact, "playmovie2" ) = 1 AND displaymode = 2 THEN
Local filename As String
filename = APP_SourcePath + gfxfolder + Mid$( checkact, 11 )
IF FILE_EXISTS( filename ) = %FALSE THEN
MSGBOX hwnd, filename + " does not exist.", %MB_ICONERROR OR %MB_OK, "TAB Warning"
EXIT FUNCTION
ELSE

Local hCanvas As Long


Control Handle hwnd, %id_listview2 To hCanvas

Local twidth, theight, xloc, yloc As Long

Dialog Get Size hcanvas To twidth, theight

Dialog Get Loc hcanvas To xloc, yloc

Control Add Label, hwnd, %ID_textview, "", xloc, yloc, twidth, theight, %SS_BITMAP
'
Control Handle hwnd, %id_textview To hCanvas

MENU SET STATE hpopup1, BYCMD %ID_OPEN, %MF_DISABLED OR %mf_grayed
MENU SET STATE hpopup1, BYCMD %ID_NEWGAME, %MF_DISABLED OR %mf_grayed
MENU SET STATE hpopup1, BYCMD %ID_SAVEGAME, %MF_DISABLED OR %mf_grayed
MENU SET STATE hpopup1, BYCMD %ID_LOADGAME, %MF_DISABLED OR %mf_grayed
MENU SET STATE hpopup1, BYCMD %transcript, %MF_DISABLED OR %mf_grayed
MENU Set State hpopup1, ByCMD %transcriptoff,%MF_DISABLED Or %MF_GRAYED
MENU Set State hpopup1, ByCMD %id_exitgame, %MF_DISABLED Or %MF_GRAYED


OpenMovie( hCanvas, filename )
PlayMovie( )
PlaceMovie( 0, 0, twidth*2, theight*2 )

movieon = 1

Dialog Disable hwnd
CONTROL DISABLE hwnd, %id_textbox2
DO
IF GETWINDOWKEYSTATE( hwnd, %vk_escape ) THEN
videoescapekey
EXIT DO
END IF
IF IsMoviePlaying( ) = %false AND movieon > 0 THEN
closemovie( )
movieon = 0
dialog enable hwnd
MENU SET STATE hpopup1, BYCMD %ID_OPEN, %MF_ENABLED
MENU SET STATE hpopup1, BYCMD %ID_NEWGAME, %MF_ENABLED
MENU SET STATE hpopup1, BYCMD %ID_SAVEGAME, %MF_ENABLED
MENU SET STATE hpopup1, BYCMD %ID_LOADGAME, %MF_ENABLED
MENU SET STATE hpopup1, BYCMD %transcript, %MF_ENABLED
MENU Set State hpopup1, ByCMD %transcriptoff, %MF_ENABLED
MENU Set State hpopup1, ByCMD %id_exitgame, %MF_ENABLED
CONTROL KILL hwnd, %id_textview
CONTROL ENABLE hwnd, %id_textbox2
GETWINDOWKEYSTATE( hwnd, - 1 )
CONTROL SET TEXT hwnd, %id_textbox2, ""
CONTROL SET FOCUS hwnd, %id_textbox2
END IF
LOOP UNTIL movieon = 0
EXIT FUNCTION
END IF
END IF
'==========================




Eros, Petr or Michael,


Can you cast an eye over the code I posted and detect if I did something wrong when calling the video routines for placing and sizing the video?

Works great on mine (Vista) and vids, small or large or perfectly sized into graphicbox control like in lower box of the image attached:

10221

catventure.


PS. It requires the "winmm.dll" to be present in the users system32 folder! Would the mcivideo.INC still in fact work on windows 7 or 10?


I wanted my program to work on all windows from XP onwards that why I am still using older version of thinbasic to keep compatibility with XP

Any help appreciated.

[Petr Schreiber]

Hi Catventure,

I am sorry you observe issues.

The winmm.dll is present on my Windows 10.

MCI stands for Media Control Interface and it is a "black box" provided by Windows:
https://docs.microsoft.com/en-us/windows/win32/multimedia/mci-reference

mciVideo.inc is a wrapper Mike prepared 12 years ago.

The error in playback can be caused by range of reasons - bad graphic driver, missing video codec, for example.

I think there is also an error in the... error handling part of mciVideo.inc:


j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))


The j is not declared. Please declare it as Int32/Long somewhere before the call.

Then you should receive text error message from Microsoft, which may help you go further.


Petr

[catventure]

Thanks Petr, I will try your idea - but on mine no error message occurs...

I will send it to my tester to try again and see if any error message happens.

I have had to stop downloads of the TAB graphic versions until I can resolve this - but the text -only version can still be obtained from my site as their are no such issues with that release.

-catventure (Phil)

[DirectuX]

I have had to stop downloads of the TAB graphic versions until I can resolve this
-catventure (Phil)

Just an idea, but you could let it available with a known bug under investigation message... for people who doesn't put videos but just pictures.

[DirectuX]

Catventure, what happens if you provide your winmm.dll vista-version in the app folder (#BUNDLE File) ?

[catventure]

Just an idea, but you could let it available with a known bug under investigation message... for people who doesn't put videos but just pictures.

Hi DirectuX,

Yes - I will do something like that soon, I think. It's a good idea.
There are not many users so far - so it not a biggie.
Yes the pictures seem to load Ok - so I think can be used without videos temporarily.

catventure.

[catventure]

Catventure, what happens if you provide your winmm.dll vista-version in the app folder (#BUNDLE File) ?

Didn't think of that. Do you mean so that the dll would be bundled and be placed in the same directory as the .exe file?


Regards,
catventure.

[DirectuX]

Didn't think of that. Do you mean so that the dll would be bundled and be placed in the same directory as the .exe file?


Regards,
catventure.

Yes,

but I don't know if it has to be with the exe or with thinbasic.exe

I can try for you if you want

[catventure]

Hi Catventure,

The error in playback can be caused by range of reasons - bad graphic driver, missing video codec, for example.

I think there is also an error in the... error handling part of mciVideo.inc:


j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))


The j is not declared. Please declare it as Int32/Long somewhere before the call.

Petr

Hi Petr,

I seem to have a later version which has already corrected the error you reported
Instead of j it uses:
DIM MCI_retValue as long

' ******************************************************
' * thinBasic MCI Video Playback *
' * by *
' * Michael Hartlef *
' * Email: contact@michaelhartlef.de *
' * *
' * Version: 1.11 (March 25th, 2007) *
' ******************************************************
' * Unofficial tweak by PSCH ( July 27th, 2008) *
' * - msgboxes use movie window handle *
' * - added media repetition *
' * - updated IsMoviePlaying to handle repeat *
' ******************************************************


' **************************************************************************************************************************
' * Command set:
' *
' * n = OpenMovie(mvhWnd as long, mvfilename as string) ' Returns %TRUE if the movie could be open
' * CloseMovie() ' Closes a movie
' * PlaceMovie(xpos as long, ypos as long, width as long, height as long) ' Place and size a movie
' * PlayMovie(mvWait as long, mvRepeat as long) ' if mvWait is %TRUE, the app is on hold till movie is finished
' * ' if mvRepeat is %TRUE, then movie is played in loop
' * n = MovieGetLength() ' Returns the length of the movie in frames
' * n = MovieGetPosition() ' Returns the current position of a playing movie
' * n = IsMoviePlaying() ' Returns %TRUE if the movie is still playing
' * UpdateMovie() ' Could be used to redraw the whole frame
' *
' **************************************************************************************************************************


uses "File"


' *----------------------------------------------------*
' * API Declarations *
' *----------------------------------------------------*
DECLARE FUNCTION mciSendString LIB "WINMM.DLL" ALIAS "mciSendStringA" (byval lpstrCommand as long, BYval lpstrReturnString as long, BYVAL uReturnLength AS LONG, byval hwndCallback as long) AS LONG
Declare Function mciGetErrorString Lib "winmm.dll" Alias "mciGetErrorStringA" (ByVal fdwError As Long, byval lpszErrorText As long, ByVal cchErrorText As Long) As Long
Declare Function GetDC Lib "user32.dll" Alias "GetDC" (ByVal hWnd As Long) As Long
Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" (ByVal lpszLongPath As long, ByVal lpszShortPath As long, ByVal cchBuffer As Long) As Long

' *----------------------------------------------------*
' * Data declarations *
' *----------------------------------------------------*
dim MciMvhWnd as long = 0
dim MciMvhdc as long = 0
dim sMvFilename as asciiz * 257
dim mvMciCmd as asciiz * 257
dim mvSReturn as asciiz * 257
dim mvi, mvj as long
dim fileext as long
DIM ismovie as long = %FALSE
dim WantRepeatMovie as long
DIM MCI_retValue AS LONG



' *----------------------------------------------------*
' * Function OpenMovie *
' *----------------------------------------------------*
function OpenMovie(mvhWnd as long, mvfilename as string) as long
fileext = iif(ucase$(FILE_PATHSPLIT(mvfilename, %Path_FileExt))="AVI", 1, 2)

smvfilename = mvfilename
MciMvhWnd = mvhWnd
MciMvhdc = GetDc(mvhWnd)

if fileext = 1 then
mvMciCmd = "open "+chr$(34)+sMvFilename+chr$(34)+" Type AVIVideo Alias video1 "
else
mvMciCmd = "open "+chr$(34)+sMvFilename+chr$(34)+" Type MPEGVideo Alias video1 "
endif

if MciMvhWnd <> 0 then mvMciCmd = mvMciCmd + "parent"+str$(MciMvhWnd)+" Style"+Str$(&h40000000)


mvi = mciSendString(varptr( mvMciCmd), 0,0,0)

if mvi <> 0 then
MCI_retValue = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(MciMvhWnd,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->OpenMovie")
function = %False
else
ismovie = %TRUE
function = %True
endif

end function

' *----------------------------------------------------*
' * SUB PlaceMovie *
' *----------------------------------------------------*
sub PlaceMovie(x as long, y as long, w as long, h as long)
if ismovie = %TRUE then
if MciMvhWnd <> 0 then
mvMciCmd = "put video1 window at"+str$(x)+str$(y)+str$(w)+str$(h)
mvi = mciSendString(varptr(mvMciCmd),0,0,0)
if mvi <> 0 then
MCI_retValue = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(MciMvhWnd,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->PlaceMovie")
endif
endif
endif
end sub


' *----------------------------------------------------*
' * SUB CloseMovie *
' *----------------------------------------------------*
Sub CloseMovie()
if ismovie = %TRUE THEN
mvMciCmd = "close video1"
mvi = mciSendString(varptr(mvMciCmd),0,0,0)
if mvi <> 0 then
MCI_retValue = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(MciMvhWnd,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->CloseMovie")
endif
ismovie = %FALSE
ENDIF
end sub

' *----------------------------------------------------*
' * SUB PlayMovie *
' *----------------------------------------------------*
Sub PlayMovie(mvWait as long, optional mvRepeat as long = 0)
if ismovie = %TRUE THEN


WantRepeatMovie = iif(mvRepeat <> %FALSE, %TRUE, %FALSE)

mvMciCmd = "play video1 "+IIF$(mvWait <> %FALSE, "wait ", "")+IIF$(mvRepeat <> %FALSE, "repeat ", "")


mvi = mciSendString(varptr(mvMciCmd),0,0,0)
if mvi <> 0 then
MCI_retValue = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(MciMvhWnd,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->PlayMovie")


else
if mvWait = %TRUE then CloseMovie()


endif


endif

end sub




' *----------------------------------------------------*
' * Function MovieGetLength *
' *----------------------------------------------------*
function MovieGetLength() as long
if ismovie = %TRUE THEN
mvMciCmd = "status video1 length"
mvi = mciSendString(varptr(mvMciCmd),varptr(mvSReturn),sizeof(mvSReturn),0)
if mvi <> 0 then
MCI_retValue = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(MciMvhWnd,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn, %MB_ICONERROR, "Error->MovieGetLength")
function = -1
else
function = val(mvSReturn)
endif
else
function = -1
ENDIF
end function

' *----------------------------------------------------*
' * Function MovieGetPosition *
' *----------------------------------------------------*
function MovieGetPosition() as long
if ismovie = %TRUE THEN
mvMciCmd = "status video1 position"
mvi = mciSendString(varptr(mvMciCmd),varptr(mvSReturn),sizeof(mvSReturn),0)
if mvi <> 0 then
MCI_retValue = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(MciMvhWnd,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->MovieGetPosition")
function = -1
else
function = val(mvSReturn)
endif
else
function = -1
ENDIF

end function

' *----------------------------------------------------*
' * Function IsMoviePlaying *
' *----------------------------------------------------*
function IsMoviePlaying() as long
dim mp as long = -1
dim ml as long = -1

if isMovie = %True then

if WantRepeatMovie <> %FALSE THEN return %TRUE

mp = MovieGetPosition()
ml = movieGetLength()


return iif( ml <= mp, %FALSE, %TRUE )
else
function = %FALSE
endif

end function

' *----------------------------------------------------*
' * Sub UpdateMovie() *
' *----------------------------------------------------*
sub UpdateMovie()
if isMovie = %True then
if isMoviePlaying() = %TRUE then
mvMciCmd = "update video1 hdc "+str$(MciMvhdc)
mvi = mciSendString(varptr(mvMciCmd),0,0,0)
if mvi <> 0 then
MCI_retValue = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(MciMvhWnd,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->UpdateMovie")
endif
endif
endif

end sub

'===================end==========

Thanks,
catventure.

[Petr Schreiber]

Catventure,

I have to admit I have very limited experience with video embedding, but another idea occurred to me.

ThinBASIC allows you to put WebBrowser control into dialog - could it be alternative way to embedd the video?

In the meantime - error message from the user would be useful.


Petr

[catventure]

Thanks Petr,

I have solved the issue I had by changing my Player dialog window to using PIXELS instead of Dialog UNITS and am happy to say that the video code routine now works correctly across all Windows from XP.

This is now closed.

Thank you for your valuable help and suggestions.

Best regards,
catventure/Phil.

[Petr Schreiber]

Thanks for getting back with the solution, I am sure it can be handy for other users. Thanks!


Petr