mlist98.frm

一个mp3播放器的源码

      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   795
      TabIndex        =   2
      Top             =   2910
      Width           =   840
   End
   Begin VB.Label Label11 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "全部选中"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   6600
      TabIndex        =   11
      Top             =   2910
      Width           =   840
   End
End
Attribute VB_Name = "MList98"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Sub List_AddData()
 
    Dim cListTreeX As ListItem
    Dim i As Integer
    Dim nCount As Integer
       
    'List.ListItems.Clear
    List.ColumnHeaders.Add , , "曲目序号", List.Width / 6
    List.ColumnHeaders.Add , , "曲目名称", List.Width / 3
    List.ColumnHeaders.Add , , "文件路径", List.Width * 9 / 20
    
    GetFileList
    If bFileList = True Then

        nCount = UBound(cFileNameList)
    
        If nCount > 0 Then
            For i = 1 To nCount
                If Len(Trim(cFileNameList(i))) > 4 And Len(Trim(cFilePathList(i))) > 1 Then
                                        
                    Set cListTreeX = List.ListItems.Add(, , "歌曲" & i, , 2) 'Author 字段。
                    cListTreeX.SubItems(1) = cFileNameList(i)
                    cListTreeX.SubItems(2) = cFilePathList(i)
    
                End If
            Next i
        End If
    End If
    
End Sub

Private Sub Command1_Click()

End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Form_Load()

'On Error GoTo ErrorHander
    Call List_AddData
    Exit Sub

ErrorHander:

    MsgBox "与数据服务器连接出现错误 ！", 0 + 16, "错误信息"
    On Error Resume Next

