📄 playmp3.frm
字号:
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 Image4_Click(Index As Integer)
Image4(Index).Visible = False '置循环标志和图标
If Index = 2 Then
Image4(0).Visible = True
Else
Image4(Index + 1).Visible = True
End If
If Image4(0).Visible = True Then
bRepeatFlag = 0
ElseIf Image4(1).Visible = True Then
bRepeatFlag = -1
ElseIf Image4(2).Visible = True Then
bRepeatFlag = 1
End If
End Sub
Private Sub Label1_Click()
On Error GoTo error_handle
If bVolumeFlag = 1 Then '置声道模式和图标
bVolumeFlag = -1
Else
bVolumeFlag = bVolumeFlag + 1
End If
Select Case bVolumeFlag
Case 0
Label1.Caption = "立体声"
If bOpenFlag = True Then
Mp3Play.SetVolumeP nLeftVolume, nRightVolume
End If
Case -1
Label1.Caption = "左声道"
If bOpenFlag = True Then
Mp3Play.SetVolumeP nLeftVolume, 0
End If
Case 1
Label1.Caption = "右声道"
If bOpenFlag = True Then
Mp3Play.SetVolumeP 0, nRightVolume
End If
End Select
Exit Sub
error_handle:
ErrorLabel.Caption = Error
Resume Next
End Sub
Private Sub Label3_Click()
bOnTopFlag = Not bOnTopFlag '置窗口状态标志和颜色
If bOnTopFlag = True Then
PutWindowOnTop Me, True
Label3.ForeColor = RGB(255, 0, 0)
Else
PutWindowOnTop Me, False
Label3.ForeColor = RGB(191, 191, 191)
End If
End Sub
Private Sub Timer1_Timer()
If bLineShowFlag = True Then '按钮已经按下
bLineShowFlag = False
Line_Click False
Timer1.Interval = 0
End If
End Sub
Sub Get_FileName()
Dim cString As String
Dim nLen, nFileCount, nOldLen As Integer '文件名长度,文件数
Dim nValue As Integer '控件的返回值
nLen = 0
nFileCount = 0
nOldLen = 1
CommDial.filename = "" '初始化文件名
CommDial.MaxFileSize = 16384 '设定文件名缓冲区
CommDial.Filter = "*.Mp2,*.Mp3|*.Mp3;*.Mp2" '指定文件类型
CommDial.Flags = cdlOFNAllowMultiselect Or cdlOFNLongNames '允许多选和长文件名
CommDial.ShowOpen '显示打开文件窗口
cString = Trim(CommDial.filename) & Chr(32) '保存选取的文件
If Len(Trim(cString)) > 4 Then '文件名存在
For nLen = 1 To Len(cString)
If Asc(Mid(cString, nLen, 1)) = 32 Then '含有空格
nFileCount = nFileCount + 1 '文件数累计
End If
Next nLen
If nFileCount = 1 Then '选定了一个文件
ReDim cFileName(1) As String '重新定义文件名数组
For nLen = 1 To Len(cString)
If Asc(Mid(cString, nLen, 1)) = 92 Then '含有"\"
nOldLen = nLen '记住"\"的位置
End If
Next nLen
cFileName(0) = Trim(Mid(cString, 1, nOldLen - 1)) '取出文件路径
cFileName(1) = Trim(cString) '取出文件名
ErrorLabel.Caption = "共选择了1个文件 !"
Else '选定了多个文件
ReDim cFileName(nFileCount - 1) As String '重新定义文件名数组
nFileCount = 0 '重新初始化文件数
For nLen = 1 To Len(cString)
If Asc(Mid(cString, nLen, 1)) = 32 Then
If nFileCount = 0 Then '取出文件路径
cFileName(nFileCount) = Trim(Mid(cString, nOldLen, nLen - nOldLen))
Else '文件路径+文件名
cFileName(nFileCount) = cFileName(0) & "\" & Trim(Mid(cString, nOldLen, nLen - nOldLen))
End If
nFileCount = nFileCount + 1
nOldLen = nLen
End If
Next nLen
ErrorLabel.Caption = "共选择了" & nFileCount - 1 & "个文件 !"
End If
Else
ErrorLabel.Caption = "没有选择任何文件 !"
End If
On Error GoTo error_handle
bPlayFlag = False '播放标志为假
bSkipFlag = 0 '正常播放
If UBound(cFileName) > 0 And Len(Trim(cFileName(1))) > 4 Then '文件列表存在
Label4.Caption = "总 计 : " & UBound(cFileName)
If bOpenFlag = True Then '已有文件打开
Mp3Play.Close '把打开的文件关闭
End If
nValue = Mp3Play.Open(cFileName(1), "")
If nValue = 0 Then
nCount = 1
bOpenFlag = True
Else
bOpenFlag = False
End If
End If
Exit Sub
error_handle:
ErrorLabel.Caption = Error
Resume Next
End Sub
Private Sub Mp3Play_ActFrame(ByVal ActFrame As Long)
Dim nHour As Integer
Dim nMinute As Integer
Dim nSecond As Integer
Dim dTime As Data
Dim cTime As String
nHour = Int(((ActFrame * Mp3Play.MsPerFrame) \ 1000) / 3600) '小时
nMinute = Int(((ActFrame * Mp3Play.MsPerFrame) \ 1000) / 60) '分
nSecond = ((ActFrame * Mp3Play.MsPerFrame) \ 1000) Mod 60 '秒
cTime = nHour & ":" & nMinute & ":" & nSecond
cTime = Format(cTime, "hh:mm:ss") '显示格式
Label2.Caption = cTime
Dim nLen As Single
nFrameCount = ActFrame
nLen = ActFrame / Mp3Play.FrameCount
Line5.X2 = Int(nLen * Picture1.Width * 15) + Line5.X1 '进度线
End Sub
Private Sub Mp3Play_ThreadEnded()
Dim nValue As Integer '控件的返回值
On Error GoTo error_handle
bOpenFlag = False
bPlayFlag = True '播放标志为真
Label2.Caption = "00:00:00"
Label5.Caption = ""
Label5.Left = Picture1.Width * 15
Select Case bSkipFlag
Case 0 '正常播放
Select Case bRepeatFlag
Case 0 '不循环
If nCount < UBound(cFileName) Then '当前文件数不是最后一个
nCount = nCount + 1 '自动播放下一首歌曲
nValue = Mp3Play.Open(cFileName(nCount), "")
If nValue = 0 Then
bOpenFlag = True
bPlayFlag = False '播放标志为假
Image1_Click (2) '开始播放
Else
bOpenFlag = False
End If
Else
nCount = 1 '自动播放第一首歌曲
nValue = Mp3Play.Open(cFileName(nCount), "")
If nValue = 0 Then
bOpenFlag = True
bPlayFlag = False '播放标志为假
ErrorLabel.Caption = "所有文件播放完毕 !"
Else
bOpenFlag = False
End If
End If
Case -1 '单首循环
nValue = Mp3Play.Open(cFileName(nCount), "")
If nValue = 0 Then
bOpenFlag = True
bPlayFlag = False '播放标志为假
Image1_Click (2) '开始播放
Else
bOpenFlag = False
End If
Case 1 '全部循环
If nCount < UBound(cFileName) Then '当前文件数不是最后一个
nCount = nCount + 1 '自动播放下一首歌曲
Else '当前文件数是最后一个
nCount = 1 ''自动播放第一首歌曲
End If
nValue = Mp3Play.Open(cFileName(nCount), "")
If nValue = 0 Then
bOpenFlag = True
bPlayFlag = False '播放标志为假
Image1_Click (2) '开始播放
Else
bOpenFlag = False
End If
bSkipFlag = 0
End Select
Case 1, -1 '下一首和上一首
nValue = Mp3Play.Open(cFileName(nCount), "")
If nValue = 0 Then
bOpenFlag = True
bPlayFlag = False '播放标志为假
Image1_Click (2) '开始播放
Else
bOpenFlag = False
End If
bSkipFlag = 0
Case 100
nValue = Mp3Play.Open(cFileName(1), "")
If nValue = 0 Then
bOpenFlag = True
bPlayFlag = False '播放标志为假
Else
bOpenFlag = False
End If
Case -100
bSkipFlag = 0
End Select
Exit Sub
error_handle:
ErrorLabel.Caption = Error
Resume Next
End Sub
Private Sub Timer2_Timer() '控制文字移动
Dim nVolume As Integer
If ErrorLabel.Left + ErrorLabel.Width > 0 Then
ErrorLabel.Left = ErrorLabel.Left - 15
Else
If Trim(Label5.Caption) <> "" Then '两个标签产生40个像素的距离
If Label5.Left + Label5.Width + 600 < Picture1.Width * 15 Then
ErrorLabel.Left = Picture1.Width * 15
End If
Else
ErrorLabel.Left = Picture1.Width * 15
End If
End If
If Trim(Label5.Caption) <> "" Then
If Label5.Left + Label5.Width > 0 Then
If ErrorLabel.Left + ErrorLabel.Width + 600 < Picture1.Width * 15 _
Or Label5.Left < Picture1.Width * 15 Then
Label5.Left = Label5.Left - 15
End If
Else
If ErrorLabel.Left + ErrorLabel.Width + 600 < Picture1.Width * 15 Then
Label5.Left = Picture1.Width * 15
End If
End If
End If
If nRepeatTime < 20 Then
nRepeatTime = nRepeatTime + 1
End If
On Error Resume Next
If bOpenFlag = True Then '已经打开了文件
If bVolumeValueFlag = False Then '尚未读取音量
bVolumeValueFlag = True
nLeftVolume = Mp3Play.GetVolumeLeftP
nRightVolume = Mp3Play.GetVolumeRightP
End If
If bVolumeFlag = -1 Then '左声道
nVolume = Mp3Play.GetVolumeLeftP
Else '右声道或立体声
nVolume = Mp3Play.GetVolumeRightP
End If
If nVolume > 100 Then
nVolume = 100
ElseIf nVolume < 0 Then
nVolume = 0
End If
Image5.Width = Int((nVolume / 100 * 900) / 15) * 15
End If
End Sub
Private Sub Pic_Set(Index As Integer)
PicClip(Index).ClipX = 0
PicClip(Index).ClipY = 0
PicClip(Index).ClipHeight = PicClip(Index).Height
PicClip(Index).ClipWidth = PicClip(Index).Width
Me.Picture = PicClip(Index).Clip
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -