用户控件代码如下,左右滚动条不见了,如何让显示
Private Declare Function ReleaseCapture Lib "user32" () As LongPrivate Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Const WM_SETTEXT = &HC
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
Dim OldIdx As Integer
Event SelectTab()
Event URLChang(Index As Integer, URL As String)
Event ProgressChange(Index As Integer, ByVal Progress As Long, ByVal ProgressMax As Long)
Event DownloadComplete(Index As Integer)
Event PropertyChange(Index As Integer, ByVal szProperty As String)
Event DownloadBegin(Index As Integer, URL As Variant)
Event NavigateComplete2(Index As Integer, ByVal pDisp As Object, URL As Variant)
Event TitleChange(Index As Integer, ByVal Text As String)
Event PrintPage()
Event BeforeNavigate2(Index As Integer, URL As Variant)
Public Sub SaveFile()
WB(OldIdx).ExecWB 4, 1
End Sub
Public Sub PrintView()
WB(OldIdx).ExecWB 7, 2
End Sub
Public Sub GoHome()
WB(OldIdx).GoHome
End Sub
Public Sub RefreshPage()
WB(OldIdx).Refresh
End Sub
Public Sub StopLink()
WB(OldIdx).Stop
End Sub
Public Sub Goforward()
On Error Resume Next
WB(OldIdx).Goforward
End Sub
Public Sub Goback()
On Error Resume Next
WB(OldIdx).Goback
End Sub
Public Sub PrintPage()
WB(OldIdx).ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT
End Sub
Public Sub SelectAll()
WB(OldIdx).ExecWB 17, 2
End Sub
Public Sub Getattribute()
WB(OldIdx).ExecWB 10, 2
End Sub
Public Sub Cut()
WB(OldIdx).ExecWB OLECMDID_CUT, OLECMDEXECOPT_DODEFAULT
End Sub
Public Sub Copy()
WB(OldIdx).ExecWB OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT
End Sub
Public Sub paste()
WB(OldIdx).ExecWB OLECMDID_PASTE, OLECMDEXECOPT_DODEFAULT
End Sub
Public Sub pagesetup()
WB(OldIdx).ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT
End Sub
Public Sub Find()
WB(OldIdx).SetFocus
SendKeys "^f"
End Sub
Public Sub GetFile()
Dim doc, objhtml As Object
Dim i As Integer
Dim strhtml As String
Dim nHwnd, eHwnd As Long
If WB(OldIdx).Busy = False Then
Set doc = WB(OldIdx).Document
i = 0
Set objhtml = doc.body.createtextrange()
If Not IsNull(objhtml) Then
strhtml = objhtml.htmltext
Shell "Notepad.exe", vbNormalFocus
nHwnd = FindWindow("Notepad", "无标题 - 记事本")
eHwnd = FindWindowEx(nHwnd, 0&, "Edit", "")
SendMessage eHwnd, WM_SETTEXT, 0, ByVal strhtml
End If
End If
End Sub
Public Sub OpenURL(URL As Variant)
Tstr(OldIdx).Caption = URL
If Tstr(OldIdx).Width >= MTab(OldIdx).Width - 600 Then Tstr(OldIdx).Caption = VBA.Left(Tstr(OldIdx).Caption, 10)
Tstr(OldIdx).Move (MTab(OldIdx).Width - Tstr(OldIdx).Width) / 2, (MTab(OldIdx).Height - Tstr(OldIdx).Height) / 2
WB(OldIdx).Navigate URL
End Sub
Public Sub NewWindow(URL As String)
On Error Resume Next
Dim ResizeIdx As Integer
If List2.ListCount > 0 Then
If List1.ListCount > 0 Then
Tcbt(List2.List(0)).Picture = tc0.Picture
MTab(List2.List(0)).Move MTab(List1.List(List1.ListCount - 1)).Left + 2700, 0
MTab(List2.List(0)).Visible = True
WB(List2.List(0)).Navigate URL
WBCnt(List2.List(0)).Visible = True
Call MTab_MouseDown(List2.List(0), 1, 0, 0, 0)
WBCnt(List2.List(0)).Move 0, 480, UserControl.Width, UserControl.Height - 480
WB(List2.List(0)).Move -20, -20, WBCnt(List2.List(0)).Width + 40, WBCnt(List2.List(0)).Height + 40
List1.AddItem List2.List(0)
List2.RemoveItem 0
Exit Sub
Else
Tcbt(List2.List(0)).Picture = tc0.Picture
MTab(List2.List(0)).Move MTab(0).Left + 2700, 0
MTab(List2.List(0)).Visible = True
WB(List2.List(0)).Navigate URL
WBCnt(List2.List(0)).Move 0, 480, UserControl.Width, UserControl.Height - 480
WBCnt(List2.List(0)).Visible = True
WB(List2.List(0)).Move -20, -20, WBCnt(List2.List(0)).Width, WBCnt(List2.List(0)).Height
Call MTab_MouseDown(List2.List(0), 1, 0, 0, 0)
WBCnt(List2.List(0)).Move 0, 480, UserControl.Width, UserControl.Height - 480
WB(List2.List(0)).Move -20, -20, WBCnt(List2.List(0)).Width + 40, WBCnt(List2.List(0)).Height + 40
List1.AddItem List2.List(0)
List2.RemoveItem 0
Exit Sub
End If
Else
If List1.ListCount > 0 Then
Load MTab(List1.List(List1.ListCount - 1) + 1)
Load Tstr(List1.List(List1.ListCount - 1) + 1)
Load TIcon(List1.List(List1.ListCount - 1) + 1)
Load Tcbt(List1.List(List1.ListCount - 1) + 1)
Load WBCnt(List1.List(List1.ListCount - 1) + 1)
Load WB(List1.List(List1.ListCount - 1) + 1)
MTab(List1.List(List1.ListCount - 1) + 1).Picture = T0.Picture
MTab(List1.List(List1.ListCount - 1) + 1).Move MTab(List1.List(List1.ListCount - 1)).Left + 2700, 0
MTab(List1.List(List1.ListCount - 1) + 1).Visible = True
Set Tstr(List1.List(List1.ListCount - 1) + 1).Container = MTab(List1.List(List1.ListCount - 1) + 1)
Tstr(List1.List(List1.ListCount - 1) + 1).Move (MTab(List1.List(List1.ListCount - 1) + 1).Width - Tstr(List1.List(List1.ListCount - 1) + 1).Width) / 2, (MTab(List1.List(List1.ListCount - 1) + 1).Height - Tstr(List1.List(List1.ListCount - 1) + 1).Height) / 2
Tstr(List1.List(List1.ListCount - 1) + 1).Visible = True
Set TIcon(List1.List(List1.ListCount - 1) + 1).Container = MTab(List1.List(List1.ListCount - 1) + 1)
TIcon(List1.List(List1.ListCount - 1) + 1).Picture = Icon1.Picture
TIcon(List1.List(List1.ListCount - 1) + 1).Move 60, (MTab(List1.List(List1.ListCount - 1) + 1).Height - TIcon(List1.List(List1.ListCount - 1) + 1).Height) / 2
TIcon(List1.List(List1.ListCount - 1) + 1).Visible = True
Set Tcbt(List1.List(List1.ListCount - 1) + 1).Container = MTab(List1.List(List1.ListCount - 1) + 1)
Tcbt(List1.List(List1.ListCount - 1) + 1).Picture = tc0.Picture
Tcbt(List1.List(List1.ListCount - 1) + 1).Move (MTab(List1.List(List1.ListCount - 1) + 1).Width - Tcbt(List1.List(List1.ListCount - 1) + 1).Width - 60), (MTab(List1.List(List1.ListCount - 1) + 1).Height - Tcbt(List1.List(List1.ListCount - 1) + 1).Height) / 2
Tcbt(List1.List(List1.ListCount - 1) + 1).Visible = True
Set WB(List1.List(List1.ListCount - 1) + 1).Container = WBCnt(List1.List(List1.ListCount - 1) + 1)
WB(List1.List(List1.ListCount - 1) + 1).Move 0, 480, UserControl.Width, UserControl.Height
WB(List1.List(List1.ListCount - 1) + 1).Visible = True
WBCnt(List1.List(List1.ListCount - 1) + 1).Move 0, 480, UserControl.Width, UserControl.Height - 480
WBCnt(List1.List(List1.ListCount - 1) + 1).Visible = True
WB(List1.List(List1.ListCount - 1) + 1).Navigate URL
WB(List1.List(List1.ListCount - 1) + 1).Move -20, -20, WBCnt(List1.List(List1.ListCount - 1) + 1).Width, WBCnt(List1.List(List1.ListCount - 1) + 1).Height
WB(List1.List(List1.ListCount - 1) + 1).Visible = True
Call MTab_MouseDown((List1.List(List1.ListCount - 1) + 1), 1, 0, 0, 0)
WBCnt(List1.List(List1.ListCount - 1) + 1).Move 0, 480, UserControl.Width, UserControl.Height - 480
WB(List1.List(List1.ListCount - 1) + 1).Move -20, -20, WBCnt(OldIdx).Width + 40, WBCnt(List1.List(List1.ListCount - 1) + 1).Height + 40
List1.AddItem List1.List(List1.ListCount - 1) + 1
Call UserControl_Resize
Exit Sub
Else
Load MTab(1)
Load Tstr(1)
Load TIcon(1)
Load Tcbt(1)
Load WBCnt(1)
Load WB(1)
MTab(1).Picture = T0.Picture
MTab(1).Move MTab(0).Left + 2700, 0
MTab(1).Visible = True
Set Tstr(1).Container = MTab(1)
Tstr(1).Move (MTab(1).Width - Tstr(1).Width) / 2, (MTab(1).Height - Tstr(1).Height) / 2
Tstr(1).Visible = True
Set TIcon(1).Container = MTab(1)
TIcon(1).Picture = Icon1.Picture
TIcon(1).Move 60, (MTab(1).Height - TIcon(1).Height) / 2
TIcon(1).Visible = True
Set Tcbt(1).Container = MTab(1)
Tcbt(1).Picture = tc0.Picture
Tcbt(1).Move (MTab(1).Width - Tcbt(1).Width - 60), (MTab(1).Height - Tcbt(1).Height) / 2
Tcbt(1).Visible = True
Set WB(1).Container = WBCnt(1)
WB(1).Move 0, 480, UserControl.Width, UserControl.Height
WB(1).Visible = True
WBCnt(1).Move 0, 480, UserControl.Width, UserControl.Height - 480
WBCnt(1).Visible = True
If Blank = False Then WB(1).Navigate URL
WB(1).Move -20, -20, WBCnt(1).Width, WBCnt(1).Height
WB(1).Visible = True
Call MTab_MouseDown(1, 1, 0, 0, 0)
WBCnt(1).Move 0, 480, UserControl.Width, UserControl.Height - 480
WB(1).Move -20, -20, WBCnt(1).Width + 40, WBCnt(1).Height + 40
List1.AddItem "1"
Exit Sub
End If
End If
End Sub
Private Sub MTab_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
If Button = 1 And OldIdx <> Index Then
MTab(OldIdx).Picture = T1.Picture
Tcbt(OldIdx).Visible = False
WBCnt(OldIdx).Visible = False
MTab(Index).Picture = T0.Picture
WBCnt(Index).Visible = True
If Index <> 0 Then Tcbt(Index).Visible = True
MTab(Index).Top = 0
OldIdx = Index
Call UserControl_Resize
End If
If Button = 1 Then RaiseEvent SelectTab
End Sub
Private Sub MTab_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If OldIdx <> Index Then
With MTab(Index)
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
If MTab(Index).Picture <> T1.Picture Then MTab(Index).Picture = T1.Picture
Else
SetCapture .hWnd
If MTab(Index).Picture <> T2.Picture Then MTab(Index).Picture = T2.Picture
End If
End With
End If
End Sub
Private Sub MTab_OLEDragDrop(Index As Integer, Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error Resume Next
Effect = vbDropEffectCopy
If Data.GetFormat(vbCFText) Then
WB(Index).Navigate Data.GetData(vbCFText)
Call MTab_MouseDown(Index, 1, Shift, 0, 0)
ElseIf Data.GetFormat(vbCFDIB) Then
ShowPic.Show
ShowPic.Picture1.Picture = Data.GetData(vbCFDIB)
End If
End Sub
Private Sub Tcbt_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 And Tcbt(Index).Picture <> tc2.Picture Then Tcbt(Index).Picture = tc2.Picture
End Sub
Private Sub Tcbt_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
With Tcbt(Index)
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
ReleaseCapture
If Tcbt(Index).Picture <> tc0.Picture Then Tcbt(Index).Picture = tc0.Picture
Else
SetCapture .hWnd
If Button = 1 Then
If Tcbt(Index).Picture <> tc2.Picture Then Tcbt(Index).Picture = tc2.Picture
Else
If Tcbt(Index).Picture <> tc1.Picture Then Tcbt(Index).Picture = tc1.Picture
End If
End If
End With
End Sub
Private Sub CloseTab(Index As Integer)
MTab(Index).Visible = False
WBCnt(Index).Visible = False
WB(Index).Navigate "About:Blank"
If List1.ListCount = 1 Then
List1.RemoveItem List1.ListCount - 1
Call MTab_MouseDown(0, 1, 0, 0, 0)
List2.AddItem Index
Exit Sub
ElseIf List1.List(List1.ListCount - 1) = Index Then
List1.RemoveItem List1.ListCount - 1
Call MTab_MouseDown(List1.List(List1.ListCount - 1), 1, 0, 0, 0)
List2.AddItem Index
GoTo SetTab
End If
Dim k As Integer
For k = 0 To List1.ListCount - 1
If List1.List(k) = Index Then
List2.AddItem Index
List1.RemoveItem k
GoTo SetTab
End If
Next k
Exit Sub
SetTab:
Dim J As Integer
For J = 0 To List1.ListCount - 1
If J = 0 Then
MTab(List1.List(J)).Move MTab(0).Left + 2700
Else
MTab(List1.List(J)).Move MTab(List1.List(J - 1)).Left + 2700
End If
Next J
Call MTab_MouseDown(List1.List(List1.ListCount - 1), 1, 0, 0, 0)
End Sub
Private Sub Tcbt_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 And X >= 0 And X <= Tcbt(Index).Width And Y >= 0 And Y <= Tcbt(Index).Height Then
'请在这里添加关闭选项卡的代码
Call CloseTab(Index)
End If
End Sub
Private Sub Tcbt_OLEDragDrop(Index As Integer, Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MTab_OLEDragDrop(Index, Data, Effect, Button, Shift, X + Tcbt(Index).Left, Y + Tcbt(Index).Top)
End Sub
Private Sub TIcon_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MTab_MouseDown(Index, Button, Shift, X + TIcon(Index).Left, Y + TIcon(Index).Top)
End Sub
Private Sub TIcon_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MTab_MouseMove(Index, Button, Shift, X + TIcon(Index).Left, Y + TIcon(Index).Top)
End Sub
Private Sub TIcon_OLEDragDrop(Index As Integer, Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MTab_OLEDragDrop(Index, Data, Effect, Button, Shift, X + TIcon(Index).Left, Y + TIcon(Index).Top)
End Sub
Private Sub Tstr_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MTab_MouseDown(Index, Button, Shift, X + Tstr(Index).Left, Y + Tstr(Index).Top)
End Sub
Private Sub Tstr_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MTab_MouseMove(Index, Button, Shift, X + Tstr(Index).Left, Y + Tstr(Index).Top)
End Sub
Private Sub Tstr_OLEDragDrop(Index As Integer, Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Call MTab_OLEDragDrop(Index, Data, Effect, Button, Shift, X + Tstr(Index).Left, Y + Tstr(Index).Top)
End Sub
Private Sub UserControl_GotFocus()
WB(OldIdx).SetFocus
End Sub
Private Sub UserControl_Initialize()
OldIdx = 0
MTab(0).Picture = T0.Picture
TIcon(0).Picture = Icon1.Picture
MTab(0).Move 60, 0
Tstr(0).Move (MTab(0).Width - Tstr(0).Width) / 2, (MTab(0).Height - Tstr(0).Height) / 2
TIcon(0).Move 60, (MTab(0).Height - TIcon(0).Height) / 2 + 20
WB(OldIdx).Navigate "http://etax.zjtax.
End Sub
Private Sub UserControl_Resize()
If UserControl.Height > 600 Then
Line1.X1 = 0
Line1.X2 = UserControl.Width
Line1.Y1 = 405
Line1.Y2 = 405
Line2.X1 = 0
Line2.X2 = UserControl.Width
Line2.Y1 = 420
Line2.Y2 = 420
Line3.X1 = 0
Line3.X2 = UserControl.Width
Line3.Y1 = 435
Line3.Y2 = 435
Line4.X1 = 0
Line4.X2 = UserControl.Width
Line4.Y1 = 450
Line4.Y2 = 450
Line5.X1 = 0
Line5.X2 = UserControl.Width
Line5.Y1 = 465
Line5.Y2 = 465
WBCnt(OldIdx).Move 0, 480, UserControl.Width, UserControl.Height - 480
WB(OldIdx).Move -20, -20, WBCnt(OldIdx).Width + 40, WBCnt(OldIdx).Height + 40
End If
End Sub
Private Sub WB_BeforeNavigate2(Index As Integer, ByVal pDisp As Object, URL As Variant, flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean)
WB(Index).Silent = True
RaiseEvent BeforeNavigate2(Index, URL)
End Sub
Private Sub WB_DownloadBegin(Index As Integer)
RaiseEvent DownloadBegin(Index, WB(Index).LocationURL)
End Sub
Private Sub WB_DownloadComplete(Index As Integer)
RaiseEvent DownloadComplete(Index)
WB(OldIdx).Move -20, -20, WBCnt(OldIdx).Width + 45, WBCnt(OldIdx).Height + 20
If WB(OldIdx).Busy = False Then
Dim a As Object
Set a = WB(OldIdx).Document
'可见宽度= a.body.clientWidth
End If
End Sub
Sub login()
Dim vDoc, vTag
Dim k As Integer
Set vDoc = WB(OldIdx).Document
For k = 0 To vDoc.All.length - 1
If UCase(vDoc.All(k).tagName) = "INPUT" Then
Set vTag = vDoc.All(k)
If vTag.Type = "text" Or vTag.Type = "password" Then
Select Case vTag.id
Case "username"
vTag.Value = Form1.Text1.Text
Case "password"
vTag.Value = Form1.Text2.Text
End Select
ElseIf vTag.Type = "button" Then
vTag.Click
End If
End If
Next k
End Sub
Private Sub WB_NavigateComplete2(Index As Integer, ByVal pDisp As Object, URL As Variant)
RaiseEvent NavigateComplete2(Index, pDisp, URL)
End Sub
Private Sub WB_NewWindow2(Index As Integer, ppDisp As Object, Cancel As Boolean)
Call NewWindow("About:Blank")
Set ppDisp = WB(List1.List(List1.ListCount - 1)).Application
WB(List1.List(List1.ListCount - 1)).ZOrder
End Sub
Private Sub WB_ProgressChange(Index As Integer, ByVal Progress As Long, ByVal ProgressMax As Long)
RaiseEvent ProgressChange(Index, Progress, ProgressMax)
End Sub
Private Sub WB_PropertyChange(Index As Integer, ByVal szProperty As String)
RaiseEvent PropertyChange(Index, szProperty)
End Sub
Private Sub WB_TitleChange(Index As Integer, ByVal Text As String)
If Text <> "" Then
If UCase(WB(Index).LocationURL) = "ABOUT:BLANK" Then
Tstr(Index).Caption = "空白页"
Else
Tstr(Index).Caption = Text
End If
If Tstr(Index).Width >= MTab(Index).Width - 600 Then Tstr(Index).Caption = VBA.Left(Tstr(Index), 10) & "..."
Tstr(Index).Move (MTab(Index).Width - Tstr(Index).Width) / 2, (MTab(Index).Height - Tstr(Index).Height) / 2
End If
If WB(Index).Busy = False Then
RaiseEvent URLChang(Index, WB(Index).LocationURL)
End If
RaiseEvent TitleChange(Index, Text)
End Sub
Public Property Get URL() As Variant
URL = WB(OldIdx).LocationURL
End Property
Public Property Let URL(ByVal New_URL As Variant)
WB(OldIdx).Navigate URL
PropertyChanged "URL"
End Property
Public Property Get Title() As String
Title = WB(OldIdx).LocationName
End Property
Private Sub WB_WindowClosing(Index As Integer, ByVal IsChildWindow As Boolean, Cancel As Boolean)
Cancel = True
Call CloseTab(Index)
End Sub
