mlist95.frm

一个mp3播放器的源码

    GetFileList
    If nBackColor > -1000 Then
        Me.BackColor = nBackColor
    End If
    
    If nListColor > -1000 Then
        List.BackColor = nListColor
    End If
    
    If nFontColor > -1000 Then
        List.ForeColor = nFontColor
    End If
    
    If bFileList = True Then

        nCount = UBound(cFileNameList)

        If nCount > 0 Then
        
            If nCount > 9 Then
                List.ColumnHeaders(3).Width = List.Width * 7.5 / 20
            Else
                List.ColumnHeaders(3).Width = List.Width * 8.2 / 20
            End If
            
            For i = 1 To nCount
                If Len(Trim(cFileNameList(i))) > 4 And Len(Trim(cFilePathList(i))) > 1 Then
                    Set cListTreeX = List.ListItems.Add(, , "  歌曲" & i, , 1) 'Author 字段。
                    cListTreeX.SubItems(1) = cFileNameList(i)
                    cListTreeX.SubItems(2) = cFilePathList(i)
                End If
            Next i
        End If
    End If
    
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub
Private Sub Form_Load()
    Call List_AddData
'    PhaseInForm Me
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 Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button <> 1 Then
        Me.PopupMenu Menu
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    PhaseOutForm 0, Me
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 = cdlOFNLongNames 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
                
                If nCount + DlgInfo.iCount > 9 Then
                    List.ColumnHeaders(3).Width = List.Width * 7.5 / 20
                Else
                    List.ColumnHeaders(3).Width = List.Width * 8.2 / 20
                End If

                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).SubItems(2)) & "\" & Trim(List.ListItems(j).SubItems(1))
                            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, , 1) '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 Then
                    List.ListItems.Remove (i)
                End If
            Next i
            
            For i = 1 To List.ListItems.Count
                List.ListItems(i).Text = "  歌曲" & i
            Next i
                        
            If List.ListItems.Count > 9 Then
                List.ColumnHeaders(3).Width = List.Width * 7.5 / 20
            Else
                List.ColumnHeaders(3).Width = List.Width * 8.2 / 20
            End If

        Case 2  '保存曲目
            If List.ListItems.Count > 0 Then
                
                WritePrivateProfileString "FileCount", "Count", CStr(List.ListItems.Count), App.Path & "\Filelist.lst"
                
                ReDim cFileNameList(List.ListItems.Count)
                ReDim cFilePathList(List.ListItems.Count)
                               
                For i = 1 To List.ListItems.Count
                    cString = Trim(List.ListItems(i).SubItems(2)) & "\" & Trim(List.ListItems(i).SubItems(1))
                    WritePrivateProfileString "Item", "File" & i, cString, App.Path & "\Filelist.lst"
                    cFileNameList(i) = List.ListItems(i).SubItems(1)
                    cFilePathList(i) = List.ListItems(i).SubItems(2)
                Next i
                
                bFileList = True
                    
            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
                Next i
                Label10.Caption = "全部取消"
                Label11.Caption = "全部取消"
            Else
                For i = 1 To List.ListItems.Count
                    List.ListItems(i).Selected = False
                    List.ListItems(i).SmallIcon = 1
                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


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 List_DblClick()
    Dim i As Integer
    For i = 1 To List.ListItems.Count
        If List.ListItems(i).Selected = True Then
            bDbClickItemFlag = True
            nPlayFileCount = i
            Image1_Click (2)
            Exit For
        End If
    Next i
    
End Sub

Private Sub List_OLEDragDrop(Data As ComctlLib.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).SubItems(2)) & "\" & Trim(List.ListItems(j).SubItems(1))
                    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

Private Sub Menu1_Click(Index As Integer)
    ChangeColor Index
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

Function PhaseInForm(oForm As Object)
Dim lMyHandle As Long
Dim lMyRgn As Long
Dim l As Long
Dim X1 As Long, Y1 As Long, X2 As Long, Y2 As Long
Dim iTime As Long

Dim nStepX As Integer
Dim nStepY As Integer

nStepX = 10
nStepY = 4

iTime = 50
lMyHandle = oForm.hwnd

X1 = 290
Y1 = 116
X2 = 215
Y2 = 109

Do
    lMyRgn = CreateRectRgn(X1, Y1, X2, Y2)

    l = SetWindowRgn(lMyHandle, lMyRgn, True)
    DoEvents
    Sleep (iTime)
    X1 = IIf(X1 < 0, 0, X1 - nStepX)
    Y1 = IIf(Y1 < 0, 0, Y1 - nStepY)
    X2 = IIf(X2 > 505, 505, X2 + nStepX)
    Y2 = IIf(Y2 > 225, 225, Y2 + nStepY)
Loop Until Y2 - Y1 > 230

'MsgBox X1 & ":" & Y1 & ":" & X2 & ":" & Y2

End Function

Function PhaseOutForm(pType As Integer, oForm As Object)
Dim lMyHandle As Long
Dim lMyRgn As Long
Dim l As Long
Dim X1 As Long, Y1 As Long, X2 As Long, Y2 As Long
Dim iTime As Long
Dim nStepX As Integer
Dim nStepY As Integer

nStepX = 10
nStepY = 4

iTime = 50
lMyHandle = oForm.hwnd

X1 = 0
Y1 = 0
X2 = oForm.ScaleX(oForm.Width, vbTwips, vbPixels)
Y2 = oForm.ScaleX(oForm.Height, vbTwips, vbPixels)
Do
    If (pType = 1) Then
        lMyRgn = CreateEllipticRgn(X1, Y1, X2, Y2)
    Else
        lMyRgn = CreateRectRgn(X1, Y1, X2, Y2)
    End If

    l = SetWindowRgn(lMyHandle, lMyRgn, True)
    DoEvents
    Sleep (iTime)
    X1 = X1 + nStepX
    Y1 = Y1 + nStepY
    X2 = X2 - nStepX
    Y2 = Y2 - nStepY
Loop Until Y2 - Y1 < 0

'MsgBox X1 & ":" & Y1 & ":" & X2 & ":" & Y2
End Function

Function ChangeColor(nIndex As Integer)

On Error GoTo ErrHandler
    If nIndex = 7 Then
        Me.BackColor = 8421504
        List.BackColor = 0
        List.ForeColor = 12640511
        WritePrivateProfileString "Screen", "nBackColor", "8421504", App.Path & "\Filelist.lst"
        WritePrivateProfileString "Screen", "nListColor", "0", App.Path & "\Filelist.lst"
        WritePrivateProfileString "Screen", "nFontColor", "12640511", App.Path & "\Filelist.lst"
        WritePrivateProfileString "Screen", "nScreenCount", "-1000", App.Path & "\Filelist.lst"
        Exit Function
    End If
    
    CommDial.CancelError = True
    CommDial.Flags = cdlCCRGBInit
    CommDial.ShowColor
    
    Select Case nIndex
        Case 1
            Me.BackColor = CommDial.Color
            WritePrivateProfileString "Screen", "nBackColor", CStr(CommDial.Color), App.Path & "\Filelist.lst"
        Case 3
            List.BackColor = CommDial.Color
            WritePrivateProfileString "Screen", "nListColor", CStr(CommDial.Color), App.Path & "\Filelist.lst"
        Case 5
            List.ForeColor = CommDial.Color
            WritePrivateProfileString "Screen", "nFontColor", CStr(CommDial.Color), App.Path & "\Filelist.lst"
    End Select
 
    Exit Function
 
ErrHandler:
    ' 用户按了“取消”按钮
    'Resume Next
End Function