?? common.bas
字號:
'//該源碼下載自www.aspx1.com(aspx1.com)
Attribute VB_Name = "common"
'****************************************************************************
'人人為我,我為人人
'枕善居收藏整理
'發布日期:2007/03/15
'描 述:網頁搜索音樂播放器 Ver 1.1.0
'網 站:http://www.Mndsoft.com/ (VB6源碼博客)
'網 站:http://www.VbDnet.com/ (VB.NET源碼博客,主要基于.NET2005)
'e-mail :Mndsoft@163.com
'e-mail :Mndsoft@126.com
'OICQ :88382850
' 如果您有新的好的代碼別忘記給枕善居哦!
'****************************************************************************
Option Explicit
Public X1, Y1 As Integer '用于窗體移動
Public Song As Integer '儲存當前 播放的歌曲 位置
Public Songname As String '儲存當前 播放的歌曲名稱
Public Songpath As String '儲存當前 播放的歌曲 路徑
Public MOVL(2) As Boolean '儲存文件列表窗體是否隨主窗體移動
Public Mm As Double '調整秒鐘 用于調整歌詞現實速度
Public m_lngSel As Long '當前播放的音樂
Public nowTab As Integer '當前Tab ID
Public firstPlay As Boolean '開始播放
Public modeType As Integer '排序方式0、單曲播放。1、單曲循環。2、順序播放。3、列表循環。4、隨機播放
'以下是歌詞下載函數
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" ( _
ByVal pCaller As Long, _
ByVal szURL As String, _
ByVal szFileName As String, _
ByVal dwReserved As Long, _
ByVal lpfnCB As Long _
) As Long
Public Function DownloadFile(ByVal strURL As String, ByVal strFile As String) As Boolean '下載歌詞過程
Dim lngReturn As Long
lngReturn = URLDownloadToFile(0, strURL, strFile, 0, 0)
If lngReturn = 0 Then DownloadFile = True
End Function
Public Sub Lrc(Path1 As String, Name As String) '顯示歌詞 "模塊"
'On Error GoTo End1
Dim T As String
Dim R As String
Dim h As Integer
Dim I
Dim a
Dim b
Dim ph(2) As String
up1:
If Path1 <> "" Then
ph(0) = Path1 & Name & ".lrc"
Else
ph(0) = App.path & "\Lrc\" & Name & ".lrc"
End If
ph(1) = App.path & "\Lrc\" & Name & ".lrc"
If Dir(ph(0)) <> "" Then ph(2) = ph(0): GoTo next1
If Dir(ph(1)) <> "" Then ph(2) = ph(1): GoTo next1 '以上兩行 是 播放文件 位置 存在同文件 的歌詞文件 則執行下一過程 跳過下載
If Dir(App.path & "\lrc\" & frmMain.MP.currentMedia.Name & ".lrc") <> "" Then ph(2) = App.path & "\lrc\" & frmMain.MP.currentMedia.Name & ".lrc": GoTo next1
'---------------------------以下是 下載歌詞
If DownloadFile("http://mp3.baidu.com/m?f=ms&rn=10&tn=baidump3lyric&ct=150994944&word=" + Name + " &lm=-1", "c:\LRC.html") = True Then
Close #1
Open "c:\lrc.html" For Input As #1
Do Until EOF(1)
Line Input #1, T
If InStrRev(T, "lrc") > 0 Then R = T: Exit Do
Loop
Close #1
End If
If R = "" Then frmLrc.Text2 = "歌詞下載失敗": Exit Sub
If DownloadFile(Mid(R, InStrRev(R, "href=") + 6, InStrRev(R, ".lrc") - InStrRev(R, "href=") - 2), App.path & "\lrc\" & Name & ".lrc") = True Then
frmLrc.Text2 = "歌詞下載成功"
GoTo up1
End If '下載歌詞并顯示歌詞 完成
'--------------------以下是將 歌詞 顯示出來
next1:
For a = 1 To 5
frmMain.List1.AddItem " " '歌詞隱藏列表前后添加 5 行
Next a
Close #1
Open ph(2) For Input As #1
Do Until EOF(1)
Line Input #1, a
If Len(Trim(a)) > 7 Or InStrRev(a, "[") > 0 Then
For b = 1 To InStrRev(a, "[")
If InStr(b, a, "[") = b Then
frmMain.List1.AddItem Mid(a, InStr(b, a, "[") + 1, 5) & Mid(a, InStrRev(a, "]") + 1, Len(a) - InStrRev(a, "]"))
frmLrc.L1.Caption = Mid(a, InStrRev(a, "]") + 1, Len(a) - InStrRev(a, "]")) '獲取歌詞寬度
If frmLrc.L1.Width > 4000 Then h = frmLrc.L1.Width '比較歌詞寬度
End If
Next
End If
Loop
Close #1
If h > 4000 Then '設置歌詞寬度
frmLrc.Text1.Width = h + 200
frmLrc.Text2.Width = frmLrc.Text1.Width - 80
frmLrc.Width = frmLrc.Text1.Width + 300
Else '根據歌詞長度重新排列顯示窗體和顯示字體位置
frmLrc.Text1.Width = 3750
frmLrc.Text2.Width = 3660
frmLrc.Text1.Left = 120
frmLrc.Text2.Left = 160
frmLrc.Width = 4020
End If
frmLrc.Text1.Text = ""
For I = 0 To 9 '顯示歌詞的 后 5 句
frmLrc.Text1.Text = frmLrc.Text1.Text & Mid(frmMain.List1.list(I), 6, Len(frmMain.List1.list(I)) - 5) & vbNewLine & vbNewLine & vbNewLine
Next
'--------------------------------- 歌詞 End
End1:
Exit Sub
End Sub
'添加文件到播放列表
Public Sub addMusic(ID As Integer, title As String, Artist As String, time As String, FileName As String, toPlay As Boolean)
Dim lngItem As Long
With frmList.playlist
lngItem = .AddItem()
.ItemText(lngItem, 0) = ID & "." '歌名
.ItemText(lngItem, 2) = title '歌名
.ItemText(lngItem, 4) = Artist '歌手
.ItemText(lngItem, 6) = time '時間
.ItemText(lngItem, 7) = FileName '文件名
'直接播放
If toPlay Then
frmMain.Timer1.Enabled = False
firstPlay = True
frmMain.MP.Controls.stop
frmMain.MP.url = .ItemText(.itemCount - 1, 7)
m_lngSel = Song
Song = .itemCount - 1
frmMain.MP.Controls.play
End If
'.ToolTipText = Title
End With
End Sub
'添加單個文件
Public Sub addSingle(FileName As String)
Dim musicTag As musicTag
Dim title As String
Dim Artist As String
title = ""
Artist = ""
If FileName <> "" Then
musicTag.FileName = FileName
If GetMusicInfo(musicTag) Then
title = musicTag.title
Artist = musicTag.Artist
Else
title = GetFileName(FileName)
End If
title = Replace(title, """", "")
Artist = Replace(Artist, """", "")
addMusic frmList.playlist.itemCount + 1, title, Artist, "00:00", FileName, False
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -