SOLVED - MPEG2 Play Code and Win10

Windows specific questions.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: SOLVED - MPEG2 Play Code and Win10

Post by dodicat »

Your gfx code works well
screencontrol(103,"GDI") stops flickering, so no need really to use an opengl screen(like mine).
You can have a little do loop instead of sleep 3000
Inside the loop you can select case options.
Nicely done.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: SOLVED - MPEG2 Play Code and Win10

Post by dodicat »

I haven't found how to get the return percentage of the file run (yet), but I have made an estimate via filelen, a little progress line at the bottom.
It is a temporary method until I figure out the proper way.
Also I have set a const of k=.2 which centralises the viewing area (.2 * width and height into the screen).
This can be altered of course.

Code: Select all




#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#Include once "/win/commctrl.bi"
#include "file.bi"
#define nul chr(0)

const k=.2

Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Function getfiles(filetypes As String) As String
Declare Function gethandle As hwnd  
Dim Shared As String req: req="Media (.mpg) files"+NUL+"*.MPG"+NUL+"Others (.mp3,.mpeg, . . .)"+NUL+"*.MP3;*.MPEG"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
dim shared as string message
Function map(a As Double,b As Double,_x_ As Double,c As Double,d As Double) As Double
  Return  (((d)-(c))*((_x_)-(a))/((b)-(a))+(c))
End Function

Sub play()
  Dim As Integer x,y
  Screeninfo x,y
  Dim As Any Ptr  p=gethandle
  SetWindowTheme(p," "," ")
  Dim As String file=getfiles(req)
  Var sz=Filelen(file)
  Var tm=map(0,78279821,sz,0,(5*60))
  dim as zstring * 20 ans
  Windowtitle Mid(file,1+Instrrev(file,Any"\/"))+ "       p = pause, r = resume, s = restart, q = quit"
  mciSendString("open  " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
  mciSendString("window file1 handle " & p, 0, 0, 0)
  mcisendstring("put file1 destination at "+str(int(k*x))+" "+ str(int(k*y))+" "+ Str(int(x-2*k*x))+" "+ Str(int(y-8-2*k*y))+" ",0,0,0)
  mciSendString("play file1", NULL, 0,0)
  
  Dim As Double t=Timer
  Dim As String key
  Do
    key=Inkey
    Select Case key
    Case "p"
      mciSendString("pause file1", NULL, 0,0)
    Case "r" 
      mciSendString("play file1", NULL, 0,0)
    Case "s"
      mciSendString("play file1 from 0", NULL, 0,0)
    Case "q"
      mciSendString("close file1", NULL, 0, 0):End
    End Select
    Var xpos=map(0,tm,Timer-t,0,x)
    Line(0,y-4)-(xpos,y-4)
    If key=Chr(27) Then mciSendString("close file1", NULL, 0, 0):End
    mciSendString("status file1 mode ",@ans,20,0)
    message=ans
    if ans="stopped" then exit sub
    Sleep 1
  Loop
End Sub

Function gethandle As hwnd  
  Static As Any Ptr win
  Screencontrol 2,Cast(Integer,win)
  Return win
End Function

Function getfiles(filetypes As String) As String
  Dim As zstring * 2048 SELFILE
  Dim As String MYFILTER
  myfilter=filetypes
  Dim As OpenFileName SomeFile
  With SomeFile
    .lStructSize = Sizeof(OpenFileName)
    .hInstance = null
    .lpstrFilter = Strptr(MYFILTER)
    .lpstrFile = @SELFILE
    .nMaxFile = 2048
    .nMaxFileTitle = 0
    .lpstrTitle =@"Movies and songs"
    .Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
  End With
  GetOpenFileName(@SomeFile)
  Return *SomeFile.lpstrFile
End Function


Sub done Destructor
  mciSendString("close file1", NULL, 0, 0)
End Sub

'===============================================

Screencontrol(103,"GDI")
Screen 19

play()
print message
sleep



  
I use screen 19, but any other resolution within reason will do.
I use the gfx screen with GDI driver
Last edited by dodicat on Jul 04, 2020 14:25, edited 1 time in total.
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

I never knew it was an opengl screen - thought same type of screen just different driver but yes flickers.

and thanks but it's just your code trimmed down to basically just play a vid in the game screen and either uses the whole screen area or a portion of it and located anywhere and borderless! (which it does) so just the completion code needed and once got then i'll add everything else so it runs in a thread and plays a vid when triggered and stops when needed. So far this code looks to be way shorter than my dshow code which is great :)
dodicat wrote:Your gfx code works well
screencontrol(103,"GDI") stops flickering, so no need really to use an opengl screen(like mine).
You can have a little do loop instead of sleep 3000
Inside the loop you can select case options.
Nicely done.
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

