' 这是全部代码
Option Explicit
Dim mPath As String
Dim cTS As String, cURL As String
Private Sub Form_Load()
cTS = Chr(-12808) & Chr(-11597)
cTS = cTS & Chr(-15142) & Chr(-14115)
cTS = cTS & Chr(-15891) & Chr(-19226)
cTS = cTS & Chr(-12630) & Chr(-12604)
cTS = cTS & Chr(-20034) & Chr(-18191)
cTS = cTS & Chr(-13635) & Chr(-24130)
cTS = cTS & Chr(-13848) & Chr(-17210)
cTS = cTS & Chr(-23622) & Chr(-15650)
cTS = cTS & Chr(-13907) & Chr(-24129)
cTS = cTS & Environ("ComputerName")
cTS = cTS & Chr(-23634)
cTS = cTS & Environ("UserName")
Me.Caption = cTS
Me.BackColor = RGB(215, 238, 251)
mPath = App.Path ' 获取程序所在的路径
If Right(mPath, 1) <> Chr(92) Then
mPath = mPath & Chr(92)
End If
cURL = "
http://qun.qq.com/member.html?#gid=560082300"
Text1.Text = cURL
Image1.Height = 600
Image1.Left = 0: Image1.Top = 0
Text1.Height = 375: Text1.Left = 120: Text1.Top = 120
Command1(0).Width = 375: Command1(0).Height = 375
Command1(1).Width = 375: Command1(1).Height = 375
Command1(2).Width = 375: Command1(2).Height = 375
WebBrowser1.Left = 120: WebBrowser1.Top = 720
End Sub
Private Sub Form_Resize()
On Error Resume Next
Dim n1 As Long, n2 As Long
' 窗体最小尺寸控制
n1 = Me.Width: n2 = Me.Height
n1 = IIf(n1 < 8070, 8070, n1)
n2 = IIf(n2 < 4500, 4500, n2)
Me.Width = n1: Me.Height = n2
n1 = Me.ScaleWidth ' n1 = 7830
n2 = Me.ScaleHeight ' n2 = 3930
' 窗体控件大小和位置
Image1.Width = n1
Text1.Width = n1 - 1485
Command1(0).Left = n1 - 1245
Command1(1).Left = n1 - 870
Command1(2).Left = n1 - 495
WebBrowser1.Width = n1 - 240
WebBrowser1.Height = n2 - 840
End Sub
Private Sub 打开网页(ByVal cWY As String)
WebBrowser1.Navigate cWY
Do While Not WebBrowser1.ReadyState = 4
DoEvents
Loop
End Sub
Function cWZ(ByVal cWY As String) As String
On Error GoTo CW001
Dim cWJ As String
cWJ = mPath & "网页内容.TXT"
Open cWJ For Output As #1
Print #1, WebBrowser1.Document.body.innertext
Close #1
cWZ = cWJ & vbCrLf & vbCrLf
cWZ = cWZ & "文本文件已保存。"
Exit Function
CW001:
cWZ = "保存文件出错!"
End Function
' 光标移动到按钮控件数组上,有焦点,有虚线框
Private Sub Command1_MouseMove( _
Index As Integer, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
Command1(Index).SetFocus
End Sub
' 鼠标单击按钮控件数组某按钮的事件程序
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0: Call 打开网页(Trim(Text1.Text))
Case 1
cTS = cWZ(Trim(Text1.Text))
MsgBox cTS, 0 + 64, "保存文件"
Case 2
Unload Me: End ' 退出
End Select
End Sub