vbAccelerator - Contents of code file: frmMusicLib.frm

VERSION 5.00
Object = "{DE8CE233-DD83-481D-844C-C07B96589D3A}#1.1#0"; "vbalSGrid6.ocx"
Object = "{396F7AC0-A0DD-11D3-93EC-00C0DFE7442A}#1.0#0"; "vbalIml6.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 vbalIml6.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 vbAcceleratorSGrid6.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