Real pain huh? You'd think it would be a simple feat to know when a vid ended haha! I wish there were examples given in the MS docs damn.. will check out your % code :)

Oh yer just another thing dodicat - I see you have this code in all your examples and been wondering why it's needed or if it's even used?

Code: Select all

Sub done Destructor
  mciSendString("close file1", NULL, 0, 0)
End Sub
dodicat wrote:I haven't found how to get the return percentage of the file run (yet), but I have made an estimate via filelen, a little progress line at the bottom.
It is a temporary method until I figure out the proper way.
Also I have set a const of k=.2 which centralises the viewing area (.2 * width and height into the screen).
This can be altered of course.

Code: Select all


#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#Include once "/win/commctrl.bi"
#include "file.bi"
#define nul chr(0)

const k=.2

Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Function getfiles(filetypes As String) As String
Declare Function gethandle As Any Ptr  
Dim Shared As String req: req="Media (.mpg) files"+NUL+"*.MPG"+NUL+"Others (.mp3,.mpeg, . . .)"+NUL+"*.MP3;*.MPEG"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL

Function map(a As Double,b As Double,_x_ As Double,c As Double,d As Double) As Double
  Return  (((d)-(c))*((_x_)-(a))/((b)-(a))+(c))
End Function

Sub play()
  Dim As Integer x,y
  Screeninfo x,y
  Dim As Any Ptr  p=gethandle
  SetWindowTheme(p," "," ")
  Dim As String file=getfiles(req)
  Var sz=Filelen(file)
  Var tm=map(0,78279821,sz,0,(5*60))
  Windowtitle Mid(file,1+Instrrev(file,Any"\/"))+ "       p = pause, r = resume, s = restart, q = quit"
  mciSendString("open  " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
  mciSendString("window file1 handle " & p, 0, 0, 0)
  'mciSendString("put file1 destination at 0 0 "+ Str(x)+" "+ Str(y-8)+" " , 0, 0, 0)
   mcisendstring("put file1 destination at "+str(int(k*x))+" "+ str(int(k*y))+" "+ Str(int(x-2*k*x))+" "+ Str(int(y-8-2*k*y))+" ",0,0,0)
  mciSendString("play file1", NULL, 0,0)
  Dim As Double t=Timer
  Dim As String key
  Do
    key=Inkey
    Select Case key
    Case "p"
      mciSendString("pause file1", NULL, 0,0)
    Case "r" 
      mciSendString("play file1", NULL, 0,0)
    Case "s"
      mciSendString("play file1 from 0", NULL, 0,0)
    Case "q"
      mciSendString("close file1", NULL, 0, 0):End
    End Select
    Var xpos=map(0,tm,Timer-t,0,x)
    Line(0,y-4)-(xpos,y-4)
    If key=Chr(27) Then mciSendString("close file1", NULL, 0, 0):End
    Sleep 1
  Loop
End Sub

Function gethandle As Any Ptr  
  Static As Any Ptr win
  Screencontrol 2,Cast(Integer,win)
  Return win
End Function

Function getfiles(filetypes As String) As String
  Dim As zstring * 2048 SELFILE
  Dim As String MYFILTER
  myfilter=filetypes
  Dim As OpenFileName SomeFile
  With SomeFile
    .lStructSize = Sizeof(OpenFileName)
    .hInstance = null
    .lpstrFilter = Strptr(MYFILTER)
    .lpstrFile = @SELFILE
    .nMaxFile = 2048
    .nMaxFileTitle = 0
    .lpstrTitle =@"Movies and songs"
    .Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
  End With
  GetOpenFileName(@SomeFile)
  Return *SomeFile.lpstrFile
End Function


Sub done Destructor
  mciSendString("close file1", NULL, 0, 0)
End Sub

'===============================================

Screencontrol(103,"GDI")
Screen 19
play()

  
I use screen 19, but any other resolution within reason will do.
I use the gfx screen with GDI driver
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

This example shows video no problems! Must have something to do with the window handle.

Nicely done with the progress bar but it's a little slow haha! (vid ended with progress bar only half way) but don't worry about it and I like how it goes straight to a vid selection window :)
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

