📄 form7.frm
字号:
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{48DC3C96-B20F-11D1-A87F-D9394DC38340}#2.6#0"; "FlatBtn2.ocx"
Begin VB.Form Form7
BorderStyle = 0 'None
Caption = "Form7"
ClientHeight = 3000
ClientLeft = 8475
ClientTop = 780
ClientWidth = 4800
LinkTopic = "Form7"
ScaleHeight = 3000
ScaleWidth = 4800
ShowInTaskbar = 0 'False
Begin VB.Timer Timer1
Enabled = 0 'False
Interval = 1000
Left = 4200
Top = 2520
End
Begin SHDocVwCtl.WebBrowser WebBrowser1
Height = 1215
Left = 120
TabIndex = 10
Top = 3120
Width = 4695
ExtentX = 8281
ExtentY = 2143
ViewMode = 0
Offline = 0
Silent = 0
RegisterAsBrowser= 0
RegisterAsDropTarget= 1
AutoArrange = 0 'False
NoClientEdge = 0 'False
AlignLeft = 0 'False
NoWebView = 0 'False
HideFileNames = 0 'False
SingleClick = 0 'False
SingleSelection = 0 'False
NoFolders = 0 'False
Transparent = 0 'False
ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}"
Location = ""
End
Begin VB.ListBox List1
Appearance = 0 'Flat
BackColor = &H000080FF&
Height = 570
Left = 120
TabIndex = 8
Top = 1920
Width = 4575
End
Begin DevPowerFlatBttn.FlatBttn FlatBttn1
Default = -1 'True
Height = 795
Left = 3360
TabIndex = 6
Top = 960
Width = 1320
_ExtentX = 2328
_ExtentY = 1402
AutoSize = 0 'False
BackColor = 33023
Caption = "DownLoad"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TextColor = -2147483630
Object.ToolTipText = ""
MousePointer = 1
Picture = "Form7.frx":0000
End
Begin VB.ComboBox Combo1
Appearance = 0 'Flat
BackColor = &H000080FF&
Height = 300
ItemData = "Form7.frx":08DA
Left = 960
List = "Form7.frx":08E4
Style = 2 'Dropdown List
TabIndex = 4
Top = 1440
Width = 2295
End
Begin VB.TextBox Text1
Appearance = 0 'Flat
BackColor = &H000080FF&
Height = 270
Left = 960
TabIndex = 1
Top = 960
Width = 2295
End
Begin VB.PictureBox Picture1
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 350
Left = 0
Picture = "Form7.frx":0908
ScaleHeight = 345
ScaleWidth = 4800
TabIndex = 0
Top = 0
Width = 4800
Begin DevPowerFlatBttn.FlatBttn FlatBttn10
Height = 300
Left = 4400
TabIndex = 9
Top = 20
Width = 300
_ExtentX = 529
_ExtentY = 529
BackColor = 33023
Caption = ""
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
TextColor = -2147483630
Object.ToolTipText = "关闭"
MousePointer = 1
Picture = "Form7.frx":2362
End
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label5"
Height = 180
Left = 2520
TabIndex = 11
Top = 2640
Width = 540
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "准备就绪"
Height = 180
Left = 120
TabIndex = 7
Top = 2640
Width = 720
End
Begin VB.Label Label3
BackStyle = 0 'Transparent
Caption = "软件没有在本地查找到歌词文件，将从服务器上动态下载Lrc歌词，请您确认歌词信息,搜索时间鉴于网络速度..."
ForeColor = &H0000FFFF&
Height = 435
Left = 120
TabIndex = 5
Top = 480
Width = 4575
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "服务器："
Height = 270
Left = 0
TabIndex = 3
Top = 1545
Width = 975
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "歌曲名称："
Height = 270
Left = 0
TabIndex = 2
Top = 1020
Width = 975
End
Begin VB.Image Image1
Height = 3000
Left = 0
Picture = "Form7.frx":245B
Top = 0
Width = 4800
End
End
Attribute VB_Name = "Form7"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'发布日期：2007/04/06
'描 述：即搜即听的网络播放器
'网 站：http://www.Mndsoft.com/ (VB6源码博客)
'网 站：http://www.VbDnet.com/ (VB.NET源码博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''
''' 界面设计，歌词显示，操作设计 '''
''' 即搜即听的网络播放器 '''
''' 孙凤鸣设计 2007.3.15 '''
''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''
Option Explicit
'-------------------API 移动窗体
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Const SWP_NOSIZE = &H1
Const SWP_NOMOVE = &H2
Const HWND_TOPMOST = -1
Const SWP_SHOWWINDOW = &H40
'-------------------API 移动窗体完毕
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 DDD As Long
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, _
ByVal wFlags As Long _
) As Long
Private Sub FlatBttn1_Click()
Call Der
End Sub
Public Sub Der()
'WebBrowser1.TheaterMode = True
WebBrowser1.Navigate "http://so.50004.com/So.asp?key=" & Text1.Text & "&y=1"
If Form1.A1.URL = "" Then
PathLrc = App.Path & "\lrc\" & Text1.Text & ".lrc"
Else
PathLrc = App.Path & "\lrc\" & Text1.Text & ".lrc"
End If
End Sub
'// 下载一个文件到本地
Public Function DownloadFile(ByVal strURL As String, ByVal strFile As String) As Boolean
On Error Resume Next
Dim lngReturn As Long
Me.Label4.Caption = "正在下载文件，请稍后..."
lngReturn = URLDownloadToFile(0, strURL, strFile, 0, 0)
If lngReturn = 0 Then DownloadFile = True
End Function
Private Sub FlatBttn10_Click()
Me.Hide
Unload Me
End Sub
Private Sub Form_Load()
On Error Resume Next
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
Timer1.Enabled = True
Combo1.Text = "so.50004.com"
Label5.Caption = "10秒后，自动搜索..."
If Form1.A1.URL <> "" Then
Text1.Text = Form1.Text1.Text
End If
DDD = 10
End Sub
Private Sub Timer1_Timer()
If DDD > 0 Then
DDD = DDD - 1
Label5.Caption = DDD & "秒后，自动搜索..."
Else
Label5.Caption = "自动搜索..."
Me.Timer1.Enabled = False
Call Der
End If
End Sub
Private Sub WebBrowser1_ProgressChange(ByVal Progress As Long, ByVal ProgressMax As Long)
On Error Resume Next
Dim AcV As Boolean
Dim alrc As String
'form1.a1.Controls.stop
If WebBrowser1.ReadyState = READYSTATE_LOADING Then
Me.Label4.Caption = "正在搜索服务器，请稍后..."
End If
If WebBrowser1.ReadyState = READYSTATE_COMPLETE Then
Dim vTag, vDoc
Dim Allcount, i
List1.Clear
Set vDoc = WebBrowser1.Document.All
Allcount = vDoc.Length
For i = 0 To Allcount - 1
If UCase(vDoc.Item(i).TagName) = "A" Then '\'找到URL
vTag = vDoc.Item(i).href
If InStr(vTag, ".lrc") Then ' \'检测URL中是否含有http://dhunter.51.net
List1.AddItem vDoc.Item(i).href '\'如果有,则添加到list1中
End If
End If
Next i
List1.Selected(0) = True
If List1.ListCount >= 0 Then
AcV = DownloadFile(List1.Text, PathLrc)
If AcV = True Then
AcV = False
Me.Label4.Caption = "歌词下载完毕"
If Form1.A1.URL = "" Then
Else
Form1.List1.Clear
Open PathLrc For Input As #4
Do While Not EOF(4)
Line Input #4, alrc
Form1.List1.AddItem Trim(alrc)
Loop
Close #4
Form1.A1.Controls.pause
Form1.A1.Controls.play
Me.Hide
Unload Me
End If
End If
End If
End If
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
'按下鼠标左键
If Button = vbLeftButton Then
'为当前的应用程序释放鼠标捕获
ReleaseCapture
'移动窗体
SendMessage Form7.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -