A quick-and-dirty win32-only AVI player using only mmsystem

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
Eponasoft
Posts: 264
Joined: Jul 26, 2007 2:40

A quick-and-dirty win32-only AVI player using only mmsystem

Postby Eponasoft » Feb 22, 2010 22:01

I derived this from some old VB6 code I found online a bunch of years ago...it seems to work quite well, though it's win32 only since it relies on mmsystem. Of course, the beauty part is that aside from the DLLs you already have on your Windows system, this doesn't engage in DEPENDENCY HELL like most other solutions would. mmsystem is somewhat limited in its ability to utilize codecs, but that shouldn't be a problem for your own projects. Anyways, take it, run with it, perhaps even make something better...I don't care. :) I am releasing this under the WTFPL license.

Code: Select all

#include once "fbgfx.bi"
#include once "windows.bi"
#include once "win/mmsystem.bi"

Declare Function GetMCIError(lngError As Long) As String
Declare Function PlayAVI(ByVal hwnd As integer, ByVal strAVIName As String) As String

screenres 640,480,32,1,1

dim as integer result
screencontrol 2,result
screenlock
dim booyah as string
booyah = PlayAVI(result,"test.avi")
screenunlock

Function GetMCIError(lngError As Long) As String
Dim strError As String
Dim LenStr As Long
strError = Space(255)
LenStr = 254
If mciGetErrorString(lngError, strError, LenStr) Then
  GetMCIError = RTrim$(strError)
Else
  GetMCIError = "Unknown MCI Error!"
End If
End Function

Function PlayAVI(ByVal hwnd As integer, ByVal strAVIName As String) As String
Dim strAlias As String
Dim strRect As String
Dim lngError As Long
Dim strTargetWindow As String
Dim strReturn As String
Dim lngLenStr As Long
strReturn = Space(128)
lngLenStr = 127
strAlias = "PLAYAVI"
If strAVIName = "" Or Len(Dir(strAVIName)) = 0 Then
  PlayAVI = strAVIName & " was Not found!"
  Exit Function
End If
If Left(strAVIName, 1) <> """" Then strAVIName = """" + strAVIName + """"
lngError = mciSendString("open " + strAVIName + " Alias " + strAlias, strReturn, lngLenStr, 0)
If lngError = 289 Then
  lngError = mciSendString("close " + strAlias, strReturn, lngLenStr, 0)
  If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If
lngError = mciSendString("open " + strAVIName + " Alias " + strAlias, strReturn, lngLenStr, 0)
End If
If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If
lngError = mciSendString("set " + strAlias + " audio all on", strReturn, lngLenStr, 0)
If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If
strTargetWindow = "window " + strAlias + " handle " + trim$(str$(hWnd))
lngError = mciSendString(strTargetWindow, strReturn, lngLenStr, 0)
If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If
lngError = mciSendString("realize " + strAlias + " background", strReturn, lngLenStr, 0)
If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If
strRect = Space$(128)
lngError = mciSendString("where " + strAlias + " destination", strRect, Len(strRect), 0)
If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If
lngError = mciSendString("play " + strAlias + " wait", strReturn, lngLenStr, 0)
If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If
lngError = mciSendString("close " + strAlias, strReturn, lngLenStr, 0)
If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If
PlayAVI = "Success"
End Function


EDIT: Minor changes because Mysoft found LOLs in the code. It was converted from VB6, so it's not gonna be perfectly clean, okay? Maybe some of the more "perfect" coders can do this better? :P
agamemnus
Posts: 1842
Joined: Jun 02, 2005 4:48

Postby agamemnus » Feb 23, 2010 5:54

KK, thanks.

Like I said in IRC, this would be great if:

* You could use keys and mouse while it is playing.
* You could resize (with anti-alias) and reposition the thing.
* You could stick it in an irrlicht or opengl drawing loop.
xbgtc
Posts: 211
Joined: Oct 14, 2007 5:40
Location: Australia

Postby xbgtc » Mar 02, 2010 23:32

agamemnus wrote:Like I said in IRC, this would be great if:

* You could resize (with anti-alias) and reposition the thing.

This would be good!
Eponasoft
Posts: 264
Joined: Jul 26, 2007 2:40

Postby Eponasoft » Sep 12, 2010 21:38

I'm necroposting my own thread since... well, I can. :P After digging through the MCI metalanguage a bit more, here's something that will help a bit for using this in a real application:

Code: Select all

' add this right before the 'play' line
lngError = mciSendString("break " + strAlias + " on 27", strReturn, lngLenStr, 0)
If lngError Then
  PlayAVI = GetMCIError(lngError)
  Exit Function
End If

This addition will allow the movie to be stopped early by pressing the Esc key. Change the 27 to change the key that stops the playback. I might mess with this some more but I dunno... there are better methods available, even if no one really uses them. :P

In order to make it possible to play the movie into another buffer, one would need to snag the data from the "window". Also, the "break" line wouldn't be useful anymore, since you would also remove the "wait" from the "play" string. Of course, you would then also want to check the status of the playback by using the "status" command string with "mode" as a parameter... when strReturn is "stopped", playback is over. To position the movie elsewhere on the screen, there is a "put" MCI command, and there is also a "stretch" command, but it apparently only works in multiples of 2, so it can't stretch arbitrarily.
relsoft
Posts: 1767
Joined: May 27, 2005 10:34
Location: Philippines
Contact:

Postby relsoft » Sep 13, 2010 1:47

Nek: OT

Why did you cancel that darn DS RPG? WHHHHYYYYYY!!!!!

Say I make a tute on how to use the 3d HW to blit 2d sprites. Would reconsider?

Trust me, the interface would be like FBGFX (easier than actually), with no external lib dependencies. Sound is easy with maxmod too.

BTW, that darn H*nT*i game roxxors! Planning on porting another one? How about "Love Potion"?
Eponasoft
Posts: 264
Joined: Jul 26, 2007 2:40

Postby Eponasoft » Sep 14, 2010 14:32

Offtopic is always fun. :)

I stopped the development of the RPG because the scene can't get over its elitism and stop fighting. It's like the DirectQB debate all over again and I don't want any part of that rabble a second time. And I had plans to port another game or maybe even do an original one but no go on that either... 'Love Potion' was suggested before and I looked into it but I don't know. Oh, and maxmod is the essence of suck... I can't think of a worse library, even libmikmod-ds isn't as bad, and it's terrible. I'm still going to continue to host DS-related sites but as far as development goes, I'm out... besides, that RPG is being made in the most recent release of FB anyways, and this video player is being used in it. I messed around with video codecs until I found a good one that is supported by mmsystem that gives good enough compression (FOURCC code 'mp42')... it's not DivX but it does a damn good job and mmsystem handles the format great. And since the game uses all-original video content, the videos are very clean from the source.
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Postby kiyotewolf » Sep 16, 2010 23:58

o.o

I am going to use this to give KikiAI lil clips, so she can be "IN YER FACE.." when you REALLY Πss her off..



~Kiyote!
xbgtc
Posts: 211
Joined: Oct 14, 2007 5:40
Location: Australia

Postby xbgtc » Oct 09, 2010 12:41

This works well on XP but how can i get it to work on Win98SE or Vista?
kiyotewolf
Posts: 1009
Joined: Oct 11, 2008 7:42
Location: ABQ, NM
Contact:

Postby kiyotewolf » Oct 10, 2010 12:54

You'd have to try these codes out, and once you have the code you think MIGHT work, then share it here, and we can work on modifying it to work on the other platforms.

I have Win98, so I can test in Win98, easily.



~Kiyote!

Vista, I can't test, cause I HATE.. Vista.. :3
xbgtc
Posts: 211
Joined: Oct 14, 2007 5:40
Location: Australia

Postby xbgtc » Oct 10, 2010 22:17

i was only talking about playing the mpg, not anything else but this is what i use but does not work in Win98SE or Vista and i'd hate to put up a game and say "only works in XP" :)

Code: Select all

screenres 800,600,32,1,1 ' i like fullscreen
sleep 1000 'just for demo as takes a while to set fullscreen

Function PlayAVI(Byval hwnd As Integer, Byval strAVIName As String) As String
Dim strAlias As String
Dim lngError As Long
Dim strTargetWindow As String
Dim strReturn As String
Dim lngLenStr As Long
strReturn = Space(128)
lngLenStr = 127
strAlias = "PLAYAVI"
lngError = mciSendString("open " + strAVIName + " Alias " + strAlias, strReturn, lngLenStr, 0)
strTargetWindow = "window " + strAlias + " handle " + trim$(Str$(hWnd))
lngError = mciSendString(strTargetWindow, strReturn, lngLenStr, 0)
lngError = mciSendString("play " + strAlias + " wait", strReturn, lngLenStr, 0)
lngError = mciSendString("close " + strAlias, strReturn, lngLenStr, 0)
If lngError Then
  PlayAVI = "Geri Halliwell" 'need this or error
  Exit Function
End If
End Function

sub playmedia (text as string)
    text = text + ".mpg"
    Dim As Integer result
    screencontrol 2,result 'if use 1 then it opens it's own window
    Dim playthis As String
    playthis = PlayAVI(result,text)
end sub

playmedia "somefile" ' your file without the .MPG and resides in freebasic directory


Also there's another MPG playing code (although more complicated) that uses DSHOW or something and can position and resize the video and works in Win98 too but i can't get it to work 'fullscreen' nor will it close after playing the file.

Code below and resides in FreeBASIC\examples\Windows\COM\MoviePlayer

Code: Select all

#include once "windows.bi"
#include once "win/commctrl.bi"
#include once "win/ole2.bi"
#include once "movctrl/movctrl.bi"

const WIN_TITLE = "movie Test"
const WIN_WIDTH = 800
const WIN_HEIGHT = 600

const WIN_TOOLBAR_STYLE = TBSTYLE_FLAT or CCS_TOP

enum
   WIN_TOOLBAR_FIRSTID = WM_USER
   WIN_TOOLBAR_BUTTON_GOBACK = WIN_TOOLBAR_FIRSTID
   WIN_TOOLBAR_BUTTON_GOFORWARD
end enum

const WIN_TOOLBAR_BUTTONS = 2

'' globals
   dim shared as movctrl ptr movie = NULL
   dim shared as HWND toolbar = NULL
   
   dim shared as integer WIN_TOOLBAR_HEIGHT = 24

''::::
private sub movie_onresize _
   ( _
      byval wdt as integer, _
      byval hgt as integer _
   )
      
   if( movie = NULL ) then
      exit sub
   end if

   if( hgt > WIN_TOOLBAR_HEIGHT ) then
      hgt -= WIN_TOOLBAR_HEIGHT
   else
      hgt = 0
   end if
      
   movie->move( 0, WIN_TOOLBAR_HEIGHT, wdt, hgt )

end sub

''::::
private sub toolbar_onresize _
   ( _
      byval wdt as integer, _
      byval hgt as integer _
   )
   
   SendMessage( toolbar, WM_SIZE, 0, 0 )
   
end sub

''::::
private sub toolbar_onclick _
   ( _
      byval hwnd as HWND, _
      byval id as integer _
   )
   
   if( movie = NULL ) then
      exit sub
   end if

   select case as const id
   case WIN_TOOLBAR_BUTTON_GOBACK
      'movctrl_GoBack( movie )
   case WIN_TOOLBAR_BUTTON_GOFORWARD
      'movctrl_GoForward( movie )
   end select
   
end sub

''::::
private function win_cb _
   ( _
      byval hwnd as HWND, _
      byval uMsg as UINT, _
      byval wParam as WPARAM, _
      byval lParam as LPARAM _
   ) as LRESULT
   
   select case uMsg
   case WM_SIZE
      dim as integer wdt = LOWORD( lParam ), _
                  hgt = HIWORD( lParam )
                  
      movie_onresize( wdt, hgt )
      
      toolbar_onresize( wdt, hgt )

      return 0
      
   case WM_DESTROY
      PostQuitMessage( 0 )
      return 0
   
   case WM_COMMAND
      if( lParam <> NULL ) then
         select case LOWORD( wParam )
         case WIN_TOOLBAR_FIRSTID to WIN_TOOLBAR_FIRSTID + WIN_TOOLBAR_BUTTONS - 1
            toolbar_onclick( cast( HWND, lParam ), LOWORD( wParam ) )
         end select
         
      end if
   end select

   return DefWindowProc( hwnd, uMsg, wParam, lParam )
   
end function

''::::
private function toolbar_oncreate _
   ( _
      byval parent as HWND _
   ) as HWND
   
   dim as HWND hwnd
   
   function = NULL
             
   InitCommonControlsEx( @type<INITCOMMONCONTROLSEX>( len( INITCOMMONCONTROLSEX ), ICC_BAR_CLASSES ) )

    hwnd = CreateWindowEx( WS_EX_DLGMODALFRAME, _
                     TOOLBARCLASSNAME, _
                     NULL, _
                             WS_CHILD or WS_VISIBLE or WIN_TOOLBAR_STYLE, _
                             0, _
                             0, _
                             CW_USEDEFAULT, _
                             CW_USEDEFAULT, _
                             parent, _
                             NULL, _
                             cast( HINSTANCE, GetWindowLong( parent, GWL_HINSTANCE ) ), _
                             NULL )
             
   if( hwnd = NULL ) then
      exit function
   end if
      
   SendMessage( hwnd, TB_BUTTONSTRUCTSIZE, len( TBBUTTON ), NULL )
   
    SendMessage( hwnd, TB_ADDBITMAP, 0, cint( @type<TBADDBITMAP>( HINST_COMMCTRL, IDB_HIST_LARGE_COLOR ) ) )

    dim as TBBUTTON button(0 to WIN_TOOLBAR_BUTTONS-1)

    '' go back
    with button(0)
      .iBitmap = HIST_BACK
      .fsState = TBSTATE_ENABLED
        .fsStyle = TBSTYLE_BUTTON
        .idCommand = WIN_TOOLBAR_BUTTON_GOBACK
   end with

    '' go forward
    with button(1)
      .iBitmap = HIST_FORWARD
      .fsState = TBSTATE_ENABLED
        .fsStyle = TBSTYLE_BUTTON
        .idCommand = WIN_TOOLBAR_BUTTON_GOFORWARD
   end with

   SendMessage( hwnd, TB_ADDBUTTONS, WIN_TOOLBAR_BUTTONS, cast( LPARAM, @button(0) ) )
   
   SendMessage( hwnd, TB_AUTOSIZE, 0, 0 )

   ''
   dim as SIZE tbsize
   SendMessage( hwnd, TB_GETMAXSIZE, 0, cast( LPARAM, @tbsize ) )
   WIN_TOOLBAR_HEIGHT = tbsize.cy + HIWORD( SendMessage( hwnd, TB_GETPADDING, 0, 0 ) ) + 2

   function = hwnd

end function

''::::
private function window_oncreate _
   ( _
      byval hInstance as HINSTANCE _
   ) as HWND

   dim as zstring ptr className = @"movie_test"
   dim as WNDCLASSEX wc
   dim as HWND hwnd
   
   function = NULL

   with wc
      .cbSize       = len( WNDCLASSEX )
      .lpfnWndProc    = @win_cb
      .hInstance       = hInstance
      .lpszClassName    = className
      '.style         = CS_HREDRAW or CS_VREDRAW
   end with
   
   RegisterClassEx( @wc )

   hwnd = CreateWindowEx( 0, _
                     className, _
                     WIN_TITLE, _
                     WS_OVERLAPPEDWINDOW, _
                     CW_USEDEFAULT, _
                     WIN_WIDTH, _
                     CW_USEDEFAULT, _
                     WIN_HEIGHT, _
                     NULL, _
                     NULL, _
                     hInstance, _
                     0 )
      
   function = hwnd

end function

''::::
private function movie_oncreate _
   ( _
      byval parent as HWND, _
      byval filename as wstring ptr _
   ) as movctrl ptr
   
   dim as movctrl ptr movie
   
   function = NULL
      
   if( len( filename ) = 0 ) then
      exit function
   end if

   movie = new movctrl( parent, _
                   0, _
                   WIN_TOOLBAR_HEIGHT, _
                   WIN_WIDTH, _
                   WIN_HEIGHT-WIN_TOOLBAR_HEIGHT )

   if( movie = NULL ) then
      exit function
   end if
   
   if( movie->load( filename ) = FALSE ) then
      delete movie
      exit function
   end if
   
   if( movie->play( ) = FALSE ) then
      delete movie
      exit function
   end if
   
   function = movie

end function

''::::
private function WinMain _
   ( _
      byval hInstance as HINSTANCE, _
        byval hPrevInstance as HINSTANCE, _
        byval szCmdLine as string, _
        byval nCmdShow as integer _
   ) as integer

   dim as MSG msg
   dim as HWND win
   
   if( len( szCmdLine ) = 0 ) then
      print "Usage: test filename.ext"
      return 1
   end if
   
   ''
   if( FAILED( CoInitialize( NULL ) ) ) then
      return 1
   end if

   ''
   win = window_oncreate( hInstance )
   
   toolbar = toolbar_oncreate( win )

   movie = movie_oncreate( win, szCmdLine )
   if( movie = NULL ) then
      return 1
   end if
   
   ''
   ShowWindow( win, nCmdShow )
   UpdateWindow( win )

   ''
   do while( GetMessage( @msg, 0, 0, 0 ) = TRUE )
      TranslateMessage( @msg )
      DispatchMessage( @msg )
   loop

   ''
   CoUninitialize( )

   function = msg.wParam

end function


   end WinMain( GetModuleHandle( NULL ), NULL, Command( ), SW_NORMAL )


I've cut it down trying to get it to work in a full graphics screen but still get the below errors as well as needing a delay to see video but i can live with that.

"C:\Program Files\FreeBASIC\lib\win32/libfbgfx.a(libfb_gfx_driver_ddraw.o):libfb_gfx_driver_ddraw.c:(.rdata+0x28): multiple definition of `IID_IDirectDraw2'
C:\Program Files\FreeBASIC\lib\win32/libstrmiids.a(strmiids.o):strmiids.c:(.rdata+0x1e30): first defined here"

Code: Select all

#include once "windows.bi"
#include once "win/commctrl.bi"
#include once "win/ole2.bi"
#include once "movctrl/movctrl.bi"

dim shared as movctrl ptr movie = NULL

private function win_cb _
   ( _
      byval hwnd as HWND, _
      byval uMsg as UINT, _
      byval wParam as WPARAM, _
      byval lParam as LPARAM _
   ) as LRESULT
   select case uMsg
   case WM_SIZE
      movie->move( 350, 280, 320, 200 ) 'position and size of video
      return 0
   end select
   return 1
end function

''::::
private function window_oncreate _
   ( _
      byval hInstance as HINSTANCE _
   ) as HWND

   dim as zstring ptr className = @"movie_test"
   dim as WNDCLASSEX wc
   dim as HWND hwnd
   function = NULL
   with wc
      .cbSize       = len( WNDCLASSEX )
      .lpfnWndProc    = @win_cb
      .hInstance       = hInstance
      .lpszClassName    = className
      '.style         = CS_HREDRAW or CS_VREDRAW
   end with
   RegisterClassEx( @wc )
   hwnd = CreateWindowEx( 0, _
                     className, _
                     0, _
                     0, _
                     0, _
                     0, _
                     CW_USEDEFAULT, _
                     0, _
                     0, _
                     0, _
                     hInstance, _
                     0 )
   function = hwnd
end function

''::::
private function movie_oncreate _
   ( _
      byval parent as HWND, _
      byval filename as wstring ptr _
   ) as movctrl ptr
   
   dim as movctrl ptr movie
   
   function = NULL
          
   movie = new movctrl( parent, _
                   0, _
                   0, _
                   0, _
                   0 )
   if( movie->load( filename ) = FALSE ) then
      delete movie
      exit function
   end if
   
   if( movie->play( ) = FALSE ) then
      delete movie
      exit function
   end if
   
   function = movie

end function

''::::
private function WinMain _
   ( _
      byval hInstance as HINSTANCE, _
        byval hPrevInstance as HINSTANCE, _
        byval szCmdLine as string, _
        byval nCmdShow as integer _
   ) as integer
   dim as MSG msg
   dim as HWND win
    dim as string playthismpg
    playthismpg = "1.dat"
   if( FAILED( CoInitialize( NULL ) ) ) then
      return 1
   end if
   win = window_oncreate( hInstance )
   movie = movie_oncreate( win, playthismpg )
   ShowWindow( win, nCmdShow )
   UpdateWindow( win )
    sleep 3000 'play video for 3 sec only
   CoUninitialize( )
   function = msg.wParam
end function
   end WinMain( GetModuleHandle( NULL ), NULL, Command( ), SW_NORMAL )


Anyway, i think we need video player code to work in freebasic and atleast across win32, much like the sound code we already have (FMOD, FBSOUND), that can do the simple things like play in your game screen, at any position and size :)

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 9 guests