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;width: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版就够了)
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
posted on 2020-04-17 21:39 Leisureeen 阅读(248) 评论(0) 编辑 收藏 举报