vbAccelerator - Contents of code file: Form1.frm
VERSION 5.00
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Object = "*\A..\..\_READE~1\GRAHEM~1\vbInfoBar.vbp"
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3336
ClientLeft = 3900
ClientTop = 3072
ClientWidth = 3840
LinkTopic = "Form1"
ScaleHeight = 3336
ScaleWidth = 3840
Begin vbIB.vbInfoBar vbInfoBar1
Height = 300
Left = 60
TabIndex = 7
Top = 60
Width = 2535
_ExtentX = 4466
_ExtentY = 487
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Arial"
Size = 9.6
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BackColor2 = 0
ForeColor = -2147483628
End
Begin VB.Frame Frame1
Caption = "Background:"
Height = 1416
Left = 105
TabIndex = 2
Top = 1050
Width = 2430
Begin VB.OptionButton Option1
Appearance = 0 'Flat
Caption = "Bitmap"
ForeColor = &H80000008&
Height = 225
Index = 3
Left = 120
TabIndex = 6
Top = 1020
Width = 1695
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
Caption = "Vertical Gradient"
ForeColor = &H80000008&
Height = 225
Index = 2
Left = 105
TabIndex = 5
Top = 780
Width = 1695
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
Caption = "Horizontal Gradient"
ForeColor = &H80000008&
Height = 225
Index = 1
Left = 105
TabIndex = 4
Top = 540
Width = 1695
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
Caption = "Plain"
ForeColor = &H80000008&
Height = 225
Index = 0
Left = 105
TabIndex = 3
Top = 315
Value = -1 'True
Width = 1695
End
End
Begin vbalIml.vbalImageList ilsIcons
Index = 0
Left = 2628
Top = 0
_ExtentX = 762
_ExtentY = 762
IconSizeX = 24
IconSizeY = 24
ColourDepth = 8
Size = 56724
Images = "Form1.frx":0000
KeyCount = 29
Keys = ""
End
Begin VB.CommandButton Command1
Caption = "Change Text"
Height = 375
Left = 945
TabIndex = 0
Top = 2835
Width = 1620
End
Begin vbalIml.vbalImageList ilsIcons
Index = 1
Left = 3252
Top = 0
_ExtentX = 762
_ExtentY = 762
ColourDepth = 8
Size = 27260
Images = "Form1.frx":DDB4
KeyCount = 29
Keys = ""
End
Begin VB.CheckBox Check1
Appearance = 0 'Flat
Caption = "InfoButton State"
ForeColor = &H80000008&
Height = 330
Left = 105
TabIndex = 1
Top = 630
Value = 1 'Checked
Width = 1485
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long)
As Long
Const m_cPOPMENU = "P"
Private WithEvents m_popDrop As cPopupMenu
Attribute m_popDrop.VB_VarHelpID = -1
Private Sub Check1_Click()
vbInfoBar1.ButtonEnabled = Check1.Value
Command1.SetFocus
End Sub
Private Sub Command1_Click()
With vbInfoBar1
.ReleaseButton
.Caption = InputBox("Caption", _
"Change InfoBar Text", _
"This is a long Information Bar description!")
End With
End Sub
Private Sub Form_Load()
With vbInfoBar1
.ImageList = ilsIcons(0).hIml
.IconIndex = 28
End With
pInitMenus
End Sub
Private Sub Form_Resize()
With vbInfoBar1
.Move .Left, .Top, Me.ScaleWidth - .Left * 2
Frame1.Move .Left, Frame1.Top, .Width, Frame1.Height
Command1.Move .Left + .Width - Command1.Width
End With
End Sub
Private Sub m_popDrop_Click(ItemNumber As Long)
'
End Sub
Private Sub Option1_Click(Index As Integer)
With vbInfoBar1
Select Case Index
Case 0
.Gradient = False
.VerticalGradient = False
Set .BackgroundPicture = Nothing
Case 1
.Gradient = True
.VerticalGradient = False
Set .BackgroundPicture = Nothing
Case 2
.Gradient = True
.VerticalGradient = True
Set .BackgroundPicture = Nothing
Case 3
.Gradient = False
.VerticalGradient = False
Set .BackgroundPicture = LoadPicture("/home/Resources/Babbage/Information_Bar_Control/dblue031.jpg")
End Select
End With
End Sub
Private Sub vbInfoBar1_ButtonDown(ButtonState As vbIB.eButtonState)
ButtonState = ebsStayDown
End Sub
Private Sub vbInfoBar1_Click()
Dim lButton As Long, lDropX As Long, lDropY As Long
m_popDrop.Restore m_cPOPMENU
vbInfoBar1.GetDropDownPosition lButton, lDropX, lDropY
m_popDrop.ShowPopupMenu lDropX, lDropY
'## Release Infobar button here to ensure that the popmenu loss of focus
' won't it stick down.
vbInfoBar1.ReleaseButton
End Sub
Private Sub vbInfoBar1_Paint()
'
End Sub
Private Sub pInitMenus()
'## Initialise Toolbar DropDown menus...
Set m_popDrop = New cPopupMenu
With m_popDrop
.ImageList = ilsIcons(1).hIml
.hWndOwner = Me.hWnd
.GradientHighlight = True
.HeaderStyle = ecnmHeaderSeparator
.HighlightCheckedItems = True
.Clear
.AddItem "Menu 1, Item 1", , , , 0, , , "M1L1"
.AddItem "Menu 1, Item 2", , , , 1, , , "M1L2"
.AddItem "Menu 1, Item 3", , , , 2, , , "M1L3"
.AddItem "Menu 1, Item 4", , , , 3, , , "M1L4"
.AddItem "Menu 1, Item 5", , , , 4, , , "M1L5"
.AddItem "Menu 1, Item 6", , , , 5, , , "M1L6"
.AddItem "Menu 1, Item 7", , , , 6, , , "M1L7"
.AddItem "Menu 1, Item 8", , , , 7, , , "M1L8"
.AddItem "Menu 1, Item 9", , , , 8, , , "M1L9"
.Store m_cPOPMENU
End With
End Sub
|
|