vbAccelerator - Contents of code file: frmMSMoneySample.frmVERSION 5.00
Object = "{50403D50-4D95-4B43-B9BF-030BAB376D77}#16.1#0"; "vbalCmdBar.ocx"
Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll"
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Begin VB.Form frmMSMoneySample
Caption = "Money UI Demonstration"
ClientHeight = 6840
ClientLeft = 2640
ClientTop = 2445
ClientWidth = 11160
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMSMoneySample.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6840
ScaleWidth = 11160
Begin VB.CommandButton cmdFont
Caption = "Font"
Height = 435
Left = 180
TabIndex = 5
ToolTipText = "Demonstrates changing font"
Top = 4200
Width = 1035
End
Begin VB.PictureBox picSideBar
AutoRedraw = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 0
ScaleHeight = 33
ScaleMode = 3 'Pixel
ScaleWidth = 101
TabIndex = 3
Top = 720
Width = 1515
End
Begin VB.PictureBox picRes
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 825
Left = 3300
Picture = "frmMSMoneySample.frx":45A2
ScaleHeight = 825
ScaleWidth = 2400
TabIndex = 2
Top = 3420
Visible = 0 'False
Width = 2400
End
Begin vbalIml.vbalImageList ilsIcons
Left = 1320
Top = 3600
_ExtentX = 953
_ExtentY = 953
IconSizeX = 24
IconSizeY = 24
ColourDepth = 24
Size = 29520
Images = "frmMSMoneySample.frx":AD04
Version = 131072
KeyCount = 12
Keys =
"ABOUTPORTFOLIOMOREHOMEGOFORWARDBUDGETBILLSACCOUNTSVBACCELERATORBACKBASEE
MPTY"
End
Begin SHDocVwCtl.WebBrowser web
Height = 2835
Left = 1500
TabIndex = 1
Top = 840
Width = 6495
ExtentX = 11456
ExtentY = 5001
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.ComboBox cboAddress
Height = 315
Left = 1980
TabIndex = 0
Text = "http://vbaccelerator.com/"
Top = 420
Width = 2475
End
Begin vbalCmdBar.vbalCommandBar cmdBar
Align = 1 'Align Top
Height = 315
Index = 0
Left = 0
Top = 0
Width = 11160
_ExtentX = 19685
_ExtentY = 556
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Style = 0
End
Begin vbalCmdBar.vbalCommandBar cmdBar
Align = 1 'Align Top
Height = 315
Index = 1
Left = 0
Top = 315
Width = 11160
_ExtentX = 19685
_ExtentY = 556
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Style = 0
End
Begin vbalCmdBar.vbalCommandBar cmdBar
Align = 2 'Align Bottom
Height = 315
Index = 2
Left = 0
Top = 6525
Width = 11160
_ExtentX = 19685
_ExtentY = 556
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Style = 0
End
Begin vbalIml.vbalImageList ilsIcons16
Left = 1980
Top = 3540
_ExtentX = 953
_ExtentY = 953
ColourDepth = 24
Size = 1148
Images = "frmMSMoneySample.frx":12074
Version = 131072
KeyCount = 1
Keys = ""
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Caption = $"frmMSMoneySample.frx":12510
Height = 195
Left = 60
TabIndex = 4
Top = 1320
Width = 1200
End
End
Attribute VB_Name = "frmMSMoneySample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' Quit gently
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal
hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&
' A generic recursive procedure to create command
' bars for all subitems of the specified key.
' This works if you set up your keys in the
' appropriate way. It isn't particularly
' efficient, though.
Private Sub createCommandBarsFromKeys( _
cmdBar As vbalCommandBar, _
ByVal sStartKey As String, _
btnOwner As cButton _
)
Dim iBtn As Long
Dim bar As cCommandBar
Dim btn As cButton
Dim colStartKeyParts As Collection
Dim colParts As Collection
Set colStartKeyParts = parseKey(sStartKey)
With cmdBar.Buttons
For iBtn = 1 To .Count
Set btn = .Item(iBtn)
If (InStr(btn.Key, sStartKey & ":") = 1) Then
Set colParts = parseKey(btn.Key)
If (colParts.Count = colStartKeyParts.Count + 1) Then
If (bar Is Nothing) Then
Set bar = cmdBar.CommandBars.Add(sStartKey, sStartKey)
If Not (btnOwner Is Nothing) Then
btnOwner.bar = bar
End If
End If
bar.Buttons.Add btn
' recurse
createCommandBarsFromKeys cmdBar, btn.Key, btn
End If
End If
Next iBtn
End With
End Sub
Private Function parseKey( _
ByVal sKey As String _
) As Collection
Dim iPos As Long
Dim iNextPos As Long
Dim colParts As New Collection
iPos = 1
iNextPos = 1
Do While (iNextPos > 0)
iNextPos = InStr(iPos, sKey, ":")
If (iNextPos > 0) Then
colParts.Add Mid(sKey, iPos, iNextPos)
iPos = iNextPos + 1
End If
Loop
If (iPos > 0) Then
colParts.Add Mid(sKey, iPos)
End If
Set parseKey = colParts
End Function
Private Sub createCommandBars()
createCommandBarsFromKeys cmdBar(0), "MENU", Nothing
createCommandBarsFromKeys cmdBar(0), "TOOLBAR", Nothing
createCommandBarsFromKeys cmdBar(0), "STATUS", Nothing
End Sub
Private Sub createButtons()
Dim btn As cButton
Dim bar As cCommandBar
Dim btns As cCommandBarButtons
Dim i As Long
With cmdBar(0)
' Add the buttons:
With .Buttons
' Add top level menu buttons
Set btn = .Add("MENU:FILE", , "&File")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:EDIT", , "&Edit")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:FAVOURITES", , "F&avourites")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:TOOLS", , "&Tools")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:ACCOUNTS", , "Accounts && &Bills")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:INVESTING", , "&Investing")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:PLANNER", , "&Planner")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:TAXES", , "Ta&xes")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:SHOPPING", , "&Shopping")
btn.ShowCaptionInToolbar = True
Set btn = .Add("MENU:HELP", , "&Help")
btn.ShowCaptionInToolbar = True
' Add file menu buttons:
.Add "MENU:FILE:NEW", , "&New"
.Add "MENU:FILE:NEW:ACCOUNT", , "New &Account..."
.Add "MENU:FILE:NEW:FILE", , "New &File..."
.Add "MENU:FILE:OPEN", , "&Open", , , vbKeyO, vbCtrlMask
.Add "MENU:FILE:CONVERT", , "Convert &Quicken File..."
.Add "MENU:FILE:SEP1", , , eSeparator
.Add "MENU:FILE:PASSWORD", , "Password &Manager"
.Add "MENU:FILE:SEP2", , , eSeparator
.Add "MENU:FILE:BACKUP", , "&Back Up..."
.Add "MENU:FILE:RESTORE", , "&Restore Backup..."
.Add "MENU:FILE:ARCHIVE", , "&Archive..."
.Add "MENU:FILE:SEP3", , , eSeparator
.Add "MENU:FILE:IMPORT", , "&Import..."
.Add "MENU:FILE:EXPORT", , "&Export..."
.Add "MENU:FILE:SEP4", , , eSeparator
.Add "MENU:FILE:PRINTSETUP", , "P&rint Setup..."
.Add "MENU:FILE:PRINT", , "&Print...", , , vbKeyP, vbCtrlMask
.Add "MENU:FILE:PREVIEW", , "Print Pre&view"
Set btn = .Add("MENU:FILE:MRUSEP", , , eSeparator)
btn.Visible = False
For i = 1 To 8
Set btn = .Add("MENU:FILE:MRU" & i, , "Recent File")
btn.Visible = False
Next i
.Add "MENU:FILE:SEP5", , , eSeparator
.Add "MENU:FILE:EXIT", , "E&xit"
' Add Edit menu buttons:
.Add "MENU:EDIT:UNDO", , "&Undo", , , vbKeyZ, vbCtrlMask
.Add "MENU:EDIT:SEP1", , , eSeparator
.Add "MENU:EDIT:CUT", , "Cu&t", , , vbKeyX, vbCtrlMask
.Add "MENU:EDIT:COPY", , "&Copy", , , vbKeyC, vbCtrlMask
.Add "MENU:EDIT:PASTE", , "&Paste", , , vbKeyV, vbCtrlMask
' Add Favourites:
Set btn = .Add("MENU:FAVOURITES:1", , "(No Favourites Yet)")
btn.Enabled = False
' Add Tools:
.Add "MENU:TOOLS:FIND", , "&Find and Replace..."
.Add "MENU:TOOLS:SEP1", , , eSeparator
.Add "MENU:TOOLS:CALCULATOR", , "&Calculator..."
.Add "MENU:TOOLS:DISCONNECT", , "&Disconnect"
.Add "MENU:TOOLS:UPGRADE", , "&Upgrade..."
.Add "MENU:TOOLS:CUSTOMISE", , "Customi&ze"
.Add "MENU:TOOLS:OPTIONS", , "&Options..."
' Add Accounts:
.Add "MENU:ACCOUNTS:LIST", , "&Account List"
.Add "MENU:ACCOUNTS:BILLS", , "&Bills && Deposits"
.Add "MENU:ACCOUNTS:MANAGER", , "&Online Service Manager"
.Add "MENU:ACCOUNTS:SEP1", , , eSeparator
.Add "MENU:ACCOUNTS:CASHFLOW", , "&Cash Flow"
.Add "MENU:ACCOUNTS:CALENDAR", , "Ca&lendar"
.Add "MENU:ACCOUNTS:SEP2", , , eSeparator
.Add "MENU:ACCOUNTS:FAVOURITES", , "Fa&vourite Accounts"
Set btn = .Add("MENU:ACCOUNTS:FAVOURITES:1", , "(No Favourites Yet)")
btn.Enabled = False
.Add "MENU:ACCOUNTS:SEP3", , , eSeparator
.Add "MENU:ACCOUNTS:SETUP", , "Account &Setup"
.Add "MENU:ACCOUNTS:CATEGORIES", , "Cate&gories"
' Add Investing
.Add "MENU:INVESTING:PORTFOLIO", , "&Portfolio"
.Add "MENU:INVESTING:ONLINE", , "&Online Investing Research"
.Add "MENU:INVESTING:SEP1", , , eSeparator
.Add "MENU:INVESTING:ANALYSIS", , "Portfolio &Analysis"
.Add "MENU:INVESTING:ALLOCATION", , "A&sset Allocation"
.Add "MENU:INVESTING:REPORTS", , "Investment &Reports"
' Add Planner
.Add "MENU:PLANNER:LIFETIME", , "&Lifetime Planner"
.Add "MENU:PLANNER:BUDGET", , "&Budget Planner"
.Add "MENU:PLANNER:DEBT", , "&Debt Planner"
.Add "MENU:PLANNER:INSURANCE", , "&Insurance Planner"
.Add "MENU:PLANNER:SEP", , , eSeparator
.Add "MENU:PLANNER:REPORTS", , "Planner &Reports"
' Add Taxes
.Add "MENU:TAXES:ESTIMATOR", , "&Tax Estimator"
.Add "MENU:TAXES:DEDUCTIONS", , "&Deduction Finder"
Set btn = .Add("MENU:TAXES:WITHHOLDING", , "Tax &Withholding
Estimator")
btn.Enabled = False
.Add "MENU:TAXES:LINE", , "Tax &Line Manager", , "Tax &Line Manager"
.Add "MENU:TAXES:SEP1", , , eSeparator
.Add "MENU:TAXES:SETTINGS", , "Tax &Settings"
' Add Shopping
.Add "MENU:SHOPPING:CENTRE", , "&Shopping Centre"
.Add "MENU:SHOPPING:BROKER", , "&Broker Centre"
.Add "MENU:SHOPPING:BANKING", , "Ban&king Centre"
' Add Help
.Add "MENU:HELP:CONTENTS", , "&Contents", , , vbKeyF1, 0
.Add "MENU:HELP:SEP1", , , eSeparator
.Add "MENU:HELP:WHATSTHIS", , "&What's This", , , vbKeyF1, vbShiftMask
.Add "MENU:HELP:WEB", , "vbAccelerator on the &Web"
.Add "MENU:HELP:REPAIR", , "&Repair"
.Add "MENU:HELP:SEP2", , , eSeparator
.Add "MENU:HELP:ABOUT", , "&About..."
' Add the toolbar buttons
Set btn = .Add("TOOLBAR:BACK", ilsIcons.ItemIndex("BACK") - 1, "Back",
, "Back", vbKeyLeft, vbAltMask)
btn.Enabled = False
btn.ShowDropDownInToolbar = True
btn.ShowCaptionInToolbar = True
Set btn = .Add("TOOLBAR:BACK:1", , "(None)")
btn.Enabled = False
Set btn = .Add("TOOLBAR:FORWARD", ilsIcons.ItemIndex("FORWARD") - 1,
"Forward", , "Forward", vbKeyRight, vbAltMask)
btn.Enabled = False
btn.ShowDropDownInToolbar = True
btn.ShowCaptionInToolbar = True
Set btn = .Add("TOOLBAR:FORWARD:1", , "(None)")
btn.Enabled = False
Set btn = .Add("TOOLBAR:HOME", ilsIcons.ItemIndex("HOME") - 1, "Home",
, "Go to your Home Page", vbKeyHome, vbAltMask)
btn.ShowCaptionInToolbar = True
.Add "TOOLBAR:SEP1", , , eSeparator
Set btn = .Add("TOOLBAR:ADDRESS", , "Address", ePanel)
btn.ShowCaptionInToolbar = True
Set btn = .Add("TOOLBAR:ADDRESSCOMBO", , , ePanel)
btn.PanelControl = cboAddress
btn.PanelWidth = cboAddress.Width \ Screen.TwipsPerPixelX
btn.ShowCaptionInToolbar = True
Set btn = .Add("TOOLBAR:GO", ilsIcons.ItemIndex("GO"), "Go")
btn.ShowCaptionInToolbar = True
.Add "TOOLBAR:SEP2", , , eSeparator
Set btn = .Add("TOOLBAR:ACCOUNTS", ilsIcons.ItemIndex("ACCOUNTS") - 1,
"Account List")
btn.ShowCaptionInToolbar = True
Set btn = .Add("TOOLBAR:PORTFOLIO", ilsIcons.ItemIndex("PORTFOLIO") -
1, "Portfolio")
btn.ShowCaptionInToolbar = True
Set btn = .Add("TOOLBAR:BILLS", ilsIcons.ItemIndex("BILLS") - 1,
"Bills && Deposits")
btn.ShowCaptionInToolbar = True
Set btn = .Add("TOOLBAR:WEB", ilsIcons.ItemIndex("VBACCELERATOR") - 1,
"vbAccelerator")
btn.ShowCaptionInToolbar = True
Set btn = .Add("TOOLBAR:MORE", ilsIcons.ItemIndex("MORE") - 1, "More")
btn.ShowCaptionInToolbar = True
' Add the status bar buttons:
Set btn = .Add("STATUS:ONLINE", , "Online")
btn.ShowCaptionInToolbar = True
.Add "STATUS:SEP1", , , eSeparator
Set btn = .Add("STATUS:UPDATES", 0, "Internet Updates")
btn.ShowDropDownInToolbar = True
btn.ShowCaptionInToolbar = True
.Add "STATUS:SEP2", , , eSeparator
Set btn = .Add("STATUS:STATUSTEXT")
btn.Locked = True
btn.ShowCaptionInToolbar = True
End With
End With
End Sub
Private Sub setColour(ByVal lHue As Long)
cmdBar(1).AdjustBackgroundImage lHue
cmdBar(2).AdjustBackgroundImage lHue
Dim r As Long, g As Long, b As Long
HLSToRGB lHue, 85, 235, r, g, b
Me.BackColor = RGB(r, g, b)
Set picSideBar.Picture = cmdBar(0).AdjustImage(picRes.Picture, lHue, 85, 0.5)
Dim sDate As String
Dim lWidth As Long
Dim lHeight As Long
sDate = Format(Now, "mmmm dd, yyyy")
lWidth = picSideBar.TextWidth(sDate)
lHeight = picSideBar.TextHeight(sDate)
picSideBar.CurrentX = 6
picSideBar.CurrentY = (picSideBar.ScaleHeight - lHeight) \ 2
picSideBar.Print sDate
End Sub
Private Sub addURL(ByVal sUrl As String)
cboAddress.Tag = "ADDING"
' Detect if we already have this item:
Dim i As Long
Dim iIndex As Long
iIndex = -1
For i = 0 To cboAddress.ListCount - 1
If (cboAddress.List(i) = sUrl) Then
iIndex = i
Exit For
End If
Next i
If (iIndex = -1) Then
cboAddress.AddItem sUrl, 0
iIndex = 0
End If
cboAddress.ListIndex = iIndex
If (iIndex = 0) Then
cmdBar(0).Buttons("TOOLBAR:FORWARD").Enabled = False
Else
For i = 0 To iIndex - 1
Next i
cmdBar(0).Buttons("TOOLBAR:FORWARD").Enabled = True
End If
If (iIndex = cboAddress.ListCount - 1) Then
cmdBar(0).Buttons("TOOLBAR:BACK").Enabled = False
Else
For i = iIndex + 1 To cboAddress.ListCount - 1
Next i
cmdBar(0).Buttons("TOOLBAR:BACK").Enabled = True
End If
cboAddress.Tag = ""
End Sub
Private Sub cboAddress_Click()
If (cboAddress.Tag = "") Then
web.Navigate2 cboAddress.Text
End If
End Sub
Private Sub cboAddress_KeyPress(KeyAscii As Integer)
If (KeyAscii = vbKeyReturn) Then
Dim lIndex As Long
Dim i As Long
lIndex = -1
For i = 0 To cboAddress.ListCount - 1
If (cboAddress.List(i) = cboAddress.Text) Then
lIndex = i
Exit For
End If
Next i
If (lIndex = -1) Then
cboAddress.AddItem cboAddress.Text, 0
lIndex = 0
End If
cboAddress.ListIndex = lIndex
End If
End Sub
Private Sub cmdBar_ButtonClick(Index As Integer, btn As vbalCmdBar.cButton)
Debug.Print "Clicked", btn.Key
Select Case btn.Key
Case "TOOLBAR:ACCOUNTS"
setColour 195
Case "TOOLBAR:PORTFOLIO"
setColour 45
Case "TOOLBAR:BILLS"
setColour 145
Case "TOOLBAR:WEB", "HELP:MENU:WEB"
setColour 75
web.Navigate2 "http://vbaccelerator.com/"
Case "TOOLBAR:HOME"
web.Navigate2 App.Path & "\page.mht"
Case "TOOLBAR:GO"
cboAddress_KeyPress vbKeyReturn
Case "MENU:HELP:ABOUT"
Dim fA As New frmAbout
fA.Acknowledgements = "This sample demonstrates the vbAccelerator
CommandBars control using the MS Money rendering style."
fA.Show vbModal, Me
Case "MENU:FILE:EXIT"
PostMessage Me.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
End Select
End Sub
Private Sub cmdBar_RequestNewInstance(Index As Integer, ctl As Object)
Dim lNewIndex As Long
lNewIndex = cmdBar.UBound + 1
Load cmdBar(lNewIndex)
cmdBar(lNewIndex).Align = 0
Set ctl = cmdBar(lNewIndex)
End Sub
Private Sub cmdBar_Resize(Index As Integer)
If (Index = 0) Or (Index = 1) Then
Form_Resize
End If
End Sub
Private Sub cmdFont_Click()
Dim sFnt As New StdFont
If (cmdBar(0).Font.Name = "Tahoma") Then
sFnt.Name = "Times New Roman"
sFnt.Size = 14
Else
sFnt.Name = "Tahoma"
sFnt.Size = 8
End If
cmdBar(0).Font = sFnt
cmdBar(1).Font = sFnt
cmdBar(2).Font = sFnt
End Sub
Private Sub Form_Load()
On Error GoTo ErrorHandler
cmdBar(0).Redraw = False
cmdBar(1).Redraw = False
cmdBar(2).Redraw = False
createButtons
createCommandBars
web.Navigate2 App.Path & "\page.mht"
cmdBar(0).Style = eMoney
cmdBar(0).MainMenu = True
cmdBar(0).Toolbar = cmdBar(0).CommandBars("MENU")
cmdBar(1).BackgroundImage = picRes.Picture
cmdBar(1).MenuImageList = ilsIcons16
cmdBar(1).ToolbarImageList = ilsIcons
cmdBar(1).ButtonTextPosition = eButtonTextBottom
cmdBar(1).Toolbar = cmdBar(0).CommandBars("TOOLBAR")
cmdBar(2).BackgroundImage = picRes.Picture
cmdBar(2).MenuImageList = ilsIcons16
cmdBar(2).ToolbarImageList = ilsIcons16
cmdBar(2).Toolbar = cmdBar(0).CommandBars("STATUS")
cmdBar(0).Redraw = True
cmdBar(1).Redraw = True
cmdBar(2).Redraw = True
setColour 195
Exit Sub
ErrorHandler:
MsgBox "Error:" & Err.Description, vbExclamation
Exit Sub
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y
As Single)
Debug.Print cmdBar(0).MainMenu, cmdBar(1).MainMenu
End Sub
Private Sub Form_Resize()
Dim lTop As Long
Dim lLeft As Long
On Error Resume Next
lTop = cmdBar(1).top + cmdBar(1).Height
lLeft = 128 * Screen.TwipsPerPixelX
web.Move lLeft, lTop, Me.ScaleWidth - lLeft, Me.ScaleHeight - lTop -
cmdBar(2).Height
picSideBar.Move 0, lTop, lLeft, 30 * Screen.TwipsPerPixelY
lTop = picSideBar.top + picSideBar.Height + 8 * Screen.TwipsPerPixelY
lblInfo.Move 6 * Screen.TwipsPerPixelX, lTop, lLeft - 10 *
Screen.TwipsPerPixelX, Me.ScaleHeight - lTop
End Sub
Private Sub web_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
'
addURL URL
'
End Sub
Private Sub web_NewWindow2(ppDisp As Object, Cancel As Boolean)
'
Cancel = True
'
End Sub
Private Sub web_StatusTextChange(ByVal Text As String)
cmdBar(2).Buttons("STATUS:STATUSTEXT").Caption = Text
End Sub
|
|