vbAccelerator - Contents of code file: frmMusicLib.frmVERSION 5.00
Object = "{3D811CB0-6F63-4CA8-BD1E-7858AC6C9A00}#5.6#0"; "vbalSGrid.ocx"
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Begin VB.Form frmMusicLib
Caption = "S-Grid 2.0 Music Library Sample"
ClientHeight = 5655
ClientLeft = 2970
ClientTop = 2550
ClientWidth = 9420
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMusicLib.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5655
ScaleWidth = 9420
Begin vbalIml.vbalImageList ilsIcons
Left = 1740
Top = 5160
_ExtentX = 953
_ExtentY = 953
ColourDepth = 32
Size = 2296
Images = "frmMusicLib.frx":0A02
Version = 131072
KeyCount = 2
Keys = "SORTASCSORTDESC"
End
Begin vbAcceleratorSGrid.vbalGrid grdLib
Height = 4815
Left = 60
TabIndex = 0
Top = 60
Width = 9135
_ExtentX = 16113
_ExtentY = 8493
BackgroundPictureHeight= 0
BackgroundPictureWidth= 0
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderStyle = 2
DisableIcons = -1 'True
End
Begin VB.Menu mnuFileTOP
Caption = "&File"
Begin VB.Menu mnuFile
Caption = "Play &Selected Track"
Index = 0
Shortcut = {F5}
End
Begin VB.Menu mnuFile
Caption = "Play this &Album"
Index = 1
End
Begin VB.Menu mnuFile
Caption = "Play everything by this A&rtist"
Index = 2
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 3
End
Begin VB.Menu mnuFile
Caption = "Make &Playlist for Selected Track..."
Index = 4
End
Begin VB.Menu mnuFile
Caption = "Make Playlist for Selected A&lbum..."
Index = 5
End
Begin VB.Menu mnuFile
Caption = "Make Playlist for Selected Ar&tist..."
Index = 6
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 7
End
Begin VB.Menu mnuFile
Caption = "&Import Files.."
Index = 8
Shortcut = ^I
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 9
End
Begin VB.Menu mnuFile
Caption = "E&xit"
Index = 10
End
End
Begin VB.Menu mnuEditTOP
Caption = "&Edit"
Begin VB.Menu mnuEdit
Caption = "&Tags..."
Index = 0
End
Begin VB.Menu mnuEdit
Caption = "-"
Index = 1
End
Begin VB.Menu mnuEdit
Caption = "&Find..."
Index = 2
Shortcut = ^F
End
Begin VB.Menu mnuEdit
Caption = "-"
Index = 3
End
Begin VB.Menu mnuEdit
Caption = "&Remove Selected Tracks..."
Index = 4
End
Begin VB.Menu mnuEdit
Caption = "-"
Index = 5
End
Begin VB.Menu mnuEdit
Caption = "&Clear Library..."
Index = 6
End
End
Begin VB.Menu mnuViewTOP
Caption = "&View"
Begin VB.Menu mnuView
Caption = "&Columns"
Index = 0
Begin VB.Menu mnuColumns
Caption = ""
Index = 0
End
End
Begin VB.Menu mnuView
Caption = "-"
Index = 1
End
Begin VB.Menu mnuView
Caption = "&Group Box"
Index = 2
End
End
Begin VB.Menu mnuHelpTOP
Caption = "&Help"
Begin VB.Menu mnuHelp
Caption = "&vbAccelerator.com..."
Index = 0
Shortcut = {F1}
End
Begin VB.Menu mnuHelp
Caption = "-"
Index = 1
End
Begin VB.Menu mnuHelp
Caption = "&About..."
Index = 2
End
End
Begin VB.Menu mnuHeaderCtxTOP
Caption = ""
Visible = 0 'False
Begin VB.Menu mnuHeaderCtx
Caption = "Sort &Ascending"
Index = 0
End
Begin VB.Menu mnuHeaderCtx
Caption = "Sort &Descending"
Index = 1
End
Begin VB.Menu mnuHeaderCtx
Caption = "-"
Index = 2
End
Begin VB.Menu mnuHeaderCtx
Caption = "Group by this &Field"
Index = 3
End
Begin VB.Menu mnuHeaderCtx
Caption = "&Group Box"
Index = 4
End
Begin VB.Menu mnuHeaderCtx
Caption = "-"
Index = 5
End
Begin VB.Menu mnuHeaderCtx
Caption = "&Remove this Column"
Index = 6
End
End
Begin VB.Menu mnuGridCtxTOP
Caption = ""
Visible = 0 'False
Begin VB.Menu mnuGridCtx
Caption = "Play this &Track"
Index = 0
End
Begin VB.Menu mnuGridCtx
Caption = "Play this &Album"
Index = 1
End
Begin VB.Menu mnuGridCtx
Caption = "Play everything by this A&rtist"
Index = 2
End
Begin VB.Menu mnuGridCtx
Caption = "-"
Index = 3
End
Begin VB.Menu mnuGridCtx
Caption = "&Remove from Library..."
Index = 4
End
Begin VB.Menu mnuGridCtx
Caption = "-"
Index = 5
End
Begin VB.Menu mnuGridCtx
Caption = "&Edit"
Index = 6
Visible = 0 'False
End
End
End
Attribute VB_Name = "frmMusicLib"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA"
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String,
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As
Long) As Long
Private Const SW_SHOWNORMAL = 1
Private m_fP As frmProgress
Private m_bDirtyLibrary As Boolean
Private Sub playList(colPlay As Collection)
Dim vItem As Variant
For Each vItem In colPlay
ShellExecute Me.hWnd, "Enqueue", vItem, "", "", SW_SHOWNORMAL
Next
End Sub
Private Sub makePlaylist(ByVal sNameHint As String, colPlay As Collection)
Dim sFile As String
Dim cD As New cCommonDialog
Dim vItem As Variant
Dim iFile As Integer
sFile = stripBadFileNameChars(sNameHint) & ".m3u"
If (cD.VBGetOpenFileName(sFile, Filter:="PlayLists (*.M3U)|M3U|All Files
(*.*)|*.*", DefaultExt:="MRU", Owner:=Me.hWnd)) Then
killFileIfExists sFile
On Error GoTo errorHandler
iFile = FreeFile
Open sFile For Binary Access Write Lock Read As #iFile
For Each vItem In colPlay
Put #iFile, , CStr(vItem) & vbCrLf
Next
Close #iFile
End If
Exit Sub
errorHandler:
Dim lErr As Long
Dim sErr As String
lErr = Err.Number
sErr = Err.Description
On Error Resume Next
Close #iFile
On Error GoTo 0
MsgBox "An error occurred trying to write the playlist: " & sErr,
vbExclamation
Exit Sub
End Sub
Private Function stripBadFileNameChars(ByVal sBad As String) As String
Dim i As Long
Dim sC As String
Dim sRet As String
For i = 1 To Len(sBad)
sC = Mid(sBad, i, 1)
Select Case sC
Case "\", "/", "*", ":", "?", """", "<", ">", "|"
sRet = sRet & "_"
Case Else
sRet = sRet & sC
End Select
Next i
stripBadFileNameChars = sRet
End Function
Private Sub addGroupSubItems(ByVal iRow As Long, colPlay As Collection)
Dim iSubRow As Long
Dim iLevel As Long
Dim iSubLevel As Long
Dim bComplete As Boolean
With grdLib
iLevel = .RowGroupingLevel(iRow)
iSubRow = iRow
Do
iSubRow = iSubRow + 1
If (iSubRow > .Rows) Then
bComplete = True
Else
If (.RowIsGroup(iSubRow)) Then
If (.RowGroupingLevel(iSubRow) <= iLevel) Then
bComplete = True
End If
Else
On Error Resume Next
colPlay.Add .CellText(iSubRow, 6), .CellText(iSubRow, 6)
On Error GoTo 0
End If
End If
Loop While Not bComplete
End With
End Sub
Private Sub createSelectionPlayList(colPlay As Collection)
Dim i As Long
Dim iRow As Long
With grdLib
For i = 1 To .SelectionCount
iRow = .SelectedRowByIndex(i)
If (.RowIsGroup(iRow)) Then
addGroupSubItems iRow, colPlay
Else
On Error Resume Next
colPlay.Add .CellText(iRow, 6), .CellText(iRow, 6)
On Error GoTo 0
End If
Next i
End With
End Sub
Private Sub createArtistPlayList(ByVal sArtist As String, colPlay As Collection)
Dim iRow As Long
With grdLib
For iRow = 1 To .Rows
If Not (.RowIsGroup(iRow)) Then
If StrComp(.CellText(iRow, 2), sArtist, vbTextCompare) = 0 Then
colPlay.Add .CellText(iRow, 6), .CellText(iRow, 6)
End If
End If
Next iRow
End With
End Sub
Private Function createAlbumPlayList(ByVal sAlbum As String, colPlay As
Collection)
Dim iRow As Long
With grdLib
For iRow = 1 To .Rows
If Not (.RowIsGroup(iRow)) Then
If StrComp(.CellText(iRow, 3), sAlbum, vbTextCompare) = 0 Then
colPlay.Add .CellText(iRow, 6), .CellText(iRow, 6)
End If
End If
Next iRow
End With
End Function
Private Sub setUpColumnsMenu()
Dim iCol As Long
Dim iMenu As Long
With grdLib
For iCol = 1 To .Columns
If (iMenu > 0) Then
Load mnuColumns(iMenu)
mnuColumns(iMenu).Visible = True
End If
If (.ColumnHeader(iCol) = "") Then
mnuColumns(iMenu).Caption = StrConv(.ColumnKey(iCol), vbProperCase)
Else
mnuColumns(iMenu).Caption = .ColumnHeader(iCol)
End If
mnuColumns(iMenu).Tag = .ColumnKey(iCol)
mnuColumns(iMenu).Checked = .ColumnVisible(iCol)
iMenu = iMenu + 1
Next iCol
End With
End Sub
Private Function findMp3Row(ByVal sFile As String) As Long
Dim sFilename As String
Dim iRow As Long
Dim lFoundRow As Long
sFilename = fileNameOf(sFile)
For iRow = 1 To grdLib.Rows
If InStr(grdLib.CellText(iRow, 6), sFilename) > 0 Then
lFoundRow = iRow
Exit For
End If
Next iRow
findMp3Row = lFoundRow
End Function
Private Sub processMp3File(ByVal sFile As String)
Dim c1 As New cMP3ID3v1
Dim c2 As New cMP3ID3v2
Dim sType As String
Dim lRow As Long
Dim dFileLastImport As Date
Dim dFileDateTime As Date
dFileDateTime = FileDateTime(sFile)
lRow = findMp3Row(sFile)
If (lRow > 0) Then
' Check whether need to process this file or not:
dFileLastImport = grdLib.CellText(lRow, 9)
If (dFileDateTime <= dFileLastImport) Then
' unchanged
Exit Sub
End If
Else
' Add a new row
grdLib.AddRow
lRow = grdLib.Rows
End If
c1.MP3File = sFile
If (c1.HasID3v1Tag) Then
sType = "1"
End If
c2.MP3File = sFile
If (c2.HasID3v2Tag) Then
If (Len(sType) > 0) Then
sType = sType & ","
End If
sType = sType & "2"
End If
If (c2.HasID3v2Tag) Then
grdLib.CellText(lRow, 1) = c2.Title
grdLib.CellText(lRow, 2) = c2.Artist
grdLib.CellText(lRow, 3) = c2.Album
grdLib.CellText(lRow, 4) = c2.Track
grdLib.CellText(lRow, 5) = c2.GenreName(c2.Genre)
grdLib.CellText(lRow, 8) = c2.Year
grdLib.CellText(lRow, 10) = c2.Comment
ElseIf (c1.HasID3v1Tag) Then
grdLib.CellText(lRow, 1) = c1.Title
grdLib.CellText(lRow, 2) = c1.Artist
grdLib.CellText(lRow, 3) = c1.Album
grdLib.CellText(lRow, 4) = c1.Track
grdLib.CellText(lRow, 5) = c1.GenreName(c1.Genre)
grdLib.CellText(lRow, 8) = c1.Year
grdLib.CellText(lRow, 10) = c1.Comment
Else
grdLib.CellText(lRow, 1) = fileNameOf(sFile)
End If
grdLib.CellText(lRow, 6) = sFile
grdLib.CellText(lRow, 7) = sType
grdLib.CellText(lRow, 9) = dFileDateTime
grdLib.CellTextAlign(lRow, 6) = DT_LEFT Or DT_SINGLELINE Or DT_PATH_ELLIPSIS
grdLib.CellTextAlign(lRow, 4) = DT_RIGHT Or DT_SINGLELINE Or DT_END_ELLIPSIS
grdLib.CellTextAlign(lRow, 7) = DT_RIGHT Or DT_SINGLELINE Or DT_END_ELLIPSIS
grdLib.CellTextAlign(lRow, 8) = DT_RIGHT Or DT_SINGLELINE Or DT_END_ELLIPSIS
End Sub
Private Function fileNameOf(ByVal sFile As String) As String
Dim i As Long
For i = Len(sFile) To 1 Step -1
If (Mid(sFile, i, 1) = "\") Then
fileNameOf = Mid(sFile, i + 1)
Exit Function
End If
Next i
fileNameOf = sFile
End Function
Private Sub recurseCheckMP3Files(ByVal sInitDir As String)
Dim colDir As New Collection
Dim colFile As New Collection
Dim sDir As String
Dim sBase As String
Dim vItem As Variant
If (Right(sInitDir, 1) <> "\") Then
sBase = sInitDir & "\"
Else
sBase = sInitDir
End If
sDir = Dir(sBase & "*.*", vbDirectory)
Do While Len(sDir) > 0
'Debug.Print sDir
If (GetAttr(sBase & sDir) And vbDirectory) = vbDirectory Then
If Not (sDir = ".") And Not (sDir = "..") Then
colDir.Add sBase & sDir
End If
Else
If LCase(Right(sDir, 3)) = "mp3" Then
colFile.Add sBase & sDir
End If
End If
sDir = Dir
Loop
' recurse process directories:
For Each vItem In colDir
recurseCheckMP3Files vItem
Next
' process the files
For Each vItem In colFile
m_fP.Import = vItem
processMp3File vItem
If Not (m_fP.Shown) Then
Exit For
End If
DoEvents
Next
End Sub
Private Function musicLibFile() As String
Dim sFile As String
sFile = App.Path
If (Right(sFile, 1) <> "\") Then sFile = sFile & "\"
sFile = sFile & "musicLib.dat"
musicLibFile = sFile
End Function
Private Function musicLibBackupFile() As String
Dim sFile As String
sFile = App.Path
If (Right(sFile, 1) <> "\") Then sFile = sFile & "\"
sFile = sFile & "musicLib.bak"
musicLibBackupFile = sFile
End Function
Private Function getImportFolder() As String
Dim cf As New cBrowseForFolder
cf.hWndOwner = Me.hWnd
cf.UseNewUI = True
cf.Title = "Choose Folder to import MP3 files from"
Dim sFolder As String
sFolder = cf.BrowseForFolder
If (Len(sFolder) > 0) Then
If (Right(sFolder, 1) <> "\") Then
sFolder = sFolder & "\"
End If
getImportFolder = sFolder
End If
End Function
Private Sub importMusic()
Dim sFolder As String
m_bDirtyLibrary = True
sFolder = getImportFolder
If Len(sFolder) > 0 Then
Set m_fP = New frmProgress
m_fP.Show , Me
recurseCheckMP3Files sFolder
Unload m_fP
Set m_fP = Nothing
End If
End Sub
Private Sub loadLibrary()
Dim sFile As String
sFile = musicLibFile()
If (fileExists(sFile)) Then
grdLib.LoadGridData sFile
grdLib_SelectionChange 0, 0
End If
End Sub
Private Sub saveLibrary()
Dim sFile As String
Dim sBackFile As String
sFile = musicLibFile()
If (fileExists(sFile)) Then
sBackFile = musicLibBackupFile()
killFileIfExists sBackFile
FileCopy sFile, sBackFile
killFileIfExists sFile
End If
If (grdLib.Rows > 0) Then
grdLib.SaveGridData musicLibFile()
Else
killFileIfExists sFile
End If
End Sub
Private Function fileExists(ByVal sFile As String) As Boolean
Dim sDir As String
On Error Resume Next
sDir = Dir(sFile)
fileExists = ((Err.Number = 0) And (Len(sDir) > 0))
End Function
Private Sub killFileIfExists(ByVal sFile As String)
On Error Resume Next
Kill sFile
End Sub
Private Sub setUpGrid()
' Set general options:
With grdLib
.BackColor = RGB(80, 120, 100)
.AlternateRowBackColor = RGB(84, 126, 105)
.GroupRowBackColor = RGB(56, 84, 70)
.GroupingAreaBackColor = .BackColor
.ForeColor = RGB(243, 247, 245)
.GroupRowForeColor = .ForeColor
.HighlightForeColor = vbWindowText
.HighlightBackColor = RGB(255, 255, 255)
.NoFocusHighlightBackColor = RGB(200, 200, 200)
.SelectionAlphaBlend = True
.SelectionOutline = True
.DrawFocusRectangle = False
.HighlightSelectedIcons = False
.HotTrack = True
.RowMode = True
.MultiSelect = True
' Add the columns:
.AddColumn "Title", "Title", lColumnWidth:=192,
eSortType:=CCLSortStringNoCase
.AddColumn "Artist", "Artist", lColumnWidth:=128,
eSortType:=CCLSortStringNoCase
.AddColumn "Album", "Album", lColumnWidth:=192,
eSortType:=CCLSortStringNoCase
.AddColumn "Track", "Track", eAlign:=ecgHdrTextALignRight,
eSortType:=CCLSortNumeric
.AddColumn "Genre", "Genre", bVisible:=False,
eSortType:=CCLSortStringNoCase
.AddColumn "Filename", "Filename", eSortType:=CCLSortStringNoCase
.AddColumn "TagType", "TagType", eAlign:=ecgHdrTextALignRight,
bVisible:=False, eSortType:=CCLSortStringNoCase
.AddColumn "Year", "Year", eAlign:=ecgHdrTextALignRight, bVisible:=False,
eSortType:=CCLSortNumeric
.AddColumn "LastImportFileDate", "", , , , bVisible:=False
.AddColumn "Comments", "Comments", bRowTextColumn:=True
.HeaderImageList = ilsIcons
.StretchLastColumnToFit = True
End With
End Sub
Private Sub Form_Load()
setUpGrid
setUpColumnsMenu
Me.Show
Me.Refresh
loadLibrary
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If (m_bDirtyLibrary) Then
Dim fP As New frmProgress
fP.Import = "Saving Music Library..."
fP.Show
fP.Refresh
Me.Enabled = False
saveLibrary
Unload fP
End If
End Sub
Private Sub Form_Resize()
On Error Resume Next
grdLib.Move grdLib.Left, grdLib.TOp, Me.ScaleWidth - grdLib.Left * 2,
Me.ScaleHeight - grdLib.TOp * 2
End Sub
Private Sub grdLib_ColumnClick(ByVal lCol As Long)
Dim iCol As Long
Dim iSortCol As Long
Dim sJunk() As String, eJunk() As ECGSortOrderConstants
With grdLib.SortObject
.ClearNongrouped
iSortCol = .IndexOf(lCol)
If (iSortCol <= 0) Then
iSortCol = .Count + 1
End If
.SortColumn(iSortCol) = lCol
If (grdLib.ColumnSortOrder(lCol) = CCLOrderNone) Or
(grdLib.ColumnSortOrder(lCol) = CCLOrderDescending) Then
.SortOrder(iSortCol) = CCLOrderAscending
Else
.SortOrder(iSortCol) = CCLOrderDescending
End If
grdLib.ColumnSortOrder(lCol) = .SortOrder(iSortCol)
.SortType(iSortCol) = grdLib.ColumnSortType(lCol)
' Place ascending/descending icon:
For iCol = 1 To grdLib.Columns
If (iCol <> lCol) Then
If Not (grdLib.ColumnIsGrouped(iCol)) Then
If grdLib.ColumnImage(iCol) > -1 Then
grdLib.ColumnImage(iCol) = -1
End If
End If
ElseIf grdLib.ColumnHeader(iCol) <> "" Then
grdLib.ColumnImageOnRight(iCol) = True
If (.SortOrder(iSortCol) = CCLOrderAscending) Then
grdLib.ColumnImage(iCol) = 0
Else
grdLib.ColumnImage(iCol) = 1
End If
End If
Next iCol
End With
Screen.MousePointer = vbHourglass
grdLib.Sort
Screen.MousePointer = vbDefault
End Sub
Private Sub grdLib_HeaderRightClick(ByVal x As Single, ByVal y As Single)
Dim lCol As Long
lCol = grdLib.ColumnHeaderFromPoint(x, y)
If (lCol > 0) Then
mnuHeaderCtx(0).Enabled = True
mnuHeaderCtx(1).Enabled = True
mnuHeaderCtx(3).Enabled = True
mnuHeaderCtx(3).Caption = IIf(grdLib.ColumnIsGrouped(lCol), "Don't Group
By This Field", "Group By This Field")
mnuHeaderCtx(6).Enabled = True
mnuHeaderCtx(0).Checked = (grdLib.ColumnSortOrder(lCol) =
CCLOrderAscending)
mnuHeaderCtx(1).Checked = (grdLib.ColumnSortOrder(lCol) =
CCLOrderDescending)
Else
mnuHeaderCtx(0).Enabled = False
mnuHeaderCtx(1).Enabled = False
mnuHeaderCtx(3).Enabled = False
mnuHeaderCtx(6).Enabled = False
mnuHeaderCtx(0).Checked = False
mnuHeaderCtx(1).Checked = False
End If
x = (x + grdLib.ScrollOffsetX) * Screen.TwipsPerPixelX + grdLib.Left
y = y * Screen.TwipsPerPixelY + grdLib.TOp
mnuHeaderCtxTOP.Tag = lCol
Me.PopupMenu mnuHeaderCtxTOP, , x, y
End Sub
Private Sub grdLib_MouseDown(Button As Integer, Shift As Integer, x As Single,
y As Single, bDoDefault As Boolean)
'
'
End Sub
Private Sub grdLib_MouseUp(Button As Integer, Shift As Integer, x As Single, y
As Single)
'
If (Button = vbLeftButton) Or (Button = vbRightButton) Then
Dim lRow As Long
Dim lCol As Long
grdLib.CellFromPoint x \ Screen.TwipsPerPixelX, y \
Screen.TwipsPerPixelY, lRow, lCol
' TODO: bug for multi select: doesn't always raise selection
' changed...
grdLib_SelectionChange lRow, lCol
End If
If (Button = vbRightButton) Then
If (lRow > 0) And (lCol > 0) Then
mnuGridCtxTOP.Tag = lRow
' Show the menu
x = x + grdLib.Left
y = y + grdLib.TOp
Me.PopupMenu mnuGridCtxTOP, , x, y
End If
End If
'
End Sub
Private Sub grdLib_SelectionChange(ByVal lRow As Long, ByVal lCol As Long)
Dim iSelCount As Long
iSelCount = grdLib.SelectionCount
If (lRow > 0) And (lCol > 0) Then
If (grdLib.RowIsGroup(lRow) Or (iSelCount > 1)) Then
mnuGridCtx(0).Caption = "Play &Selected Items"
mnuGridCtx(0).Enabled = True
mnuFile(0).Caption = mnuGridCtx(0).Caption
mnuFile(0).Enabled = True
mnuGridCtx(1).Enabled = False
mnuFile(1).Enabled = False
mnuGridCtx(2).Enabled = False
mnuFile(2).Enabled = False
mnuFile(5).Enabled = False
mnuFile(6).Enabled = False
mnuEdit(0).Enabled = True
mnuEdit(4).Enabled = True
Else
mnuGridCtx(0).Caption = "Play this &Track"
mnuGridCtx(0).Enabled = (iSelCount > 0)
mnuFile(0).Caption = mnuGridCtx(0).Caption
mnuFile(0).Enabled = (iSelCount > 0)
mnuGridCtx(1).Enabled = (iSelCount > 0)
mnuFile(1).Enabled = (iSelCount > 0)
mnuGridCtx(2).Enabled = (iSelCount > 0)
mnuFile(2).Enabled = (iSelCount > 0)
mnuFile(5).Enabled = (iSelCount > 0)
mnuFile(6).Enabled = (iSelCount > 0)
mnuEdit(0).Enabled = (iSelCount > 0)
mnuEdit(4).Enabled = (iSelCount > 0)
End If
Else
mnuGridCtx(0).Enabled = False
mnuFile(0).Enabled = False
mnuGridCtx(1).Enabled = False
mnuFile(1).Enabled = False
mnuGridCtx(2).Enabled = False
mnuFile(2).Enabled = False
mnuFile(5).Enabled = False
mnuFile(6).Enabled = False
mnuEdit(0).Enabled = False
mnuEdit(4).Enabled = False
End If
End Sub
Private Sub mnuColumns_Click(index As Integer)
Dim bS As Long
bS = Not (mnuColumns(index).Checked)
mnuColumns(index).Checked = bS
grdLib.ColumnVisible(mnuColumns(index).Tag) = bS
End Sub
Private Sub mnuEdit_Click(index As Integer)
Select Case index
Case 0 ' Tags
MsgBox "Not implemented", vbInformation
Case 2 ' Find
MsgBox "Not implemented", vbInformation
Case 4 ' remove selected
MsgBox "Not implemented", vbInformation
Case 6 ' clear
If (MsgBox("Are you sure you want to clear the music library?",
vbQuestion Or vbYesNo)) Then
grdLib.Clear
grdLib_SelectionChange 0, 0
End If
End Select
End Sub
Private Sub mnuFile_Click(index As Integer)
Dim colPlay As New Collection
Dim lRow As Long
Dim sText As String
Select Case index
Case 0
mnuGridCtx_Click 0
Case 1
mnuGridCtx_Click 1
Case 2
mnuGridCtx_Click 2
Case 4
lRow = grdLib.SelectedRow
createSelectionPlayList colPlay
If (grdLib.RowIsGroup(lRow)) Then
sText = grdLib.CellText(lRow, grdLib.Columns)
Else
sText = grdLib.CellText(lRow, 1)
End If
makePlaylist sText, colPlay
Case 5
lRow = grdLib.SelectedRow
createAlbumPlayList grdLib.CellText(lRow, 3), colPlay
makePlaylist grdLib.CellText(lRow, 3), colPlay
Case 6
lRow = grdLib.SelectedRow
createArtistPlayList grdLib.CellText(lRow, 2), colPlay
makePlaylist grdLib.CellText(lRow, 2), colPlay
Case 8
importMusic
Case 10
Unload Me
End Select
End Sub
Private Sub mnuGridCtx_Click(index As Integer)
Dim colPlay As New Collection
Dim lRow As Long
Dim vItem As Variant
Select Case index
Case 0 ' selected
lRow = grdLib.SelectedRow
If (mnuGridCtx(1).Enabled) Then
' single selection
ShellExecute Me.hWnd, "Enqueue", grdLib.CellText(lRow, 6), "", "",
SW_SHOWNORMAL
Else
' multi selection
createSelectionPlayList colPlay
playList colPlay
End If
Case 1 ' album
lRow = grdLib.SelectedRow
createAlbumPlayList grdLib.CellText(lRow, 3), colPlay
playList colPlay
Case 2 ' artist
lRow = grdLib.SelectedRow
createArtistPlayList grdLib.CellText(lRow, 2), colPlay
playList colPlay
Case 4 ' remove
If (vbYes = MsgBox("Are you sure you want to remove the selected items
from the library?", vbYesNo Or vbQuestion)) Then
'
'
End If
End Select
End Sub
Private Sub mnuHeaderCtx_Click(index As Integer)
Select Case index
Case 0
If (mnuHeaderCtx(0).Checked) Then
mnuHeaderCtx(0).Checked = False
grdLib.ColumnSortOrder(mnuHeaderCtxTOP.Tag) = CCLOrderNone
Else
mnuHeaderCtx(0).Checked = True
grdLib.ColumnSortOrder(mnuHeaderCtxTOP.Tag) = CCLOrderNone
grdLib_ColumnClick mnuHeaderCtxTOP.Tag
End If
Case 1
If (mnuHeaderCtx(1).Checked) Then
mnuHeaderCtx(1).Checked = False
grdLib.ColumnSortOrder(mnuHeaderCtxTOP.Tag) = CCLOrderNone
Else
mnuHeaderCtx(1).Checked = True
grdLib.ColumnSortOrder(mnuHeaderCtxTOP.Tag) = CCLOrderAscending
grdLib_ColumnClick mnuHeaderCtxTOP.Tag
End If
Case 3
Dim iIndex As Long
iIndex = CLng(mnuHeaderCtxTOP.Tag)
If (grdLib.ColumnIsGrouped(iIndex)) Then
' Ungroup
grdLib.ColumnIsGrouped(iIndex) = False
Else
' Group
grdLib.ColumnIsGrouped(iIndex) = True
End If
Case 4
' Group box:
grdLib.AllowGrouping = Not (grdLib.AllowGrouping)
mnuHeaderCtx(index).Checked = grdLib.AllowGrouping
mnuView(2).Checked = grdLib.AllowGrouping
Case 6
grdLib.ColumnVisible(mnuHeaderCtxTOP.Tag) = False
mnuColumns(mnuHeaderCtxTOP.Tag - 1).Checked = False
End Select
End Sub
Private Sub mnuHelp_Click(index As Integer)
Select Case index
Case 0
ShellExecute Me.hWnd, "open", "http://vbaccelerator.com/", "", "",
SW_SHOWNORMAL
Case 2
frmAbout.Show vbModal, Me
End Select
End Sub
Private Sub mnuView_Click(index As Integer)
Select Case index
Case 2
mnuView(2).Checked = Not (mnuView(2).Checked)
mnuHeaderCtx(4).Checked = mnuView(2).Checked
grdLib.AllowGrouping = mnuView(2).Checked
End Select
End Sub
|
|