Songplayer, mp3, wma with shuffle play

Share your advanced PureBasic knowledge/code with the community.
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Songplayer, mp3, wma with shuffle play

Post by utopiomania »

Code updated For 5.20+

Here's a simple songplayer I wrote for my laptop mainly. It's meant to be as to the point and efficient as possible.

20051128 Edit: Playlists added, bugfixes (some severe).

Code: Select all

;-songplayer, 20051128, utopiomania

;-Global constants, vars
Enumeration
  #IdWin
  #IdFileOpen
  #IdFileOpenAll
  #IdFileSaveAs
  #IdFilePlayList
  #idFileExplore
  #IdFileExit
  #IdStatus
  #IdTrk1
  #IdTrk2
  #IdBtn1
  #IdBtn2
  #IdBtn3
  #IdChk1
EndEnumeration

;Localised system folders
#CSIDL_PERSONAL = $5 ;C:\Documents and settings\user\My Documents
#CSIDL_MYMUSIC = $D ;C:\Documents and settings\user\my documents\my music

;Used by ChangeCursor()
#IDC_ARROW = 32512
#IDC_WAIT = 32514

Global Folder.s
;Statusbar
Global SbHeight
;Now playing
Global Playing
;Loop/Shuffle
Global Shuffle
;Songs in playlist
Global Songs
;Current full path song name
Global Song.s
;Current songlist index
Global SongNum
;Song volume
Global Volume
;Current playlist
Global PlayList.s
;Song length
Global SongSize