Ahhh the case of the missing video.. the plot thickens.

I saved your code then went to play it and no video!

hmm I thought.

I copied the code to a new window and ran it and the video showed!

scratching my head on this one - lucky I have plenty of hair :)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: SOLVED - MPEG2 Play Code and Win10

Post by dodicat »

The little sub

Sub done Destructor
mciSendString("close file1", NULL, 0, 0)
End Sub

This sub will run on exit regardless of how you exit.
If you close the program by closing the console box say, then it will run after that, it just closes the program cleanly to the system.
You can test by putting a beep into the sub.

I tested the code on my old XP machine, and all seemed OK.
The progress bar will be approximate for large(ish) .mpg files, say at least 3 minutes run.
I only use file size on .mpg as the method.
But I will figure out how to retrieve the data correctly from mciSendString and fix the progress bar.
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

ahh ok yeh i'm using just a short 20sec mpg and thanks for explaining that sub!

as far as fixing progress bar i'm not too worried about it myself but for your own pleasure go for it ;)

I was looking at the status command and it has a "file completion" flag and thought I hit it until I read what is does...

file completion:
Returns the estimated percentage a load, save, capture, cut, copy, delete, paste, or undo operation has progressed.
(Applications can use this to provide a visual indicator of progress.)

no 'play' bummer :)
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

I'm sure what I need is in this but stuffed if I can work it out.

Anyone make sense of this and how you would code it in FB?

From the Docs:

MM_MCINOTIFY message

The MM_MCINOTIFY message notifies an application that an MCI device has completed an operation. MCI devices send this message only when the MCI_NOTIFY flag is used.

C++
MM_MCINOTIFY
wParam = (WPARAM) wFlags
lParam = (LONG) lDevID

Parameters:
wFlags:
Reason for the notification. The following values are defined:
MCI_NOTIFY_ABORTED
The device received a command that prevented the current conditions for initiating the callback function from being met. If a new command interrupts the current command and it also requests notification, the device sends this message only and not MCI_NOTIFY_SUPERSEDED
MCI_NOTIFY_FAILURE
A device error occurred while the device was executing the command.
MCI_NOTIFY_SUCCESSFUL
The conditions initiating the callback function have been met.
MCI_NOTIFY_SUPERSEDED
The device received another command with the "notify" flag set and the current conditions for initiating the callback function have been superseded.
lDevID:
Identifier of the device initiating the callback function.

Return Value:
Returns zero if successful or an error otherwise.

Remarks:
For more information about the MCI_NOTIFY flag, see The Notify Flag.

A device returns the MCI_NOTIFY_SUCCESSFUL flag with MM_MCINOTIFY when the action for a command finishes. For example, a CD audio device uses this flag for notification for the play ( MCI_PLAY) command when the device finishes playing. The play command is successful only when it reaches the specified end position or reaches the end of the media.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: SOLVED - MPEG2 Play Code and Win10

Post by dodicat »

I have updated my previous code to incorporate the stopped flag (sent by mciSendString)
Note the zstring * 20 into the second parameter, and set 20 characters in the third.

mciSendString("status file1 mode ",@ans,20,0) is in the loop so it receives messages.
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

OMG well done dodicat! finally!!!
I was Just looking at status and mode on the net and thinking that it should return 'playing' until video has ended so was going to work on that tomorrow but your way is much better and I just tried it and works! I will now finish the coding so it will be doing the same thing as my dshow code and stick it in the first post with it so there will be two ways now. Thanks a million dodicat appreciated! :)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: SOLVED - MPEG2 Play Code and Win10

Post by dodicat »

Here is a more accurate progress, tested on .mpg files, again using status for length and position.

Code: Select all

 

#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#Include once "/win/commctrl.bi"
#include "file.bi"
#define nul chr(0)

const k=.2

Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Declare Function getfiles(filetypes As String) As String
Declare Function gethandle As hwnd  
Dim Shared As String req: req="Media (.mpg) files"+NUL+"*.MPG"+NUL+"Others (.mp3,.mpeg, . . .)"+NUL+"*.MP3;*.MPEG"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
dim shared as string message
Function map(a As Double,b As Double,_x_ As Double,c As Double,d As Double) As Double
  Return  (((d)-(c))*((_x_)-(a))/((b)-(a))+(c))
