xbgtc wrote:...
this is getting weird!
Did you had a look at this thread?
Ways in which I can embed a video player into GFX window?
xbgtc wrote:...
this is getting weird!
Code: Select all
#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#include "win/vfw.bi" 'some mcisendstring constants (unused here)
#Include once "/win/commctrl.bi"
#define nul chr(0)
Dim As MSG msg
Dim As String req
req="Media (.mpg) files"+NUL+"*.MPG"+NUL+"Others (.mp3,.mpeg, . . .)"+NUL+"*.MP3;*.MPEG"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
var Main_Win=CreateWindowEx(0,"#32770","Control",WS_OVERLAPPEDWINDOW Or WS_VISIBLE,5,5,320,550,0,0,0,0)
var starter=CreateWindowEx(0,"Button","Start", WS_VISIBLE Or WS_CHILD,0,0,60,30,Main_win,0,0,0)
var stopper=CreateWindowEx(0,"Button","Stop", WS_VISIBLE Or WS_CHILD,60,0,60,30,Main_win,0,0,0)
var player=CreateWindowEx(0,"Button","Play", WS_VISIBLE Or WS_CHILD,120,0,60,30,Main_win,0,0,0)
var finish=CreateWindowEx(0,"Button","End", WS_VISIBLE Or WS_CHILD,180,0,60,30,Main_win,0,0,0)
var message=CreateWindowEx(0,"static","", WS_VISIBLE Or WS_CHILD,10,200,260,30,Main_win,0,0,0)
var restart=CreateWindowEx(0,"button","Restart", WS_VISIBLE Or WS_CHILD,240,0,60,30,Main_win,0,0,0)
Declare Function getfiles(filetypes As String) As String
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
'freeconsole 'dont show the console box
SetWindowTheme(main_win," "," ")
While GetMessage( @msg,Main_Win,0,0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Select Case msg.hwnd
Case Main_Win
Select Case msg.message
Case 273 'close by clicking X
mciSendString("close file1", NULL, 0,0)
End
End Select
'-----------------------------
Case starter
Select Case msg.message
Case WM_LBUTTONDOWN
Dim As String file= getfiles(req)
mciSendString("open " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
'mciSendString("window movie state show",0,0,NULL)
var s=mid(file,1+instrrev(file,any"\\/"))
setwindowtext(message,s)
End Select
'-----------------------------
Case stopper
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("pause file1", NULL, 0,0)
End Select
'------------------------------
Case player
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("play file1", NULL, 0,0)
End Select
'------------------------------
Case restart
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("play file1 from 0", NULL, 0,0)
End Select
'------------------------------
Case finish
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("close file1", NULL, 0,0)
End Select
End Select'(case main_win)
Wend
Sub done Destructor
mciSendString("close file1", NULL, 0, 0)
End Sub
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
dodicat wrote:Here are the full set of command strings for MCI
https://docs.microsoft.com/en-us/windows/win32/multimedia/mci-command-strings
Possibly a flag needed after play in play file1.
In the meantime just press escape from the console, it ends cleanly.
paul doe wrote:xbgtc wrote:...
this is getting weird!
Did you had a look at this thread?
Ways in which I can embed a video player into GFX window?
dodicat wrote:I have a little more control, but not enough yet.
Some info is here:
https://docs.microsoft.com/en-us/windows/win32/multimedia/playing-a-deviceCode: Select all
#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#include "win/vfw.bi" 'some mcisendstring constants (unused here)
#Include once "/win/commctrl.bi"
#define nul chr(0)
Dim As MSG msg
Dim As String req
req="Media (.mpg) files"+NUL+"*.MPG"+NUL+"Others (.mp3,.mpeg, . . .)"+NUL+"*.MP3;*.MPEG"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
var Main_Win=CreateWindowEx(0,"#32770","Control",WS_OVERLAPPEDWINDOW Or WS_VISIBLE,5,5,320,550,0,0,0,0)
var starter=CreateWindowEx(0,"Button","Start", WS_VISIBLE Or WS_CHILD,0,0,60,30,Main_win,0,0,0)
var stopper=CreateWindowEx(0,"Button","Stop", WS_VISIBLE Or WS_CHILD,60,0,60,30,Main_win,0,0,0)
var player=CreateWindowEx(0,"Button","Play", WS_VISIBLE Or WS_CHILD,120,0,60,30,Main_win,0,0,0)
var finish=CreateWindowEx(0,"Button","End", WS_VISIBLE Or WS_CHILD,180,0,60,30,Main_win,0,0,0)
var message=CreateWindowEx(0,"static","", WS_VISIBLE Or WS_CHILD,10,200,260,30,Main_win,0,0,0)
var restart=CreateWindowEx(0,"button","Restart", WS_VISIBLE Or WS_CHILD,240,0,60,30,Main_win,0,0,0)
Declare Function getfiles(filetypes As String) As String
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
'freeconsole 'dont show the console box
SetWindowTheme(main_win," "," ")
While GetMessage( @msg,Main_Win,0,0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Select Case msg.hwnd
Case Main_Win
Select Case msg.message
Case 273 'close by clicking X
mciSendString("close file1", NULL, 0,0)
End
End Select
'-----------------------------
Case starter
Select Case msg.message
Case WM_LBUTTONDOWN
Dim As String file= getfiles(req)
mciSendString("open " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
'mciSendString("window movie state show",0,0,NULL)
var s=mid(file,1+instrrev(file,any"\\/"))
setwindowtext(message,s)
End Select
'-----------------------------
Case stopper
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("pause file1", NULL, 0,0)
End Select
'------------------------------
Case player
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("play file1", NULL, 0,0)
End Select
'------------------------------
Case restart
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("play file1 from 0", NULL, 0,0)
End Select
'------------------------------
Case finish
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("close file1", NULL, 0,0)
End Select
End Select'(case main_win)
Wend
Sub done Destructor
mciSendString("close file1", NULL, 0, 0)
End Sub
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
Code: Select all
#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#Include once "/win/commctrl.bi"
#define nul chr(0)
Dim As MSG msg
Dim As String req
req="Media (.mpg) files"+NUL+"*.MPG"+NUL+"Others (.mp3,.mpeg, . . .)"+NUL+"*.MP3;*.MPEG"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
var Main_Win=CreateWindowEx(0,"#32770","Control",WS_OVERLAPPEDWINDOW Or WS_VISIBLE,5,5,800,600,0,0,0,0)
var starter=CreateWindowEx(0,"Button","Start", WS_VISIBLE Or WS_CHILD,0,0,60,30,Main_win,0,0,0)
var stopper=CreateWindowEx(0,"Button","Stop", WS_VISIBLE Or WS_CHILD,60,0,60,30,Main_win,0,0,0)
var player=CreateWindowEx(0,"Button","Play", WS_VISIBLE Or WS_CHILD,120,0,60,30,Main_win,0,0,0)
var finish=CreateWindowEx(0,"Button","End", WS_VISIBLE Or WS_CHILD,180,0,60,30,Main_win,0,0,0)
var message=CreateWindowEx(0,"static","", WS_VISIBLE Or WS_CHILD,500,10,200,30,Main_win,0,0,0)
var restart=CreateWindowEx(0,"button","Restart", WS_VISIBLE Or WS_CHILD,240,0,60,30,Main_win,0,0,0)
var vscreen=CreateWindowEx(0,"static","", WS_VISIBLE Or WS_CHILD or WS_BORDER,5,50,770,510,Main_win,0,0,0)
Declare Function getfiles(filetypes As String) As String
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
'freeconsole 'dont show the console box
SetWindowTheme(main_win," "," ")
While GetMessage( @msg,Main_Win,0,0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Select Case msg.hwnd
Case Main_Win
Select Case msg.message
Case 273 'close by clicking X
mciSendString("close file1", NULL, 0,0)
End
End Select
'-----------------------------
Case starter
Select Case msg.message
Case WM_LBUTTONDOWN
Dim As String file= getfiles(req)
mciSendString("open " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
mciSendString("window file1 handle " & vscreen, 0, 0, 0)
var s=mid(file,1+instrrev(file,any"\\/"))
setwindowtext(message,s)
End Select
'-----------------------------
Case stopper
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("pause file1", NULL, 0,0)
End Select
'------------------------------
Case player
Select Case msg.message
Case WM_LBUTTONDOWN
Dim rct As rect
getCLIENTrect(vscreen,@rct)
mciSendString("put file1 destination at 0 0 770 510 " , 0, 0, 0)
mciSendString("play file1", NULL, 0,0)
End Select
'------------------------------
Case restart
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("play file1 from 0", NULL, 0,0)
End Select
'------------------------------
Case finish
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("close file1", NULL, 0,0)
End Select
End Select'(case main_win)
Wend
Sub done Destructor
mciSendString("close file1", NULL, 0, 0)
End Sub
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
Code: Select all
#include "Windows.bi"
#include "win/mmsystem.bi"
mciSendString("open videol.mpg",NULL,0,0)
mciSendString("play video.mpg",NULL,0,0)
sleep 5000
mciSendString("close video.mpg",NULL,0,0)
dodicat wrote:BINGOCode: Select all
#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#Include once "/win/commctrl.bi"
#define nul chr(0)
Dim As MSG msg
Dim As String req
req="Media (.mpg) files"+NUL+"*.MPG"+NUL+"Others (.mp3,.mpeg, . . .)"+NUL+"*.MP3;*.MPEG"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
var Main_Win=CreateWindowEx(0,"#32770","Control",WS_OVERLAPPEDWINDOW Or WS_VISIBLE,5,5,800,600,0,0,0,0)
var starter=CreateWindowEx(0,"Button","Start", WS_VISIBLE Or WS_CHILD,0,0,60,30,Main_win,0,0,0)
var stopper=CreateWindowEx(0,"Button","Stop", WS_VISIBLE Or WS_CHILD,60,0,60,30,Main_win,0,0,0)
var player=CreateWindowEx(0,"Button","Play", WS_VISIBLE Or WS_CHILD,120,0,60,30,Main_win,0,0,0)
var finish=CreateWindowEx(0,"Button","End", WS_VISIBLE Or WS_CHILD,180,0,60,30,Main_win,0,0,0)
var message=CreateWindowEx(0,"static","", WS_VISIBLE Or WS_CHILD,500,10,200,30,Main_win,0,0,0)
var restart=CreateWindowEx(0,"button","Restart", WS_VISIBLE Or WS_CHILD,240,0,60,30,Main_win,0,0,0)
var vscreen=CreateWindowEx(0,"static","", WS_VISIBLE Or WS_CHILD or WS_BORDER,5,50,770,510,Main_win,0,0,0)
Declare Function getfiles(filetypes As String) As String
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
'freeconsole 'dont show the console box
SetWindowTheme(main_win," "," ")
While GetMessage( @msg,Main_Win,0,0)
TranslateMessage(@msg)
DispatchMessage(@msg)
Select Case msg.hwnd
Case Main_Win
Select Case msg.message
Case 273 'close by clicking X
mciSendString("close file1", NULL, 0,0)
End
End Select
'-----------------------------
Case starter
Select Case msg.message
Case WM_LBUTTONDOWN
Dim As String file= getfiles(req)
mciSendString("open " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
mciSendString("window file1 handle " & vscreen, 0, 0, 0)
var s=mid(file,1+instrrev(file,any"\\/"))
setwindowtext(message,s)
End Select
'-----------------------------
Case stopper
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("pause file1", NULL, 0,0)
End Select
'------------------------------
Case player
Select Case msg.message
Case WM_LBUTTONDOWN
Dim rct As rect
getCLIENTrect(vscreen,@rct)
mciSendString("put file1 destination at 0 0 770 510 " , 0, 0, 0)
mciSendString("play file1", NULL, 0,0)
End Select
'------------------------------
Case restart
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("play file1 from 0", NULL, 0,0)
End Select
'------------------------------
Case finish
Select Case msg.message
Case WM_LBUTTONDOWN
mciSendString("close file1", NULL, 0,0)
End Select
End Select'(case main_win)
Wend
Sub done Destructor
mciSendString("close file1", NULL, 0, 0)
End Sub
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
For things like fast forward e.t.c. you can make your own buttons and refer to
https://docs.microsoft.com/en-us/windows/win32/multimedia/mci-command-strings
Code: Select all
#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#Include once "/win/commctrl.bi"
#include "crt.bi"
sub play(file as string,p as any ptr)
dim as integer x,y
screeninfo x,y
windowtitle file+ " 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)+" " , 0, 0, 0)
mciSendString("play file1", NULL, 0,0)
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
flip
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 ptr,@win)
return win
end function
Sub done Destructor
mciSendString("close file1", NULL, 0, 0)
End Sub
screen 20,,,2
play("orbiter.mpg",gethandle)
Code: Select all
#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#Include once "/win/commctrl.bi"
#define nul chr(0)
screencontrol(103,"GDI")
screenres 800,600,32
dim shared HWND as hwnd
screencontrol(2,cast(integer,hwnd))
mciSendString("open " +Chr(34)+"lesgrl.mpg"+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
mciSendString("window file1 handle " & hwnd, 0, 0, 0)
'mciSendString("pause file1", NULL, 0,0)
mciSendString("put file1 destination at 320 320 160 120 " , 0, 0, 0)
mciSendString("play file1 notify", NULL, 0, HWND)
sleep 3000
mciSendString("close file1", NULL, 0,0)
Users browsing this forum: No registered users and 5 guests