End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lngReturnValue As Long
    If Button = 1 Then
        ReleaseCapture
        lngReturnValue = SendMessage(hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
    End If
    Line_Move 0, False  '隐藏所有按钮

End Sub

Private Sub Image1_Click(Index As Integer)
    Dim i As Integer, j As Integer
    Dim cListTreeX As ListItem
    Dim DlgInfo As DlgFileInfo
    Dim nCount As Integer
    Dim cString As String
    Dim bSearchFlag As Boolean

    Line_Click True
    Timer2.Enabled = True
    
    Select Case Index
        Case 0
            '选择文件
            With CommDial
                .MaxFileSize = 32767 '被打开的文件名尺寸设置为最大，即32K
                .Flags = cdlOFNHideReadOnly Or cdlOFNAllowMultiselect Or cdlOFNExplorer Or cdlOFNNoDereferenceLinks
                .DialogTitle = "选择音乐文件"
                .Filter = "*.Mp2,*.Mp3|*.Mp3;*.Mp2" '指定文件类型
                .ShowOpen
                DlgInfo = GetDlgSelectFileInfo(.filename)
                .filename = ""      '在打开了*.pif文件后须将Filename属性置空，
                                    '否则当选取多个*.pif文件后，当前路径会改变
            End With
            
            If DlgInfo.iCount > 0 Then
                
                nCount = List.ListItems.Count
                
                For i = 1 To DlgInfo.iCount '所有选中的文件
                    If Len(Trim(DlgInfo.sPath & DlgInfo.sFile(i))) > 7 Then     '此文件是音乐文件
                        bSearchFlag = False
                        For j = 1 To nCount
                            cString = Trim(List.ListItems(j).ListSubItems(2).Text) & "\" & Trim(List.ListItems(j).ListSubItems(1).Text)
                            If StrComp(Trim(DlgInfo.sPath & DlgInfo.sFile(i)), Trim(cString), vbTextCompare) = 0 Then   '此文件已经存在
                                bSearchFlag = True
                                Exit For
                            End If
                        Next j
                        
                        If bSearchFlag = False Then
                            Set cListTreeX = List.ListItems.Add(, , "歌曲" & List.ListItems.Count + 1, , 2) 'Author 字段。
                            cListTreeX.SubItems(1) = DlgInfo.sFile(i)
                            cListTreeX.SubItems(2) = Left(DlgInfo.sPath, Len(Trim(DlgInfo.sPath)) - 1)
                            
                            List.ListItems(List.ListItems.Count).Selected = True
                            List.SetFocus
                            SendKeys "{END}"
                        End If
                    End If
                Next i
            End If
        Case 1  '删除曲目
            For i = List.ListItems.Count To 1 Step -1
                If List.ListItems(i).Selected = True Or List.ListItems(i).Checked = True Then
                    List.ListItems.Remove (i)
                End If
            Next i
            
            For i = 1 To List.ListItems.Count
                List.ListItems(i).Text = "歌曲" & i
            Next i
        Case 2  '保存曲目
            If List.ListItems.Count > 0 Then
                WritePrivateProfileString "FileCount", "Count", CStr(List.ListItems.Count), App.Path & "\Filelist.lst"
                nCount = 0
                For i = 1 To List.ListItems.Count
                    cString = Trim(List.ListItems(i).ListSubItems(2).Text) & "\" & Trim(List.ListItems(i).ListSubItems(1).Text)
                    WritePrivateProfileString "Item", "File" & i, cString, App.Path & "\Filelist.lst"
                    If List.ListItems(i).Checked = True Then
                        nCount = nCount + 1
                    End If
                Next i
                
                bFileList = True
                
                If nCount > 0 Then
                    ReDim cFileNameList(nCount)
                    ReDim cFilePathList(nCount)
                Else
                    ReDim cFileNameList(List.ListItems.Count)
                    ReDim cFilePathList(List.ListItems.Count)
                End If
                
                j = 1
                
                For i = 1 To List.ListItems.Count
                    If nCount > 0 Then
                        If List.ListItems(i).Checked = True Then
                            cFileNameList(j) = List.ListItems(i).ListSubItems(1).Text
                            cFilePathList(j) = List.ListItems(i).ListSubItems(2).Text
                            j = j + 1
                        End If
                    Else
                        cFileNameList(i) = List.ListItems(i).ListSubItems(1).Text
                        cFilePathList(i) = List.ListItems(i).ListSubItems(2).Text
                    End If
                Next i
            Else
                WritePrivateProfileString "FileCount", "Count", "0", App.Path & "\Filelist.lst"
                bFileList = False
            End If
            
            bModiFileListFlag = True
            Unload Me
        Case 3  '退出
            bModiFileListFlag = False
            
            Unload Me
        Case 4
            If Label10.Caption = "全部选中" Then
                For i = 1 To List.ListItems.Count
                    List.ListItems(i).Selected = True
                    List.ListItems(i).SmallIcon = 3
                    List.ListItems(i).Checked = True
                Next i
                Label10.Caption = "全部取消"
                Label11.Caption = "全部取消"
            Else
                For i = 1 To List.ListItems.Count
                    List.ListItems(i).Selected = False
                    List.ListItems(i).SmallIcon = 2
                    List.ListItems(i).Checked = False
                Next i
                Label10.Caption = "全部选中"
                Label11.Caption = "全部选中"
            End If
            Image1(4).ToolTipText = Label10.Caption
    End Select
End Sub

Private Sub Image1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Line_Move Index, True   '显示按钮
    Timer1.Enabled = True
End Sub

Private Sub List_ItemCheck(ByVal Item As MSComctlLib.ListItem)
    Item.SmallIcon = IIf(Item.Checked = False, 2, 3)
End Sub
  

Private Sub List_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    
    Dim i As Integer, j As Integer
    Dim nCount As Integer
    Dim bSearchFlag As Boolean
    Dim cString As String
    Dim cFileName As String
    Dim cFilePath As String
    Dim cListTreeX As ListItem
    
    nCount = List.ListItems.Count
    
    If Data.GetFormat(vbCFFiles) Then
        For i = 1 To Data.Files.Count
            If Len(Trim(Data.Files(i))) > 7 And InStr(1, Trim(Data.Files(i)), ".mp", 1) > 0 Then    '此文件是音乐文件
                bSearchFlag = False
                For j = 1 To nCount
                    cString = Trim(List.ListItems(j).ListSubItems(2).Text) & "\" & Trim(List.ListItems(j).ListSubItems(1).Text)
                    If StrComp(Trim(Data.Files(i)), Trim(cString), vbTextCompare) = 0 Then   '此文件已经存在
                        bSearchFlag = True
                        Exit For
                    End If
                Next j
                
                If bSearchFlag = False Then
                    cFileName = ""
                    cFilePath = ""
                    File_NamePath Trim(Data.Files(i)), cFileName, cFilePath
                
                    Set cListTreeX = List.ListItems.Add(, , "歌曲" & List.ListItems.Count + 1, , 2) 'Author 字段。
                    cListTreeX.SubItems(1) = cFileName
                    cListTreeX.SubItems(2) = cFilePath
                    
                    List.ListItems(List.ListItems.Count).Selected = True
                End If
                List.SetFocus
                SendKeys "{END}"
            End If
        Next i
    End If

End Sub

Sub Line_Move(Index As Integer, bShowFlag As Boolean)

    If bShowFlag = True Then    '允许按钮显示
        Line1.X1 = Image1(Index).Left - 30
        Line1.X2 = Image1(Index).Left + Image1(Index).Width + 30
        Line2.X1 = Image1(Index).Left - 30
        Line2.X2 = Image1(Index).Left + Image1(Index).Width + 30
        Line3.X1 = Image1(Index).Left - 30
        Line3.X2 = Image1(Index).Left - 30
        Line4.X1 = Image1(Index).Left + Image1(Index).Width + 30
        Line4.X2 = Image1(Index).Left + Image1(Index).Width + 30
        
        Line1.Y1 = Image1(Index).Top - 30
        Line1.Y2 = Image1(Index).Top - 30
        Line2.Y1 = Image1(Index).Top + Image1(Index).Height + 30
        Line2.Y2 = Image1(Index).Top + Image1(Index).Height + 30
        Line3.Y1 = Image1(Index).Top - 30
        Line3.Y2 = Image1(Index).Top + Image1(Index).Height + 30
        Line4.Y1 = Image1(Index).Top - 30
        Line4.Y2 = Image1(Index).Top + Image1(Index).Height + 30
        
        Line1.Visible = True
        Line2.Visible = True
        Line3.Visible = True
        Line4.Visible = True
    Else
        Line1.Visible = False
        Line2.Visible = False
        Line3.Visible = False
        Line4.Visible = False
    End If
    
End Sub

Sub Line_Click(bShowFlag As Boolean)    '按钮的四框为凸起或凹进
    If bShowFlag = True Then    '凹进
        Line1.BorderColor = RGB(0, 0, 0)
        Line2.BorderColor = RGB(255, 255, 255)
        Line3.BorderColor = RGB(0, 0, 0)
        Line4.BorderColor = RGB(255, 255, 255)
    Else    '凸起
        Line1.BorderColor = RGB(255, 255, 255)
        Line2.BorderColor = RGB(0, 0, 0)
        Line3.BorderColor = RGB(255, 255, 255)
        Line4.BorderColor = RGB(0, 0, 0)
    End If
End Sub

Private Sub Timer1_Timer()
    Line_Move 0, False
    Timer1.Enabled = False
End Sub

Private Sub Timer2_Timer()  '控制按钮按下时的时间
    Line_Click False
    Timer2.Enabled = False
End Sub