MusicPXY3.1

‎MusicPXY3.1的代码是June ‎28, ‎2019那天晚上改的,HTML的音乐播放器是‎November ‎25, ‎2018晚上改的。

首先放一个用HTML+JS实现的音乐播放器,代码如下。

<html>
    <head>
        <title>MusicPlayer</title>
    </head>
    <body bgcolor="AAEEFF">
        <center>
            <h1 style="color:FF8899">MusicPlayer</h1>
            <audio id="audio" controls loop></audio><br>
            <input style="height:34px;380px;font-size:18" type="file" onchange="audio.src=this.value">
            <h2 style="color:31F">Designer:Leisureeen</h2>
        </center>
    </body>
</html>

这个HTML的播放器要求浏览器必须是比较新的,如果是比较老的版本的浏览器可能无法正常显示控件。

下面重点展示用VB制作的音乐播放器,首先要把comdlg32.ocx文件放到应用程序目录下,还要运行一个小程序,这个小程序主要用于注册播放控件。

方法一:

将如下代码保存为一个后缀名为bat的文件并运行。

@echo off
c:\windows\syswow64\regsvr32 /s wmp.dll
exit

当然这只是针对64位机的,如果是32位机则要将目录改掉。

方法二:

将上面代码的中间的那一行在命令提示符中执行一遍即可。

一般情况下此播放器可以播放mp3、m4a等格式的音乐,如果想让播放器播放flac、ogg等格式的音乐,需要下载安装K-Lite_Codec_Pack

Basic版下载地址(Basic版就够了)

Mega版下载地址

MusicPXY3.1的主窗体(main.frm)代码如下:

Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private iniDir As String

Private Sub ButtTimer_Timer()
    If ButtTimer.Interval > 200 Then ButtTimer.Interval = 100
    If GetAsyncKeyState(vbKeyF9) Then
        PP_Click
        ButtTimer.Interval = 1500
    End If
End Sub

Private Sub fiDir_DblClick()
    On Error Resume Next
    ComD.DialogTitle = "Open Files"
    ComD.Filter = "ALL File(*.*)|*.*"
    ComD.ShowSave
    If ComD.FileName <> "" And ComD.FileName <> MP.URL Then
        MP.URL = ComD.FileName
        fiDir.Text = ComD.FileName
        TBar.Value = 1
        TLabel.Caption = ""
    End If
End Sub

Private Sub FLabel_DblClick()
    On Error Resume Next
    Me.Hide
    ComD.ShowColor
    If ComD.Color Then Me.BackColor = ComD.Color
    If fiDir.BackColor <> Me.BackColor Then fiDir.BackColor = Me.BackColor
    Me.Show
End Sub

Private Sub Form_Load()
    Dim strTmp As String
    On Error Resume Next
    iniDir = App.Path & "\MusicPXY.ini"
    If Dir(iniDir) <> "" Then
        Open iniDir For Input As #1
            Line Input #1, strTmp
            Me.BackColor = Val(strTmp)
            Line Input #1, strTmp
            fiDir.Text = strTmp
            Line Input #1, strTmp
            VBar.Value = 20
            VBar.Value = Val(strTmp)
        Close #1
    End If
    MP.Visible = False
    MP.settings.autoStart = False
    MP.settings.setMode "loop", True
    MP.URL = fiDir.Text
    fiDir.BackColor = Me.BackColor
    ComD.FontBold = True
    ComD.FontSize = 12
    Randomize
    Powe.ForeColor = &HFFBBFF
    TLabel.Caption = ""
    Powe.Caption = "Powered By Leisureeen"
    Me.Caption = VBA.Left(Me.Caption, 12) & "  Designer:Leisureeen"
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    r_Click
End Sub

Private Sub MP_PlayStateChange(ByVal NewState As Long)
    Select Case NewState
    Case 3
        PP.Caption = "Pause"
        TTimer.Enabled = True
    Case 2
        PP.Caption = "Resume"
        TTimer.Enabled = False
    Case Else
        PP.Caption = "Play"
        TTimer.Enabled = False
    End Select
    PoT.Enabled = TTimer.Enabled
End Sub

Private Sub poHz_Change()
    Dim spd(0 To 7) As Long
    spd(0) = 2000: spd(1) = 1200: spd(2) = 1000: spd(3) = 800
    spd(4) = 600: spd(5) = 400: spd(6) = 200: spd(7) = 120
    PoT.Interval = spd(poHz.Value)
End Sub

Private Sub PoT_Timer()
    Powe.ForeColor = IIf(Powe.ForeColor < 8888, 16776980 - Int(Rnd * &HFF), 500 - Int(Rnd * &HFF))
End Sub

Private Sub Powe_Click()
    PoT.Enabled = Not PoT.Enabled
End Sub

Private Sub PP_Click()
    On Error Resume Next
    Select Case VBA.Mid(PP.Caption, 2, 1)
    Case "a"
        MP.Controls.pause
    Case Else
        MP.Controls.play
    End Select
End Sub

Private Sub r_Click()
    On Error Resume Next
    MP.Close
    Open iniDir For Output As #1
        Print #1, Trim(Me.BackColor)
        Print #1, fiDir.Text
        Print #1, Trim(VBar.Value)
    Close
    End
End Sub

Private Sub TBar_Scroll()
    On Error Resume Next
    MP.Controls.currentPosition = TBar.Value * MP.currentMedia.duration / 255
End Sub

Private Sub TLabel_DblClick()
    Me.Caption = Me.Caption & " +++"
    fiDir.Locked = False
    poHz.Visible = True
End Sub

Private Sub TTimer_Timer()
    On Error Resume Next
    TLabel.Caption = MP.Controls.currentPositionString & " / " & MP.currentMedia.durationString
    TBar.Value = Int(255 * MP.Controls.currentPosition / MP.currentMedia.duration)
End Sub

Private Sub VBar_Change()
    MP.settings.volume = 100 - VBar.Value
End Sub

Private Sub VBar_Scroll()
    MP.settings.volume = 100 - VBar.Value
End Sub
原文地址:https://www.cnblogs.com/leisureeen/p/12722649.html