-
Notifications
You must be signed in to change notification settings - Fork 1
Expand file tree
/
Copy pathFRMWEBACT.frm
More file actions
223 lines (219 loc) · 7.16 KB
/
Copy pathFRMWEBACT.frm
File metadata and controls
223 lines (219 loc) · 7.16 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
VERSION 5.00
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "ieframe.dll"
Begin VB.Form FRMWEBACT
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00AD7900&
BorderStyle = 0 'None
Caption = "活动接受"
ClientHeight = 9390
ClientLeft = 0
ClientTop = 0
ClientWidth = 5355
LinkTopic = "Form1"
ScaleHeight = 626
ScaleMode = 3 'Pixel
ScaleWidth = 357
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.PictureBox IMD
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00AD7900&
BorderStyle = 0 'None
Height = 1455
Index = 5
Left = 1680
ScaleHeight = 97
ScaleMode = 3 'Pixel
ScaleWidth = 105
TabIndex = 7
Top = 4320
Visible = 0 'False
Width = 1575
End
Begin VB.PictureBox IMD
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00AD7900&
BorderStyle = 0 'None
Height = 1455
Index = 4
Left = 1440
ScaleHeight = 97
ScaleMode = 3 'Pixel
ScaleWidth = 105
TabIndex = 6
Top = 3960
Visible = 0 'False
Width = 1575
End
Begin VB.PictureBox IMD
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00AD7900&
BorderStyle = 0 'None
Height = 1455
Index = 3
Left = 1080
ScaleHeight = 97
ScaleMode = 3 'Pixel
ScaleWidth = 105
TabIndex = 5
Top = 3720
Visible = 0 'False
Width = 1575
End
Begin VB.PictureBox IMD
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00AD7900&
BorderStyle = 0 'None
Height = 1455
Index = 2
Left = 840
ScaleHeight = 97
ScaleMode = 3 'Pixel
ScaleWidth = 105
TabIndex = 4
Top = 3360
Visible = 0 'False
Width = 1575
End
Begin VB.PictureBox IMD
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00AD7900&
BorderStyle = 0 'None
Height = 1455
Index = 1
Left = 600
ScaleHeight = 97
ScaleMode = 3 'Pixel
ScaleWidth = 105
TabIndex = 3
Top = 3000
Visible = 0 'False
Width = 1575
End
Begin VB.PictureBox IMD
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H00AD7900&
BorderStyle = 0 'None
Height = 1455
Index = 0
Left = 360
ScaleHeight = 97
ScaleMode = 3 'Pixel
ScaleWidth = 105
TabIndex = 2
Top = 2640
Visible = 0 'False
Width = 1575
End
Begin VB.ListBox LSTLINK
Height = 5640
Left = 8640
TabIndex = 1
Top = 3360
Width = 2775
End
Begin SHDocVwCtl.WebBrowser WEB
Height = 3015
Left = 8760
TabIndex = 0
Top = 240
Width = 2775
ExtentX = 4895
ExtentY = 5318
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
End
Attribute VB_Name = "FRMWEBACT"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type TGUID
Data1 As Long
data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
'// 用来加载Internet上的图片
Private Declare Function OleLoadPicturePath Lib "oleaut32.dll" (ByVal szURLorPath As Long, ByVal punkCaller As Long, ByVal dwReserved As Long, ByVal clrReserved As OLE_COLOR, ByRef riid As TGUID, ByRef ppvRet As IPicture) As Long
'// 从Internet上加载图片
Public Function LoadPicture(ByVal strFilename As String) As PICTURE
Dim IID As TGUID
With IID
.Data1 = &H7BF80980
.data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(2) = &H0
.Data4(3) = &HAA
.Data4(4) = &H0
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
On Error GoTo LocalErr
OleLoadPicturePath StrPtr(strFilename), 0&, 0&, 0&, IID, LoadPicture
Exit Function
LocalErr:
Set LoadPicture = VB.LoadPicture(strFilename)
ERR.Clear
End Function
Private Sub Form_Load()
Me.Hide
WEB.Navigate "http://hi.baidu.com/iceeorgan/item/dfb41b7f65775f6eef1e53c8"
End Sub
Private Sub WEB_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Dim I As Integer, s As String, SB As String, CAST As String
LSTLINK.Clear
s = ""
SB = ""
CAST = "[活动]"
For I = 0 To WEB.Document.links.Length - 1
If WEB.Document.links.Item(I) <> s Then
SB = WEB.Document.links.Item(I).innerText 'SB是页面中所有超链接文字
s = WEB.Document.links.Item(I) 'S是页面中所有超链接
If Left(SB, Len(CAST)) = CAST Then LSTLINK.AddItem SB & "|" & s
End If
Next I
WEB.Silent = True
If LSTLINK.ListCount = 0 Then Exit Sub
IMD(0).PICTURE = LoadPicture(Split(LSTLINK.List(0), "|")(2))
IMD(1).PICTURE = LoadPicture(Split(LSTLINK.List(1), "|")(2))
IMD(2).PICTURE = LoadPicture(Split(LSTLINK.List(2), "|")(2))
IMD(3).PICTURE = LoadPicture(Split(LSTLINK.List(3), "|")(2))
IMD(4).PICTURE = LoadPicture(Split(LSTLINK.List(4), "|")(2))
IMD(5).PICTURE = LoadPicture(Split(LSTLINK.List(5), "|")(2))
For I = 0 To IMD.Count - 1
frmma.IWG(I).SETCOLOR COLOR_NOR, COLOR_HIGH
frmma.IWG(I).SETIMG IMD(I)
frmma.IWG(I).MYTIT = (Split(LSTLINK.List(I), "|")(1))
frmma.IWG(I).SETTIP (Replace(Split(LSTLINK.List(I), "|")(0), "[活动]", ""))
Next
frmma.PF(11).Visible = True
frmma.PF(11).ZOrder 0
Call frmma.RUNSAFE
IS_FIRST_LOAD_ACT = False
End Sub