Post by angelo2449 on Oct 15, 2022 12:39:01 GMT -5
Hi guys,
I would like to complete the program that I am attaching here.
I copied part of the program from a website and adapted it to my needs.
Now I would like the program to close the video and run it until the time entered in the field
> # main.fine <.
Can anyone kindly help me?
Thank you.
I would like to complete the program that I am attaching here.
I copied part of the program from a website and adapted it to my needs.
On Error goto [GestErr]
nomainwin
WindowWidth = 500
WindowHeight = 160
UpperLeftX=int((DisplayWidth-WindowWidth)/2)
UpperLeftY=int((DisplayHeight-WindowHeight)/2)
TextboxColor$ = "white"
BackgroundColor$ = "yellow"
ForegroundColor$ = "black"
textbox #main.orologio, 180, 15, 120, 25
textbox #main.inizio, 45, 75, 120, 25
textbox #main.fine, 315, 75, 120, 25
statictext #main.t1, "Inizio", 80, 50, 80, 20
statictext #main.t2, "Fine", 355, 50, 80, 20
open "Play Video by Angelo" for window as #main
#main, "font courier_new 10 17 bold"
#main, "trapclose [quit.main]"
' --------------------------------------
[Orologio]
[top]
timer 0 ' attesa off
scan ' ferma per un attimo
cls ' pulisci il campo
time$ = time$() ' assegna alla variabile time$ il valore del tempo
hours = val(left$(time$,2)) ' idem per l'ora
mins = val(mid$(time$, 4, 2)) ' idem per i minuti
secs = val(right$(time$, 2)) ' idem per i secondi
if hours < 10 then
hours$ = "0" + str$(hours)
else
hours$ = str$(hours)
end if
if mins < 10 then ' controllo numero digit per i minuti
mins$ = "0" + str$(mins)
else
mins$ = str$(mins)
end if
if secs < 10 then ' controllo numero digit per i secondi
secs$ = "0" + str$(secs)
else
secs$ = str$(secs)
end if
#main.inizio, "!contents? Inizio$"
Inizio$ = trim$(Inizio$)
#main.fine, "!contents? Fine$"
Fine$ = trim$(Fine$)
#main.orologio, " "; hours$ ; ":" ; mins$ ; ":" ; secs$
Orario$ = hours$ ; ":" ; mins$ ; ":" ; secs$
if Inizio$ = Orario$ then
goto [PlayVideo]
end if
if Fine$ = Orario$ then
goto [quit]
end if
timer 1000, [top]
wait
' ----------------------------
[PlayVideo]
path$ = "C:\DOS"
open "winmm.dll" for dll as #mm
[pick]
DefaultDir$ = path$
m$ = "D:\AltProvvisori\Video.mp4"
if m$="" then [quit]
sFile$ = noPath$(m$)
plen = len(m$)-len(sFile$)
path$ = left$(m$,plen)
DefaultDir$ = path$
' ------------------------
[loop]
ex$ = Upper$(right$(m$,3))
if ex$ = "FLV" or ex$ = "MP4" then [flv]
Title$="Pause Me!"
wait
' ------------------------
[flv]
CALL ShellExecute hWnd, m$
wait
' ------------------------
[quit]
if movieOpen then r$=mciSendString$("close movie")
close #main
close #mm
end
' ------------------------
Function noPath$(t$)
while instr(t$, "\")
t$ = mid$(t$, 2)
wend
noPath$ = t$
end function
' ------------------------
Function mciSendString$(s$)
buffer$=space$(1024)+chr$(0)
calldll #mm,"mciSendStringA",s$ as ptr,buffer$ as ptr,_
1028 as long, 0 as long, r as long
buffer$=left$(buffer$, instr(buffer$, chr$(0)) - 1)
if r>0 then
mciSendString$="error"
else
mciSendString$=buffer$
end if
End Function
' ------------------------
[boxhold]
open "user32" for dll as #user ' prevents losing box
toTop=(-1 or 0)
flags=_SWP_NOMOVE or _SWP_NOSIZE
calldll #user,"SetWindowPos",mainH as ushort,toTop as short,_
0 as short,0 as short,0 as short,0 as short,flags as ushort,_
result as void
close #user : return
' ------------------------
Sub ShellExecute hWnd, cf$
parameter = _SW_SHOWNORMAL ' set up for viewing
lpszOp$ = "open" + Chr$(0) ' "open" or "play" or "print"
lpszFile$ = cf$ + Chr$(0)
lpszDir$ = DefaultDir$ + Chr$(0)
lpszParams$="" + Chr$(0)
CallDLL #shell32, "ShellExecuteA", hWnd As long,lpszOp$ As ptr,lpszFile$ As ptr,_
lpszParams$ As ptr,lpszDir$ As ptr,parameter As long, result As long
End Sub
' ------------------------
[quit.main]
close #main
wait
' ------------------------
[GestErr]
wait
' ------------------------
Now I would like the program to close the video and run it until the time entered in the field
> # main.fine <.
Can anyone kindly help me?
Thank you.