Play movies with sound inside TBGL windows

[Michael Hartlef]

Hi folks,

I was a little quite the last days, but it was for a good reason. Please welcome...

Movie playback inside TBGL windows ;D

The animation was a quick job, so please be nice ;) For the sample I took one of Petr's samples. I hope you don't mind.

Have fun
Michael

Edit2: New zip includes latest files.

[ErosOlmi]

That's really a fantastic present.
I cannot imagine Ken and Petr faces ;D

For all, Mike is looking to add few more util functions to determine if movie is still running so it will be possible to close when done and leave the screen to to game.
Also function to determine if movie has to be closed or not because already closed.

Anyhow thanks again.
Eros

[Petr Schreiber]

Hi Mike,

this is perfect video !
I have just one problem, which is probably related to driver settings/codecs.
If I take your script as is, I can hear only the sound and see 3D environment + fonts.

When I remove all rendering commands, and let just while/wend and ESC checking, it works good, although little bit slow.
Also I had to put on top of script "DOEVENTS ON", with OFF setting it plays music till end, but video stops after some time.

With no WHILE/WEND, just SLEEP 7000 it runs great.

I will try to seek for reason, it is probably specific to my PC.

Thanks a gigalot!,
Petr

[Michael Hartlef]

Hi Petr,

I had the same problem on my comp at work, when you move the window, you see that it interfears with the TBGL_CLEARFRAME command. I was hoping that it was the trashy system I have there. Must be graphiccard related I guess.

Here at home everything runs fine. I will see if I can create some update command, that you can call each frame.

By the way, here is a new version, with some status commands:

