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