Play a video

[angelo2449]

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.


   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.

[atomose]

Hi,
i dont know if this can help, you can try this code. You just need a .avi file. In my code its "trailer.avi" but you can change name if you change it to into the code


   nomainwin
   WindowWidth=80 : WindowHeight=26 : UpperLeftX=100 : UpperLeftY=120
   open "winmm.dll" for dll as #mm
   button #1, "CLOSE /STOP",[quit],UL,0,0,80,26
   graphicbox #1.map, 0, 0, WindowWidth, WindowHeight
   open "test" for window_popup as #1
   print #1, "trapclose [quit]"

   DefaultDir$ = path$
   m$="trailer.avi"  '---------------------MUST HAVE A "trailer.avi" file with this .bas file to work
   sFile$ = noPath$(m$)
   plen = len(m$)-len(sFile$)
   path$ = left$(m$,plen)
   scrw = 1310 : scrh = 833
   xpos = int((DisplayWidth-scrw)/2) : ypos = int((DisplayHeight-scrh)/2)
   m$=GetShortPathName$(m$)
   r$=mciSendString$("open "+m$+" type MpegVideo alias movie")
   r$=mciSendString$("window movie text " + chr$(34) + "video player" + chr$(34))
   r$=mciSendString$("put movie window at ";xpos;" ";ypos;" ";scrw;" ";scrh)
   r$=mciSendString$("status movie length")
   mlength=val(r$)
   movieOpen=1
   r$=mciSendString$("play movie")
   wait

   [quit]
   if movieOpen then r$=mciSendString$("close movie")
   close #1 : close #mm : end

Function noPath$(t$)
   while instr(t$, "\")
   t$ = mid$(t$, 2)
   wend
   noPath$ = t$
end function

Function GetShortPathName$(lPath$)
   lPath$=lPath$+chr$(0)
   sPath$=space$(256)
   lenPath=len(sPath$)
   open "kernel32" for dll as #k
   calldll #k, "GetShortPathNameA",lPath$ as ptr,_
   sPath$ as ptr,lenPath as long,r as long
   close #k
   GetShortPathName$=left$(sPath$,r)
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"
   if r<=0 then mciSendString$=buffer$
end Function