;Songlist
#MaxFiles = 128000
Global Dim SrcFiles.s(#MaxFiles)

Procedure MciLoad(Id, Name.s)
  ProcedureReturn mciSendString_("open " + Chr(34) + Name + Chr(34) + " type mpegvideo alias song" + Str(Id), 0, 0, 0)
EndProcedure

Procedure MciPlay(Id)
  ProcedureReturn mciSendString_("play song" + Str(Id), 0, 0, 0)
EndProcedure

Procedure MciSetVol(Id, Vol)
  ProcedureReturn mciSendString_("setaudio song" + Str(Id) + " volume to " + Str(Vol), 0, 0, 0)
EndProcedure

Procedure MciGetPos(Id)
  Pos.s = Space(#MAX_PATH)
  mciSendString_("status song" + Str(Id) + " position", Pos, #MAX_PATH, 0)
  ProcedureReturn Val(Pos)
EndProcedure

Procedure MciPause(Id)
  ProcedureReturn mciSendString_("pause song" + Str(Id), 0, 0, 0)
EndProcedure

Procedure MciSeek(Id, Pos)
  ProcedureReturn mciSendString_("seek song" + Str(Id) + " to " + Str(Pos), 0, 0, 0)
EndProcedure

Procedure MciStop(Id)
  ProcedureReturn mciSendString_("stop song" + Str(Id), 0, 0, 0)
EndProcedure

Procedure MciFree(Id)
  ProcedureReturn mciSendString_("close song" + Str(Id), 0, 0, 0)
EndProcedure

Procedure MciGetLen(Id)
  Len.s = Space(#MAX_PATH)
  mciSendString_("status song" + Str(Id) + " length", Len, #MAX_PATH, 0)
  ProcedureReturn Val(Len)
EndProcedure

Procedure ChangeCursor(Id)
  SetClassLong_(WindowID(0), #GCL_HCURSOR, LoadCursor_(0,Id))
EndProcedure

Procedure.s GetTrackTime(Pos)
  ;Translate mci position or length to a timestring
  Pos / 1000
  Sec = Pos % 60
  Pos / 60
  Min = Pos % 60
  Pos / 60
  ProcedureReturn RSet(Str(Pos), 2, "0") + ":" + RSet(Str(Min), 2, "0") + ":" + RSet(Str(Sec), 2, "0") 
EndProcedure

Procedure SetTrackPos(Pos, Size)
  ;Sets the trackbar song position
  If Size
    SetGadgetState(#IdTrk1, Pos * 1000 / Size)
  Else
    SetGadgetState(#IdTrk1, 0)
  EndIf
EndProcedure

Procedure DisableGadgets(First, Last, True)
  ;Disables a range of gadgets
  For Id = First To Last
    DisableGadget(Id, True)
  Next Id
EndProcedure

Procedure.s GetSpecialFolder(Id)
  ;Gets localised system folder name
  ;       Structure SHITEMID
  ;         cb.b
  ;         abID.b[1]
  ;       EndStructure
  ;       Structure ITEMIDLIST
  ;         mkid.SHITEMID
  ;       EndStructure
  *ItemId.ITEMIDLIST = #Null
  If SHGetSpecialFolderLocation_(0, Id, @*ItemId) = #NOERROR
    Path.s = Space(#MAX_PATH)
    If SHGetPathFromIDList_(*ItemId, @Path)
      ProcedureReturn Path
    EndIf
  EndIf
EndProcedure

Procedure GetSrcFiles(Path.s, Ext.s, Dirs, Excl)
  ;Fills in the array SrcFiles with full path file names in path.
  ;Lists all(Ext = "") or some(Ext = ".rtf;.htm;") filetypes.
  ;Includes directories if Dirs = 1.
  ;Excludes hidden and system entries if Excl = 1.
  If ExamineDirectory(0, Path, "*.*")
    Repeat
      WindowEvent()
      FileType = NextDirectoryEntry(0)
      If FileType
        Name.s = DirectoryEntryName(0)
        Attr = DirectoryEntryAttributes(0)
        Incl = 1
        If Excl And (Attr & #PB_FileSystem_Hidden) | (Attr & #PB_FileSystem_System)
          ;Hidden or system file, do not include
          Incl = 0
        EndIf
        If Incl
          ;Entry attributes ok,  entry eligible for inclusion
          If FileType = 2
            ;The entry is a directory
            If Dirs And Name<>"." And Name<>".."
              ;To be included and is not a dot entry
              SrcFiles(I) = Path + Name + "\"
              I + 1
              SrcFiles(I) = ""
            EndIf
          Else
            ;The entry is a file
            If Ext
              ;List files with some extensions
              If FindString(LCase(Ext), LCase(GetExtensionPart(Name) + ";"), 1)
                SrcFiles(I) = Path + Name
                I + 1
              EndIf
            Else
              ;List files with all extensions
              E.s = LCase(GetExtensionPart(Name) + ";")
              If Len(E) = 4 And FindString(LCase(Ext), E, 1)
                SrcFiles(I) = Path + Name
                I + 1
                SrcFiles(I) = ""
              EndIf
            EndIf
          EndIf
        EndIf
      EndIf
    Until FileType = 0
  EndIf
  ProcedureReturn I
EndProcedure

Procedure GetAllSrcFiles(Path.s, Ext.s, I, N, Dirs, Excl)
  ;Fills in the array SrcFiles with full path file names in path
  ;and in subdirectories of path.
  ;Lists all(Ext = "") or some(Ext = ".rtf;.htm;") filetypes.
  ;Includes directories if Dirs = 1.
  ;Excludes hidden and system entries if Excl = 1.
  If ExamineDirectory(N, Path, "*.*")
    Repeat
      WindowEvent()
      FileType = NextDirectoryEntry(N)
      If FileType
        Name.s = DirectoryEntryName(N)
        Attr = DirectoryEntryAttributes(N)
        Incl = 1
        If Excl And (Attr & #PB_FileSystem_Hidden) | (Attr & #PB_FileSystem_Hidden)
          ;Hidden or system file,  do not include
          Incl = 0
        EndIf
        If Incl
          ;Entry attributes ok,  entry eligible for inclusion
          If FileType = 2
            ;The entry is a directory
            If Name<>"." And Name<>".."
              ;Open it
              I = GetAllSrcFiles(Path + Name + "\", Ext, I, N + 1, Dirs, Excl)
              ;Returned,   use the current directory
              
              If Dirs
                ;Include directory entries
                SrcFiles(I) = Path + Name + "\"
                I + 1
                SrcFiles(I) = ""
              EndIf
            EndIf
          Else
            ;The entry is a file
            If Ext
              ;List files with some extensions
              E.s = LCase(GetExtensionPart(Name) + ";")
              If Len(E) = 4 And FindString(LCase(Ext), E, 1)
                SrcFiles(I) = Path + Name
                I + 1
                SrcFiles(I) = ""
              EndIf
            Else
              ;List files with all extensions
              SrcFiles(I) = Path + Name
              I + 1
              SrcFiles(I) = ""
            EndIf
          EndIf
        EndIf
      EndIf
    Until FileType = 0
  EndIf
  ProcedureReturn I
EndProcedure

Procedure FileExplore(Path.s)
  ;Explore current folder
  RunProgram("Explorer.exe", Path, "") 
  ProcedureReturn
EndProcedure

Procedure StopSong()
  ;resets play
  If Playing
    MciStop(Playing)
    MciFree(Playing)
    Playing = 0
  EndIf
  ;Clear current playlist
  SrcFiles(0) = ""
  DisableGadgets(#IdTrk1, #IdChk1, #True)
  GadgetToolTip(#Idtrk1, "")
  GadgetToolTip(#IdBtn2, "")
  GadgetToolTip(#IdBtn3, "")
  StatusBarText(#IdStatus, 0, "", #PB_StatusBar_BorderLess) 
  StatusBarText(#IdStatus, 1, "", #PB_StatusBar_BorderLess)
EndProcedure

Procedure FileOpen()
  ;Opens a single song and songlist rom a single folder
  ;After the call to this procedure:
  ;Song holds the full path name To the selected song
  ;SongNum points to the songs location in the songlist
  ;Songs holds the number of songs in the songlist
  PlayList = "No Playlist"
  Ext.s = "Songs (*.mp3;*.wma)|*.mp3;*.wma|Playlists (*.m3u)|*.m3u"
  Opened.s = OpenFileRequester("", Folder + "\", Ext, 0)
  If Opened
    Folder = GetPathPart(Opened)
    Ext = LCase(GetExtensionPart(Opened))
    If Ext = "m3u"
      ;Get playlist
      SongNum = 0
      If ReadFile(0, Opened)
        While Eof(0) = 0
          S.s = ReadString(0)
          If Left(S, 1) <> "#" And Len(S) > 6
            SrcFiles(SongNum) = S
            SongNum + 1
            SrcFiles(SongNum) = ""
          EndIf
        Wend
        CloseFile(0)
        PlayList = Opened
        Songs = SongNum
        SongNum = 0
        Song = SrcFiles(0)
      EndIf
    Else
      ;Get filelist
      Ext = ".mp3;.wma;"
      Songs = GetSrcFiles(Folder, Ext.s, 0, 1)
      ;Locate the song in the filelist
      Song = Opened
      SongNum = 0
      While SrcFiles(SongNum)
        If SrcFiles(SongNum) = Song
          ;Found, SongNum now points to the current song
          Break
        EndIf
        SongNum + 1
      Wend
    EndIf
    ;Opened
    ProcedureReturn #True
  EndIf
  ;Cancelled
  ProcedureReturn #False
EndProcedure

Procedure FileOpenAll()
  ;Opens a single song and songlist from a folder and all folders in it
  ;After the call to this procedure:
  ;Song holds the full path name To the selected song
  ;SongNum points to the songs location in the songlist
  ;Songs holds the number of songs in the songlist
  PlayList = "No Playlist"
  Ext.s = "Songs (*.mp3;*.wma;*.wav)|*.mp3;*.wma;*.wav"
  Opened.s = PathRequester("", Folder + "\")
  If Opened
    Folder = GetPathPart(Opened)
    ;Get filelist
    Ext = ".mp3;.wma;"
    I = 0: N = 0
    ;Wait cursor, recursive call incoming
    ChangeCursor(#IDC_WAIT)
    Songs = GetAllSrcFiles(Folder, Ext, I, N, 0, 1)
    ChangeCursor(#IDC_ARROW)
    If Songs
      ;Select the first song
      SongNum = 0
      Song = SrcFiles(0)
      ;Opened
      ProcedureReturn #True
    EndIf
  EndIf
  ;Cancelled or no songs found
  ProcedureReturn #False
EndProcedure

Procedure FileSaveAs()
  Ext.s = "Playlist (*.m3u)|*.m3u"
  Path.s = SaveFileRequester("", PlayList, Ext, 0)
  If Path
    If GetExtensionPart(Path) = ""
      Path + ".m3u"
    EndIf
    If CreateFile(0, Path)
      I = 0
      While(SrcFiles(I))
        WriteStringN(0,SrcFiles(I))
        I + 1
      Wend
      PlayList = Path
      CloseFile(0)
    EndIf
  Else
    ;Cancelled
    ProcedureReturn #False
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure FilePlayList()
  ;Edit playlist
  RunProgram("notepad.exe", PlayList, "")
  ProcedureReturn
EndProcedure

Procedure.s PrevSong()
  ;Skip to the prev song in the songlist
  If SongNum > 0
    ;Prev
    SongNum - 1
  Else
    ;Skip around to the last song
    SongNum = Songs - 1
  EndIf
  Song = SrcFiles(SongNum)
  ProcedureReturn
EndProcedure

Procedure.s NextSong()
  ;Skip to the next song in the songlist
  If SongNum < Songs - 1
    ;Next
    SongNum + 1
  Else
    ;Skip around to the first song
    SongNum = 0
  EndIf
  Song = SrcFiles(SongNum)
  ProcedureReturn
EndProcedure

Procedure.s AnySong()
  ;Select a random song in the songlist
  SongNum = Random(Songs - 1)
  Song = SrcFiles(SongNum)
  ProcedureReturn
EndProcedure

Procedure PlaySong()
  If Playing
    ;Unload current song
    MciStop(Playing)
    MciFree(Playing)
  Else
    ;Set song mci Id
    Playing = 1
  EndIf
  MciLoad(Playing, Song)
  SongSize = MciGetLen(Playing)
  If SongSize
    ;Set prev button tooltips
    PrevSong()
    GadgetToolTip(#IdBtn2, GetFilePart(SrcFiles(SongNum)))
    ;Set next button tooltip
    NextSong()
    NextSong()
    GadgetToolTip(#IdBtn3, GetFilePart(SrcFiles(SongNum)))
    ;Current song
    PrevSong()
    ;Start play
    SetTrackPos(Playing, 0)
    MciPlay(Playing)
    ;Update statusbar, and trackbar tooltip
    S.s = Str(SongNum) + "/" + Str(Songs - 1) + " - " + LCase(GetFilePart(Song))
    StatusBarText(#IdStatus, 1, S, #PB_StatusBar_BorderLess)
    GadgetToolTip(#IdTrk1, GetFilePart(PlayList) + " - " + Song)
  EndIf
  ProcedureReturn
EndProcedure

Procedure OpenMainWindow()
  ;Main program window
  Flags = #PB_Window_ScreenCentered|#PB_Window_SystemMenu|#PB_Window_MinimizeGadget
  If OpenWindow(#IdWin, 0, 0, 400, 108, "songplayer - www.utopiomania.com", Flags)
    ;Menus
    If CreateMenu(#PB_Any, WindowID(#IdWin))
      MenuTitle("File")
      MenuItem(#IdFileOpen, "Open Song/Playlist...")
      MenuItem(#IdFileOpenAll, "Open All Songs In...")
      MenuBar()
      MenuItem(#IdFileSaveAs, "Save As Playlist...")
      MenuItem(#IdFilePlayList, "Playlist..")
      MenuBar()
      MenuItem(#IdFileExplore, "Explore Folder...")
      MenuBar()
      MenuItem(#IdFileExit, "Exit")
    Else
      ProcedureReturn 0
    EndIf
    ;Set the default font
    LoadFont(1,"tahoma", 10)
    SetGadgetFont(#PB_Default, FontID(1))
    ;Statusbargadget
    hStatus = CreateStatusBar(#IdStatus, WindowID(#IdWin))
    If hStatus
      ;Get the statusbar height
      SendMessage_(hStatus, #SB_GETRECT, 0, @Value.RECT)
      SbHeight = Value\bottom - Value\top + 1
      ;Time field       
      AddStatusBarField(110)
      StatusBarText(#IdStatus, 0, "", #PB_StatusBar_BorderLess)
      ;Song name field
      AddStatusBarField(290)
      StatusBarText(#IdStatus, 1, "", #PB_StatusBar_BorderLess)
    Else
      ProcedureReturn 0
    EndIf
    ;Create a new gadget list for the current window
    
    ;Pos trackbar
    TrackBarGadget(#IdTrk1, 5, 5, 255, 23, 0, 1000)
    ;Vol trackbar
    TrackBarGadget(#IdTrk2, 290, 5, 100, 23, 0, 1000)
    GadgetToolTip(#IdTrk2, "Volume ")
    ;Play/Stop button
    ButtonGadget(#IdBtn1, 5, 55 - SbHeight, 80, 23, "Play")
    GadgetToolTip(#IdBtn1, "Pause or Play current song")
    ;Prev song button
    ButtonGadget(#IdBtn2, 90, 55 - SbHeight, 80, 23, "Prev Song")
    GadgetToolTip(#IdBtn2, "Play previous song")     
    ;Next song button
    ButtonGadget(#IdBtn3, 175, 55 - SbHeight, 80, 23, "Next Song")
    GadgetToolTip(#IdBtn3, "Play next song")
    ;Shuffle play checkbox
    CheckBoxGadget(#IdChk1, 298, 55 - SbHeight, 100, 23, "Shuffle Play")
    GadgetToolTip(#IdChk1, "Shuffle play/Loop song")
    SetGadgetState(#IdChk1, Shuffle)
    
  EndIf
  ProcedureReturn 1
EndProcedure

;-Startrun
Shuffle = #True
OpenMainWindow()
DisableGadgets(#IdTrk1, #IdChk1, #True)

;Default startup folder, \Documents and settings\user\my documents\my music
Folder = GetSpecialFolder(#CSIDL_MYMUSIC)

;Set initial vol
SetGadgetState(#IdTrk2, 800)
GadgetToolTip(#IdTrk2, "Volume - " + Str(800))

;Fileopen dialog
If FileOpen()
  ;Enable gadgets
  DisableGadgets(#IdTrk1, #IdChk1, #False)
  PlaySong()
  MciSetVol(Playing, 800)
  SetGadgetText(#IdBtn1, "Pause")
EndIf

;-EventHandler
Repeat
  IdEvent = WindowEvent()
  Pos = MciGetPos(Playing)
  Delay(20)
  Select IdEvent
    Case 0
      If Playing
        If GetGadgetState(#IdTrk1) <> Pos * 1000 / SongSize
          Pos = MciGetPos(Playing)
          ;Position has changed
          If Pos = SongSize
            ;Song has ended
            If Shuffle
              ;Select and play a random song
              AnySong()
              PlaySong()
            Else
              ;Loop song
              PlaySong()
            EndIf
          Else
            SetTrackPos(Pos, SongSize)
            S.s = "  " + GetTrackTime(Pos) + " / " + GetTrackTime(SongSize)
            StatusBarText(#IdStatus, 0, S, #PB_StatusBar_BorderLess)
          EndIf
        EndIf
      EndIf
    Case #PB_Event_CloseWindow
      ;Program closed
      Exit = #True
    Case #PB_Event_Menu
      Select EventMenu()
        Case #IdFileOpen
          StopSong()
          If FileOpen()
            ;File opened, enable gadgets
            DisableGadgets(#IdTrk1, #IdChk1, #False)
            PlaySong()
            SetGadgetText(#IdBtn1, "Pause")
          EndIf
        Case #IdFileOpenAll
          StopSong()
          If FileOpenAll()
            ;List opened, enable gadgets
            DisableGadgets(#IdTrk1, #IdChk1, #False)
            PlaySong()
            SetGadgetText(#IdBtn1, "Pause")
          EndIf
        Case #IdFileSaveAs
          FileSaveAs()
        Case #IdFilePlayList
          FilePlayList()
        Case #IdFileExplore
          FileExplore(Folder)
        Case #IdFileExit
          Exit = #True
      EndSelect
    Case #PB_Event_Gadget
      Select EventGadget()
        Case #IdTrk1
          ;Move pos trackbar
          If Playing
            Pos = GetGadgetState(#IdTrk1) * SongSize / 1000
            SetTrackPos(Pos, SongSize)
            MciSeek(Playing, Pos)
            If Pos
              ;Resume play
              MciPlay(Playing)
              SetGadgetText(#IdBtn1, "Pause")
            Else
              ;Moved to 0, stop             
              SetGadgetText(#IdBtn1, "Play")
            EndIf
          EndIf
        Case #IdTrk2
          ;Move vol trackbar
          MciSetVol(Playing, GetGadgetState(#IdTrk2))
          GadgetToolTip(#IdTrk2, "Volume - "+Str(GetGadgetState(#IdTrk2)))
        Case #IdBtn1
          ;Stop/Play
          Text.s = GetGadgetText(#IdBtn1)
          If Text = "Pause"
            ;Song is playing
            MciPause(Playing)
            SetGadgetText(#IdBtn1, "Play")
          Else
            ;Song is paused
            MciPlay(Playing)
            SetGadgetText(#IdBtn1, "Pause")
          EndIf 
        Case #IdBtn2
          ;Prev song
          PrevSong()
          PlaySong()
        Case #IdBtn3
          ;Next song
          NextSong()
          PlaySong()
        Case #IdChk1
          ;Shuffle play
          Shuffle = GetGadgetState(#IdChk1)
      EndSelect
  EndSelect
Until Exit

;-EndRun
If Playing
  MciFree(Playing)
EndIf
End

Last edited by utopiomania on Mon Nov 28, 2005 4:58 pm, edited 4 times in total.
dracflamloc
Addict
Addict
Posts: 1648
Joined: Mon Sep 20, 2004 3:52 pm
Contact:

Post by dracflamloc »

User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

Hi! looks good, I'll check it out!
dige
Addict
Addict
Posts: 1413
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Post by dige »

@utopiomania: good work!
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

@dige, Thanks :)

I've updated it, heres the log:
.LOG
16:58 25.11.2005
Added vol control
Simple playlist support
More informative tooltips
18:38 25.11.2005
removed 'All Files *.*' entries from fileopen dialogs, and wav support
19:06 25.11.2005
shuffle play checked by default
19:18 25.11.2005
Fixed open all files in.. chrash
19:34 25.11.2005
upped file num to 128000, checked cpu usage bad/mem usage ok
20:02 25.11.2005
fixed getallsrcfiles() error
21:14 25.11.2005
tweaked eventhandler, cpu down from ~55% to ~4%, wmplayer is ~35%)
And submitted. On my laptop it now has a cpu of ~4%, while mediaplayer 10 shows ~35%. :)
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Nice one - thanks.

cheers
Baldrick
Addict
Addict
Posts: 860
Joined: Fri Jul 02, 2004 6:49 pm
Location: Australia

Post by Baldrick »

Hi utopiomania,
Seems good, but my compiler locks up when I try to create exe file from it.
I have been playing around recently with the idea of making a little user lib which I have called DeMusic Lib. - DE is my real life name initials :) ( Not released yet, but you can download from my personal site to try it out. - I will probably change a few bits before release yet though.)
Click here to Download <--- the Lib & help files.
The zip file contains the Lib file & also a compiled help file which you will need to manually paste into your PB directories. Also I have included source for the Lib file.

The below code is a small Mp3 player I made using my lib to test it out a little.
Try it, let me know what you think.
Regards,
Baldrick
p.s. I didn't really make this little Mp3 player for the forum, so sorry for all the ":" between commands instead of new lines.

Code: Select all

  ; Quick Mp3 player by Baldrick 26/11/2005
  ; This code is a little Mp3 player made using my DeMusic user Lib which is available currently 
  ; from my own webspace at this stage until I am happy that the lib works as I want it too.
  ; I will probably release this Lib through PureArea then.... 
  ; enjoy :)
 RunOnlyOneInstance();<--- requires Droopy's lib, so just comment out if you don' have it
 Enumeration
 #MainWindow:#Menu_0:#MQuit:#Frame:#Songlist:#DirSel:#Play:#Stop:#PlayAll:#Volume:#VolumeText
 #Balance:#BalanceText:#Pause:#StatBar:#Repeat:#Random:#Speed:#SpeedText:#About:#AboutWin:#AboutText
 #Directory_0
 EndEnumeration
 AppName$="Quick Mp3 Player"
 Track1=-1;deliberately give Track1 a value prior to use due to mci returns of 0 for "command successfull"
 
  mainwin.l = OpenWindow(#mainWindow,0,0,285,210,#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered,AppName$)
  If mainwin
  CreateMenu(#Menu_0,WindowID(#MainWindow))
  MenuTitle("&File")
  MenuItem(#MQuit,"E&xit or Esc"):AddKeyboardShortcut(#MainWindow,#PB_Shortcut_Escape,#MQuit)
  MenuTitle("&About")
  MenuItem(#About,"Abou&t")
  CreateGadgetList(WindowID(#MainWindow))
  ContainerGadget(#Frame,1,1,268,168)
 ComboBoxGadget(#Songlist,3,10,180,200)
 ButtonGadget(#DirSel,190,10,70,20,"Select Album")
 ButtonGadget(#Play,3,40,60,20,"Play")
 ButtonGadget(#Pause,100,40,60,20,"Pause")
 ButtonGadget(#Stop,195,40,60,20,"Stop")
 CheckBoxGadget(#PlayAll,10,65,53,15,"Play All")
 CheckBoxGadget(#Repeat,100,65,55,15,"Repeat")
 CheckBoxGadget(#Random,180,65,59,15,"Random")
 TextGadget(#VolumeText,15,100,80,15,"Volume")
 TrackBarGadget(#Volume,1,80,100,20,0,100)
 SetGadgetState(#Volume,75)
 TextGadget(#BalanceText,185,100,80,15,"Balance")
 TrackBarGadget(#Balance,165,80,100,20,0,200)
 SetGadgetState(#Balance,100)
 TrackBarGadget(#Speed,1,115,100,20,0,200)
 SetGadgetState(#Speed,100)
 TextGadget(#SpeedText,15,135,100,20,"Speed")
 CloseGadgetList()
 CreateStatusBar(#StatBar,WindowID(#MainWindow))
 AddStatusBarField(45);0 Track status
 AddStatusBarField(140);1 Track Title
 AddStatusBarField(50);2 Track playing position
 AddStatusBarField(50);3 Track total length
 EndIf
 
 Repeat
 EventID.l=WindowEvent():If EventID=0:Delay(1):Else:Delay(0):EndIf
 MyFocus=GetFocus_()
 If AboutWin:If MyFocus<>WindowID(#AboutWin):SetFocus_(WindowID(#AboutWin)):EndIf:EndIf
 ;- setup statusbar info, etc
 If track1=0
 status$=DeMusicGetStatus(1):SongPos$=DeMusicGetPosition(1,1):SongLength$=DeMusicGetLength(1,1)
 If statusA$<>Status$:StatusA$=Status$:StatusBarText(#Statbar,0,Status$):EndIf
 If CurrentSongA$<>CurrentSong$:CurrentSongA$=CurrentSong$:StatusBarText(#Statbar,1,CurrentSong$):EndIf
 If SongPosA$<>SongPos$:SongPosA$=SongPos$:StatusBarText(#Statbar,2,SongPos$):EndIf
 If SongLengthA$<>SongLength$:SongLengthA$=SongLength$:StatusBarText(#Statbar,3,SongLength$):EndIf
 EndIf
 If Track1>0
 MessageRequester("Error "+AppName$,"Music Loading failure - "+Str(Track1)); error number is direct mci error
 Track1=-1
 EndIf
 ;- play current selected song from songlist
 If StartPlay=1:StartPlay=0
 If Track1=0:DeMusicClose(1):Track1=-1:EndIf;close & reset Track1
 currentsong$=GetGadgetText(#SOnglist):title$=Selectdir$+currentsong$
 If Track1<>0:Track1=DeMusicLoad(1,title$):EndIf
 If Track1=0:Playing=DeMusicPlay(1):Play=1:TotalSongs=CountGadgetItems(#SOngList):EndIf
 VolumeCheck=1:SpeedCheck=1
 EndIf
 ;- setup play & repeat states for multiple song playing
 If CheckBoxTest=0:CheckBoxTest=1
 PlayAll=GetGadgetState(#PlayAll):RepeatState=GetGadgetState(#Repeat)
 If PlayAll=1 And RepeatState=1:PlayAllRepeat=1:RandomSet=4:EndIf
 If PlayAll=1 And RepeatState=0:PlayAllRepeat=1:RandomSet=2:EndIf
 If PlayAll=0 And RepeatState=0:PlayAllRepeat=0:If status$="stopped":Play=0:EndIf:RandomSet=1:EndIf
 If PlayAll=0 And RepeatState=1:PlayAllRepeat=1:RandomSet=3:EndIf
 If RandomSet=1 Or RandomSet=3:DisableGadget(#Random,1):SetGadgetState(#Random,0):EndIf
 If RandomSet=2 Or RandomSet=4:DisableGadget(#Random,0):EndIf
 EndIf
 If SongCount=0:SongCount=1:EndIf
 If status$="playing"
 If PlayAll=0 And RepeatState=1:SongCount=0:EndIf
 If RepeatState=0:If SongCount=>TotalSongs:Play=0:SongCount=0:EndIf:EndIf
 If PlayAllRepeat=1 And Play=1 And SongPos$=SongLength$
 TotalSongs=CountGadgetItems(#SOngList):RandomState=GetGadgetState(#Random):CurrentSong=GetGadgetState(#SOnglist)
 If PlayAll=1 And RepeatState=0:NextSong=CurrentSong+1:EndIf
 If PlayAll=1 And RepeatState=1:NextSong=CurrentSong+1:EndIf
 If PlayAll=0 And RepeatState=1:NextSong=CurrentSong:EndIf
 If Randomstate=1:NextSong=Random(TotalSongs-1):EndIf
 If NextSong=TotalSongs:NextSong=0:EndIf
 If NextSong<TotalSongs:If SongCount=0:SongCount=1:EndIf:SongCount+1:SetGadgetState(#SOnglist,NextSong)
 If Track1=0:DeMusicClose(1):Track1=-1:EndIf
 currentsong$=GetGadgetText(#SOnglist):title$=Selectdir$+currentsong$
 If Track1<>0:Track1=DeMusicLoad(1,title$):EndIf
 If Track1=0:Playing=DeMusicPlay(1):Play=1:SpeedCheck=1:VolumeCheck=1:EndIf:EndIf:EndIf
 EndIf
 ;- setup volume \ balance \ speed levels in real time
 VolumeGad=GetGadgetState(#Volume)
 If Volume<>VolumeGad*10 Or VolumeCheck=1:Volume=VolumeGad*10:VolumeCheck=0
 VolSet=DeMusicSetVolume(1,Volume):VolumeGet=DeMusicGetVolume(1)
 SetGadgetText(#VolumeText,"Volume: "+Str(VolumeGet/10)):VolMod=1:EndIf
 BalanceGad=GetGadgetState(#Balance)
 If Balance<>BalanceGad*10 Or VolMod=1:Balance=BalanceGad*10
 BalSet$=DeMusicSetBalance(1,Volume,Balance):BalanceGet=DeMusicGetBalance(1)
 SetGadgetText(#BalanceText,"Balance: "+Str(BalanceGet/10)):VolMod=0:EndIf
 SpeedGad=GetGadgetState(#Speed)
 If Speed<>SpeedGad*10 Or SpeedCheck=1:Speed=SpeedGad*10:SpeedCheck=0
 SpeedSet=DeMusicSetSpeed(1,Speed):SpeedGet=DeMusicGetSpeed(1)
 SetGadgetText(#SpeedText,"Speed: "+Str(SpeedGet/10)):EndIf
 
 If EventID = #PB_EventMenu
 Select EventMenuID()
 Case #MQuit:Quit=1
 Case #About
 Aboutwin.l = OpenWindow(#AboutWin,0,0,250,85,#PB_Window_SystemMenu | #PB_Window_ScreenCentered,"About "+AppName$,WindowID(#MainWindow))
 If Aboutwin
 About$=Appname$+#CRLF$+#CRLF$
 About$=About$+Appname$+" is a demo program written by Baldrick for testing purposes of the "
 About$=About$+"DeMusic user Library which I am currently working on"+#CRLF$+#CRLF$
 CreateGadgetList(WindowID(#AboutWin))
 TextGadget(#AboutText,5,5,240,75,About$,#PB_Text_Center|#PB_Text_Border)
 EndIf
 EndSelect
 EndIf
 If eventID=#PB_EventGadget
 Select EventGadgetID()
 Case #DirSel
 SelectDir$=PathRequester("Please choose Mp3 Album ", "C:\")
 If SelectDir$:entries=ExamineDirectory(#Directory_0,SelectDir$,"*.mp3"):ClearGadgetItemList(#Songlist)
 If entries:Repeat:entryNum=NextDirectoryEntry():If entrynum:EntryName$=DirectoryEntryName()
 AddGadgetItem(#Songlist,-1,EntryName$):EndIf:Until entryNum=0:SetGadgetState(#Songlist,0):EndIf
 EndIf
 If SelectDir$:DirA$=SelectDir$;when valid album is loaded
 Else; deal with cancelled album selection while existing music loaded
 SelectDir$=DirA$
 EndIf
 Case #Play:StartPlay=1:Play=0
 Case #Pause
 If Track1=0
 If status$="playing":pause=DeMusicPause(1):SetGadgetText(#Pause,"Resume"):EndIf
 If status$="paused":resume=DeMusicResume(1):SetGadgetText(#Pause,"Pause"):EndIf
 EndIf
 Case #Stop:If Track1=0:DeMusicStop(1,0):Play=0:SongCount=0:EndIf
 Case #PlayAll:CheckBoxTest=0
 Case #Repeat:CheckBoxTest=0
 Case #Random:CheckBoxTest=0
 EndSelect
 EndIf
 If EventID=#PB_Event_CloseWindow And EventWindowID()=#AboutWin
 CloseWindow(#AboutWin):UseWindow(#MainWindow):About$="":AboutWin=0:EndIf
 If EventID=#PB_Event_CloseWindow And EventWindowID()=#MainWindow:Quit=1:EndIf
 Until Quit=1
 If Track1=0:DeMusicClose(1):EndIf; free music file from memory before ending
 End
dige
Addict
Addict
Posts: 1413
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Post by dige »

Baldrick: looks good and very handy! The Lib is based on MCI api?
Which sound formats are supported?
User avatar
GeoTrail
Addict
Addict
Posts: 2794
Joined: Fri Feb 13, 2004 12:45 am
Location: Bergen, Norway
Contact:

Post by GeoTrail »

@Baldrick, messy code, but VERY cool lib ;)
Any date for the release version?
I Stepped On A Cornflake!!! Now I'm A Cereal Killer!
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

@Baldrick, looks good! I cut my own post out and compiled it to an exe several times without any problems.
I have no idea why the compiler locks up?? Anyone else had any problems with it ?
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

created exe and plays fine here.

No idea why it would hang.

cheers
User avatar
utopiomania
Addict
Addict
Posts: 1655
Joined: Tue May 10, 2005 10:00 pm
Location: Norway

Post by utopiomania »

@rsts, Great :) Since Baldrick is writing a lib, I assume he must use the registered PureBasic. I am thinking about the Api's in there.
Baldrick
Addict
Addict
Posts: 860
Joined: Fri Jul 02, 2004 6:49 pm
Location: Australia

Post by Baldrick »

@utopiomania, Yes I am a registered PureBasic user & luving it :)
I just tried your code again & tonight it compiled into an exe file faster than I could blink, so my PB must have been just having some sort of vapour last night I think. It was making other exe's without problems though, so I think I might put that 1 down to a gremlin in my Xp :roll: .

@dige, thats a good point! I pretty much had in mind controlling Mp3's when writing this little test lib. So I guess it would probably be better to change the name of the Lib to something like DeMp3 lib instead in order to save confusion. [ It will play a few formats such as ".wav", but functionality such as volume / balance/ speed control is lost & definately doesn't like .cda files giving out of range errors when you try to stop or close a song.- I think probably because I am forcing millisecond format when file is loaded. So probably better to stick with mp3 files at this stage.]

@GeoTrail, my code is always messy :) :oops: I am very much a self learner in self teach mode. :D
As for release, I think as I stated above I might rename the commands as DeMp3Load(), etc & rename it to DeMp3 lib before releasing.
I also think I will change the balance setting from a range of 0 to 2000 to a range of -1000 to +1000 to match with the getbalance command prior to releasing. So depending on what happens this weekend, I will see if I can get time to rewrite the commandnames & update the help files to match. I might then get a few ppl from the forum to have a play with it & if it seems good enough I will get Andre to put it on PureArea. [ It would be nice to think I might be able to offer something a little bit worth while back into this forum.]
User avatar
GeoTrail
Addict
Addict
Posts: 2794
Joined: Fri Feb 13, 2004 12:45 am
Location: Bergen, Norway
Contact:

Post by GeoTrail »

Baldrick wrote:I also think I will change the balance setting from a range of 0 to 2000 to a range of -1000 to +1000 to match with the getbalance command prior to releasing.
Yes that's a good idea. Would seem more logical using -1000 and +1000 :)
I Stepped On A Cornflake!!! Now I'm A Cereal Killer!
Post Reply