End Function

Sub play()
  Dim As Integer x,y
  Screeninfo x,y
  Dim As Any Ptr  p=gethandle
  SetWindowTheme(p," "," ")
  Dim As String file=getfiles(req)
  Var sz=Filelen(file)
  Var tm=map(0,78279821,sz,0,(5*60))
  dim as zstring * 20 ans,length,position
  Windowtitle Mid(file,1+Instrrev(file,Any"\/"))+ "       p = pause, r = resume, s = restart, q = quit"
  mciSendString("open  " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
  mciSendString("window file1 handle " & p, 0, 0, 0)
  mcisendstring("put file1 destination at "+str(int(k*x))+" "+ str(int(k*y))+" "+ Str(int(x-2*k*x))+" "+ Str(int(y-8-2*k*y))+" ",0,0,0)
  mciSendString("play file1", NULL, 0,0)
  mciSendString("status file1 length",@length, 20,0)
  dim as long Lngth,pst
  Lngth=vallng(length)
  Dim As Double t=Timer
  Dim As String key
  Do
    key=Inkey
    Select Case key
    Case "p"
      mciSendString("pause file1", NULL, 0,0)
    Case "r" 
      mciSendString("play file1", NULL, 0,0)
    Case "s"
      mciSendString("play file1 from 0", NULL, 0,0)
    Case "q"
      mciSendString("close file1", NULL, 0, 0):End
    End Select
    
    mciSendString("status file1 position ",@position, 20,0)
    pst=vallng(position)
    draw string(x/2-4,y-16),string(4,chr(219)),0
    draw string(x/2,y-16),str(int(100*pst/lngth))+"%"
    Var xpos=map(0,1,pst/Lngth,0,x)
    Line(0,y-4)-(xpos,y-4)
    
    mciSendString("status file1 mode ",@ans,20,0)
    message=ans
    if ans="stopped" then exit sub
    Sleep 1
    If key=Chr(27) Then mciSendString("close file1", NULL, 0, 0):End
  Loop
End Sub

Function gethandle As hwnd  
  Static As Any Ptr win
  Screencontrol 2,Cast(Integer,win)
  Return win
End Function

Function getfiles(filetypes As String) As String
  Dim As zstring * 2048 SELFILE
  Dim As String MYFILTER
  myfilter=filetypes
  Dim As OpenFileName SomeFile
  With SomeFile
    .lStructSize = Sizeof(OpenFileName)
    .hInstance = null
    .lpstrFilter = Strptr(MYFILTER)
    .lpstrFile = @SELFILE
    .nMaxFile = 2048
    .nMaxFileTitle = 0
    .lpstrTitle =@"Movies and songs"
    .Flags = OFN_PATHMUSTEXIST Or OFN_FILEMUSTEXIST
  End With
  GetOpenFileName(@SomeFile)
  Return *SomeFile.lpstrFile
End Function


Sub done Destructor
  mciSendString("close file1", NULL, 0, 0)
End Sub

'===============================================

Screencontrol(103,"GDI")
Screen 19
play()
print message
sleep

 
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

wow impressed! dead accurate on my 10sec clip :)
xbgtc
Posts: 249
Joined: Oct 14, 2007 5:40
Location: Australia

Re: SOLVED - MPEG2 Play Code and Win10

Post by xbgtc »

dodicat - just one more thing that is not working. In the line:

mciSendString("open " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)

In my own code I have made "file" equal to the path and filename eg. file="c:\users\franco\video\avideo.mpg" but it won't play it as it can't find it. It seems to only play files in the current directory or the basic program's directory. Any idea what's wrong?

EDIT: ahh i just tried c:\users\avideo.mpg and that worked so must have something to do with long directory names.
EDIT2: Oh god! Been trying different directories and they work then 3 directories thinking there's limit but that worked too! then tried the original problem directory and NOW that works LOL. Man programming is a real head f*** :)
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: SOLVED - MPEG2 Play Code and Win10

Post by dodicat »

The mciSendString topic is huge, it must have taken many Microsoft coders a while to perfect it, I daresay they continually update it.
When you think that most windows computer users are not in the least bit interested in coding, rather a great deal of interest in photos, movies, online TV, e.t.c. the encoding/decoding part of the internal (winapi) is very important.
Your very first code works well If the gdi driver is used.(Win 10).
I am experimenting in C++ to get my own method running there in Win api.
Post Reply