If it doesn't show at first, move the console slightly.
Some formats don't show at all, I have set .avi as the first choice.
Should play .mp3 also.
Tested win 10, fbc 32/64/gas64
Added pause/resume e.t.c. for .mp3/ .wav files.
Code: Select all
#define WIN_INCLUDEALL
#include "Windows.bi"
#include "win/mmsystem.bi"
#Include once "/win/commctrl.bi"
#define nul chr(0)
Declare Function SetWindowTheme Lib "UxTheme.dll" Alias "SetWindowTheme"(As Any Ptr,As zstring Ptr,As zstring Ptr) As Long
Dim Shared As String req: req="Media (.avi) files"+NUL+"*.AVI"+NUL+"Others (.mp3,.mpeg, . . .)"+NUL+"*.MP3;*.MPEG"+NUL+"All files (*.*)"+NUL+"*.*"+NUL+NUL
Dim Shared As String message
Dim Shared As Any Ptr p
Dim Shared As hdc hdc
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
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
Function splice(s As String,a() As Long) As String
Redim a(1 To 4)
Dim As Long position=Instr(s," "),count=1
a(1)= Val(s)
While position>0
count+=1
a(count)= Val(Mid(s,position))
position=Instr(position+1,s," ")
Wend
Return s
End Function
Function Getsize( file As String,Byref _Width As Integer,Byref _Height As Integer,Byref l As Long=0) As Long
Dim As zstring * 50 mcidata
Dim As zstring * 20 length
Redim Elements() As Long
mciSendString("open " +Chr(34)+file+Chr(34)+ " type mpegvideo alias file1", NULL, 0, 0)
Var MCIResult = mciSendString("Where file1 Destination max",@MCIData,50,0)
If MCIResult = 0 Then
splice(MCIData,elements())
_Width = Elements(3)
_Height = Elements(4)
mciSendString("status file1 length",@length, 20,0)
l=Val(length)
End If
Return _width*_height
End Function
Function GetHandle As HWND
Dim As HWND hwndFound
Dim pszNewWindowTitle As zstring * 1024
Dim pszOldWindowTitle As zstring * 1024
GetConsoleTitle(pszOldWindowTitle, 1024)
wsprintf(pszNewWindowTitle, "%d/%d", GetTickCount(), GetCurrentProcessId())
SetConsoleTitle(pszNewWindowTitle)
Sleep(40)
hwndFound = FindWindow(NULL, pszNewWindowTitle)
SetConsoleTitle(pszOldWindowTitle)
Return hwndFound
End Function
Sub hidecursor()
Dim As HANDLE consoleHandle = GetStdHandle(STD_OUTPUT_HANDLE)
Dim As CONSOLE_CURSOR_INFO info
info.dwSize = 100
info.bVisible = FALSE
SetConsoleCursorInfo(consoleHandle, @info)
End Sub
Sub play(file As String="")
If file="" Then file=getfiles(req)
Dim As Integer x,y,w,h,vflag=1
Dim As Long l
Dim As rect r
Dim As Long diagonal,lastdiagonal
Dim As String xs,ys,p1,p2
Getsize(file,x,y,l)
If Instr(Lcase(file),".mp3") Then vflag=0:Goto lbl
If Instr(Lcase(file),".wav") Then vflag=0:Goto lbl
p=gethandle
If x=0 Or y=0 And vflag Then Print "Not valid": Return
setwindowpos(p,HWND_TOPMOST,0,0,x,y,SWP_SHOWWINDOW)
lbl:
SetWindowTheme(p," "," ")
Dim As zstring * 20 ans,length,position
Shell "title "+Mid(file,1+Instrrev(file,Any"\/"))+ " p = pause, r = resume, s = restart, q = quit"
mciSendString("window file1 handle " & p, 0, 0, 0)
mcisendstring("put file1 destination at "+Str(0)+" "+ Str(10)+" "+ Str(Int(x))+" "+ Str(Int(y))+" ",0,0,0)
mciSendString("play file1", NULL, 0,0)
Dim As Long Lngth,pst
Lngth=l
Dim As Double t=Timer
Dim As String key
If vflag=0 Then
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)
mciSendString("status file1 mode ",@ans,20,0)
mciSendString("status file1 length",@length, 20,0)
locate 1,1,0
print " ";(100*Vallng(position)\vallng(length));"%"
message=ans
if message="paused" then message+=" "
Locate 3
Print "Audio ";message
If ans="stopped" Then Exit Sub
Sleep 100
If key=Chr(27) Then mciSendString("close file1", NULL, 0, 0):End
Loop
End If
ShowScrollBar(p, SB_BOTH, FALSE)
getwindowrect(p,@r)
diagonal = Sqr((r.right-r.left)*(r.right-r.left) + (r.bottom-r.top)*(r.bottom-r.top))
lastdiagonal=diagonal
hdc=GetDC(p)
Dim As Long xpos,wd
wd=r.right-r.left
hidecursor
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)
xpos=map(0,1,pst/Lngth,0,wd)
SetPixel(hdc,xpos,5,bgr(255,255,255))
getwindowrect(p,@r)
diagonal = Sqr((r.right-r.left)*(r.right-r.left) + (r.bottom-r.top)*(r.bottom-r.top))
If (lastdiagonal<>diagonal) Then
movewindow(p,r.left,r.top,r.right-r.left,r.bottom-r.top,true)
ShowScrollBar(p, SB_BOTH, FALSE)
xs= Str((r.right-r.left))
wd=(r.right-r.left)
ys= Str((r.bottom-r.top))
p1= "0"
p2= "10"
Dim As String moveposition= "put file1 destination at "+p1+" "+p2+" "+xs+" "+ys
mcisendstring(moveposition,null,0,0)
hidecursor
End If
lastdiagonal=diagonal
mciSendString("status file1 mode ",@ans,20,0)
message=ans
If ans="stopped" Then Locate 1,1: Print message : Exit Sub
Sleep 100
If key=Chr(27) Then mciSendString("close file1", NULL, 0, 0):End
Loop
End Sub
Dim As String filepath="" 'optional path otherwise openfile window
play(filepath)
Sleep
Sub finish Destructor
mciSendString("close file1", NULL, 0, 0)
ReleaseDC(p,hdc)
End Sub