Loading ...
Sorry, an error occurred while loading the content.

18017Another Media Player

Expand Messages
  • Gordon Sweet
    Dec 1 12:15 AM
      Hope this does not clutter up the emails, but I was delving through my collection of snippets to produce the following. Any suggestions? Dunno why it seldom reaches 100% Gordon Sweet

      nomainwin
      [start]
      open "winmm.dll" for dll as #mm
      WindowWidth = 500 : WindowHeight = 150
      UpperLeftX=DisplayWidth-500
      UpperLeftY=DisplayHeight-250
      help$ = "Use any Video or Music File"
      statictext #main.numer, "",432,10,60,30
      statictext #main.info, help$,20,50,460,30
      button #main, " STOP ", [quit], ll, 400, 1
      graphicbox #main.box, 21, 10, 400, 20
      open "progress bar" for window_nf as #main
      print #main.box, "down; fill white; flush"
      print #main, "trapclose [quit]"
      print #main, "font arial 10 bold"

      [open]
      DefaultDir$ = left$(DefaultDir$,2) + "\"
      filedialog "Any MP3,MID,MPEG,AVI,WMA file","*.mp3;*.mid;*.mpeg;*.wmv;*avi",m$
      if m$="" then [quit]

      x=0 : title$ = m$
      print #main.box,"down; cls; color red; backcolor red; size 1"

      ext$ = right$(upper$(m$),3)
      m$=GetShortPathName$(m$)
      if ext$ = "MID" then
      r$=mciSendString$("open "+m$+" type sequencer alias music")
      goto [pass]
      else
      r$=mciSendString$("open "+m$+" type MpegVideo alias music")
      end if

      [pass]
      r$=mciSendString$("status music length")
      musiclength=val(r$)
      print #main.info, title$;" LENGTH = ";musiclength

      timer 100, [closeSong]
      musicOpen=1
      r$=mciSendString$("play music")

      [closeSong] 'See which part of midi is currently
      'playing and if it is at the end then close
      r$=mciSendString$("status music position")

      pos = val(r$)
      while pos < musiclength
      S=(pos/musiclength)*100
      print #main.numer,int(S);"% ";pos
      print #main.box,"goto ";x;" 1"
      x=400/musiclength*pos
      print #main.box,"boxfilled ";x;" 21"
      scan
      wend

      r$=mciSendString$("close music")
      goto [open]

      [quit]
      timer 0
      if musicOpen=1 then r$=mciSendString$("close music")
      close #mm : close #main
      confirm "More ?"; more$
      if more$ = "yes" then [start]
      end

      Function mciSendString$(s$)
      'Buffer will contain a return string from
      'the function, if there is one.
      buffer$=space$(1024)+chr$(0)
      calldll #mm,"mciSendStringA",s$ as ptr,buffer$ as ptr,_
      1028 as long, 0 as long, r as long

      'truncate returned string at null character
      buffer$=left$(buffer$, instr(buffer$, chr$(0)) - 1)

      if r>0 then
      mciSendString$="error"
      else
      mciSendString$=buffer$
      end if
      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





      [Non-text portions of this message have been removed]
    • Show all 3 messages in this topic