Edit: New UpdateMovie function (I thought it might help Petr, but it didn't)


' ******************************************************
' * thinBasic MCI Video Playback *
' * by *
' * Michael Hartlef *
' * Email: contact@michaelhartlef.de *
' * *
' * Version: 1.1 (March 25th, 2007) *
' ******************************************************

' **************************************************************************************************************************
' * 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) ' if mvWait is %TRUE, the app is on hold till movie is finished
' * 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"
USES "UI"

' *----------------------------------------------------*
' * 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

' *----------------------------------------------------*
' * 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


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

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

'mvMciCmd = "open f:\bot.wmv Type MPEGVideo Alias video1 parent"+str$(hWnd)+" Style"+Str$(&h40000000)
'mvMciCmd = "open e:\bot.wmv type MPEGVideo alias video1"
if fileext = 1 then
'mvMciCmd = "open "+sMvFilename+" Type AVIVideo Alias video1 parent"+str$(mvhWnd)+" Style"+Str$(&h40000000)
mvMciCmd = "open "+sMvFilename+" Type AVIVideo Alias video1 "
else
'mvMciCmd = "open "+sMvFilename+" Type MPEGVideo Alias video1 parent"+str$(mvhWnd)+" Style"+Str$(&h40000000)
mvMciCmd = "open "+sMvFilename+" Type MPEGVideo Alias video1 "
endif
if MciMvhWnd <> 0 then
mvMciCmd = mvMciCmd + "parent"+str$(MciMvhWnd)+" Style"+Str$(&h40000000)
endif
mvi = mciSendString(varptr( mvMciCmd), 0,0,0)
if mvi <> 0 then
j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(0,"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 10 10 220 160"
mvMciCmd = "put video1 window at"+str$(x)+str$(y)+str$(w)+str$(h)
mvi = mciSendString(varptr(mvMciCmd),0,0,0)
if mvi <> 0 then
j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(0,"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
j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(0,"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)
if ismovie = %TRUE THEN
if mvWait = %TRUE then
mvMciCmd = "play video1 wait"
else
mvMciCmd = "play video1"
endif
mvi = mciSendString(varptr(mvMciCmd),0,0,0)
if mvi <> 0 then
j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(0,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->PlayMovie")
else
if mvWait = %TRUE then
CloseMovie()
endif
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
j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(0,"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
j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(0,"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
mp = MovieGetPosition()
ml = movieGetLength()
if ml <= mp then
function = %FALSE
else
function = %TRUE
endif
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
j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(0,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->UpdateMovie")
endif
endif
endif

end sub

[Michael Hartlef]

Btw, to you have Verticalsync set OFF in your graphiccard driver settings? I have it ON.

[Petr Schreiber]

Hi Mike,

on or off - it does not make difference on my PC :(
But it was good idea.

Another observation:


' ******************************************************
' * thinBasic testscript for MCI Video Playback *
' ******************************************************

uses "UI"
#INCLUDE once "%APP_INCLUDEPATH%\mciVideo.inc"

dim hWnd as dword

dim xres, yres as long

desktop get size to xres, yres

DIALOG NEW PIXELS, 0, "Video", 0, 0,xres,yres, %WS_POPUP OR %DS_SETFOREGROUND to hWnd
dialog set color hWnd, %BLACK, %BLACK
DIALOG SHOW MODELESS hwnd

'---Resets key status before checking
GetAsyncKeyState(-1)

dim t1 as dword = gettickcount
'---Load a movie file and play it
if OpenMovie(hWnd, APP_SOURCEPATH+"thinBasicTheme.mpeg") = %True then
PlaceMovie(0,yres-xRes/600*200,xRes,xRes/600*200)
PlayMovie(%TRUE)
endif

do
if iswindow(hwnd) then
if gettickcount > t1 + 8200 or getasynckeystate(%VK_ESCAPE) or getasynckeystate(%VK_space) or getasynckeystate(%VK_RETURn) then exit do
sleep 0
end if
loop

CloseMovie()
dialog end hWnd


This way it works ok, but with PlayMovie(%FALSE) I can see only first frame and then it disappears.


Bye,
Petr

[Michael Hartlef]

Here is the new test script for the ones who downloaded the initial version:


' ******************************************************
' * thinBasic testscript for MCI Video Playback *
' ******************************************************

Uses "TBGL"
uses "UI"
#INCLUDE once "mciVideo.inc"

dim hWnd as long
Dim i, j As long
dim xres, yres as long
Dim CamDeltaMove, CamDeltaAngle, CamAngleLR, CamPointToX, CamPointToY, CamPointToZ, CamPosX, CamPosY, CamPosZ As Single
Dim ThisTime, LastTime, TimeDelta as dword

yres = 480 : xres = 640

hWnd = TBGL_CreateWindowex("Movie playback test inside a TBGL window",xres,yres,32,0)
TBGL_ShowWindow
Tbgl_LoadBMPFont App_SourcePath+"TBGL_Font.bmp" ' Loads texture for font

GetAsyncKeyState(%VK_ESCAPE) ' Resets keys status before checking

tbgl_UseLighting 1
tbgl_uselightsource %gl_light1, 1
tbgl_setlightparameter %gl_light1, %tbgl_light_ambient, 0.5, 0.5, 0.5, 1
tbgl_setlightparameter %gl_light1, %tbgl_light_diffuse, 1, 1, 1, 1


'---The alture in which the observers eyes are situated
CamPosY = 1.75

'---Resets key status before checking
GetAsyncKeyState(%VK_SPACE)
GetAsyncKeyState(%VK_ESCAPE)
GetAsyncKeyState(%VK_UP)
GetAsyncKeyState(%VK_DOWN)
GetAsyncKeyState(%VK_PGUP)
GetAsyncKeyState(%VK_PGDN)
GetAsyncKeyState(%VK_RIGHT)
GetAsyncKeyState(%VK_LEFT)


'---Load a movie file and play it
'if OpenMovie(hWnd, "f:\bot.wmv") = %True then
'if OpenMovie(hWnd, APP_SOURCEPATH+"thinBasicTheme.mpeg") = %True then
if OpenMovie(hWnd, APP_SOURCEPATH+"thinBasicTheme.mpeg") = %True then
PlaceMovie(20,120,600,200)
PlayMovie(%FALSE)
'CloseMovie()
endif
while IsWindow(hWnd)

' *******************************
' * RENDERING THE SCENE *
' *******************************
tbgl_ClearFrame
' tbgl_viewport 0.5,0.5,1,1

'---Script will run on different PCs so we must assure
'---constant speed of movement
LastTime = ThisTime
ThisTime = GetTickCount
TimeDelta= ThisTime-LastTime
If TimeDelta = 0 THEN TimeDelta = 1

tbgl_color 255,50,50
tbgl_printBMP "thinBasic - The T experience",1,1
tbgl_printBMP "MouseX: "+STr$(tbgl_MouseGetPosX),1,2
tbgl_printBMP "MouseY: "+Str$(tbgl_MouseGetPosY),1,3
tbgl_printBMP "MoviePosition: "+str$(MovieGetPosition()),1,22
tbgl_printBMP "MovieLength: "+str$(MovieGetlength()),1,23
tbgl_printBMP "ISMoviePlaying: "+str$(ISMoviePlaying()),1,24
'---Setups camera
TBGL_Camera CamPosX, CamPosY, CamPosZ, _
CamPosX + CamPointToX, CamPosY, CamPosZ + CamPointToZ
'---Let's build a grid
TBGL_BeginPoly %GL_LINES ' Starts polygon definition based on 2 vertex lines
TBGL_Color 0,255,0 ' Defines color

For i = -10 To 10
For j = -10 To 10
TBGL_Vertex -10, 0, j ' Adds vertex
TBGL_Vertex 10, 0, j ' Adds vertex

TBGL_Vertex i, 0, -10 ' Adds vertex
TBGL_Vertex i, 0, 10 ' Adds vertex

Next
Next

TBGL_EndPoly ' Ends polygon definition


tbgl_DrawFrame
if isMoviePlaying() = %FALSE then
CloseMovie()
else
UpdateMovie()
endif
if GetAsyncKeyState(%VK_UP) then CamDeltaMove = 0.02 * TimeDelta
if GetAsyncKeyState(%VK_DOWN) then CamDeltaMove = -0.02 * TimeDelta

if GetAsyncKeyState(%VK_PGUP) then CamPosY += 0.02 * TimeDelta
if GetAsyncKeyState(%VK_PGDN) then CamPosY -= 0.02 * TimeDelta

if GetAsyncKeyState(%VK_RIGHT) then CamDeltaAngle = +0.002 * TimeDelta

if GetAsyncKeyState(%VK_LEFT) then CamDeltaAngle = -0.002 * TimeDelta

if GetAsyncKeyState(%VK_ESCAPE) then EXIT WHILE

' Some math to calculate the next position
CamAngleLR = CamAngleLR + CamDeltaAngle
CamPointToX = SIN(CamAngleLR)
CamPointToZ = -COS(CamAngleLR)

CamPosX = CamPosX + CamDeltaMove * CamPointToX
CamPosZ = CamPosZ + CamDeltaMove * CamPointToZ

CamDeltaMove = 0
CamDeltaAngle = 0
wend
CloseMovie()
TBGL_DestroyWindow

[kryton9]

I am dieing in anticipation here to see what wonderful new thing Mike came up with. I get this error in the picture below.
After I click it ok, I get the green grid some nice info readouts, but no sound or movie.

Can't wait to see it in action!!

Thanks in advance Mike, this is really something to have video in the program!!

[Michael Hartlef]

Not sure if it is the path with spaces in between. Can you try to run it from a folder without spaces in the path?
Which MS Movie Player version do you have installed?

I guess me and Eros are the only ones who can use it without problems.

[Michael Hartlef]

Yip, that's it. It doesn't like paths with spaces. HEre is a fix for the include file.
Please exchange the OpenMove function with this code:


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

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

'mvMciCmd = "open f:\bot.wmv Type MPEGVideo Alias video1 parent"+str$(hWnd)+" Style"+Str$(&h40000000)
'mvMciCmd = "open e:\bot.wmv type MPEGVideo alias video1"
if fileext = 1 then
'mvMciCmd = "open "+sMvFilename+" Type AVIVideo Alias video1 parent"+str$(mvhWnd)+" Style"+Str$(&h40000000)
mvMciCmd = "open "+chr$(34)+sMvFilename+chr$(34)+" Type AVIVideo Alias video1 "
else
'mvMciCmd = "open "+sMvFilename+" Type MPEGVideo Alias video1 parent"+str$(mvhWnd)+" Style"+Str$(&h40000000)
mvMciCmd = "open "+chr$(34)+sMvFilename+chr$(34)+" Type MPEGVideo Alias video1 "
endif
if MciMvhWnd <> 0 then
mvMciCmd = mvMciCmd + "parent"+str$(MciMvhWnd)+" Style"+Str$(&h40000000)
endif
mvi = mciSendString(varptr( mvMciCmd), 0,0,0)
if mvi <> 0 then
j = mciGetErrorString(mvi,varptr(mvSReturn),sizeof(mvSReturn))
msgbox(0,"Command: "+mvMciCmd+crlf+"Errorcode:"+str$(mvi)+crlf+"Errormsg: "+mvSReturn,%MB_ICONERROR, "Error->OpenMovie")
function = %False
else
ismovie = %TRUE
function = %TRue
endif

end function

I will upload a new complete zip in a few seconds.

[Michael Hartlef]

New version is uploaded in the first post.

[kryton9]

Oh Wow Mike, Awesome!!! What a great feature to have, thanks so much!

Your new animation movie is very very nice too. The music and the way the logo rises with the reflective surface, very very sweet!!

What a combo of wonderfulness!!

[Michael Hartlef]

Thanks Kent,

unfortunately, when someone has a system like Petr (newage WinME with Media Player 7 :P ) you can't have a regular TBGL frame cycle and animation at the same time. I think it has something to do with Windows Media Player as I have at work WinXP Pro SP2 with Version 7 of the media player and it shows the same symtoms. Well could be graphic card driver too, as these surely are not uptodate and the graficcard is also a week one.

[Petr Schreiber]

Hi,

just to clarify ( Mike knows it ):

On my PC it is not possible to play video and render scene at the same time, but there is no problem playing video in TBGL window when I am not rendering 3D. So for TopDown game purposes I think it is ok.

Mike, how could you call my precious Radeonito 9600 a week card :D I know it is not latest hardware, but it has so great performance in OpenGL I wonder if I will ever change it for other :P Really amazing one. Especially comparing to Radeon 7000 I had before...


Bye,
Petr

[Michael Hartlef]

I was talking about the system I have at work. :)

But I think it is more Media Player related as MCI uses functionalities of it in the background I think. Question, why didn't you install MP9? Because of this message that you can't roll back after it?

Michael

[Petr Schreiber]

Hi Mike,

I know I am coward, but I am happy how my system is running now.
Installation said I need to go through Windows Update to get my PC ready for this update.
I appreciate MS is patching their OS, but I do not want to change any system stuff now as all is working as should ( knock knock on the wood ).

I am sorry


Petr

[Michael Hartlef]

Nothing to be sorry about, I was just curious.