VB5 ICQ Menu Demonstration Project (68K)
VB6 ICQ Menu Demonstration Project (59K)
13 Feb 1999
First Posted
vbAccelerator - Contents of code file: frmICQStyle.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.2#0"; "COMCTL32.OCX"
Begin VB.Form frmICQStyle
Caption = "vbAccelerator ICQ Style Pop-up Menu Demonstration"
ClientHeight = 4245
ClientLeft = 3495
ClientTop = 1995
ClientWidth = 6435
Icon = "frmICQStyle.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4245
ScaleWidth = 6435
Begin VB.PictureBox picSideBar
AutoRedraw = -1 'True
BackColor = &H00000000&
BorderStyle = 0 'None
BeginProperty Font
Name = "Arial"
Size = 9.75
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 3555
Left = 5280
ScaleHeight = 3555
ScaleWidth = 255
TabIndex = 1
Top = 120
Visible = 0 'False
Width = 255
End
Begin pICQStyle.uAnimButton btnAnimate
Height = 375
Left = 120
TabIndex = 0
Top = 3720
Width = 975
_ExtentX = 1720
_ExtentY = 661
End
Begin VB.Label lblInfo
BackStyle = 0 'Transparent
Height = 255
Left = 1140
TabIndex = 2
Top = 3840
Width = 5295
End
Begin ComctlLib.ImageList ilsIcons16
Left = 4440
Top = 1260
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 44
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":1272
Key = "PASTE"
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":158C
Key = "CUT"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":18A6
Key = "COPY"
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":1BC0
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":1EDA
Key = ""
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":21F4
Key = ""
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":250E
Key = ""
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":2828
Key = ""
EndProperty
BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":2B42
Key = ""
EndProperty
BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":2E5C
Key = ""
EndProperty
BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":3176
Key = ""
EndProperty
BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":3490
Key = ""
EndProperty
BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":37AA
Key = ""
EndProperty
BeginProperty ListImage14 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":3AC4
Key = ""
EndProperty
BeginProperty ListImage15 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":3DDE
Key = ""
EndProperty
BeginProperty ListImage16 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":40F8
Key = ""
EndProperty
BeginProperty ListImage17 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":4412
Key = ""
EndProperty
BeginProperty ListImage18 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":472C
Key = ""
EndProperty
BeginProperty ListImage19 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":4A46
Key = ""
EndProperty
BeginProperty ListImage20 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":4D60
Key = ""
EndProperty
BeginProperty ListImage21 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":507A
Key = ""
EndProperty
BeginProperty ListImage22 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":5394
Key = ""
EndProperty
BeginProperty ListImage23 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":56AE
Key = ""
EndProperty
BeginProperty ListImage24 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":59C8
Key = ""
EndProperty
BeginProperty ListImage25 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":5CE2
Key = ""
EndProperty
BeginProperty ListImage26 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":5FFC
Key = ""
EndProperty
BeginProperty ListImage27 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":6316
Key = ""
EndProperty
BeginProperty ListImage28 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":6630
Key = ""
EndProperty
BeginProperty ListImage29 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":694A
Key = ""
EndProperty
BeginProperty ListImage30 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":6C64
Key = ""
EndProperty
BeginProperty ListImage31 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":6F7E
Key = ""
EndProperty
BeginProperty ListImage32 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":7298
Key = ""
EndProperty
BeginProperty ListImage33 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":75B2
Key = ""
EndProperty
BeginProperty ListImage34 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":78CC
Key = ""
EndProperty
BeginProperty ListImage35 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":7BE6
Key = ""
EndProperty
BeginProperty ListImage36 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":7F00
Key = ""
EndProperty
BeginProperty ListImage37 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":821A
Key = ""
EndProperty
BeginProperty ListImage38 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":8534
Key = ""
EndProperty
BeginProperty ListImage39 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":884E
Key = "Web"
EndProperty
BeginProperty ListImage40 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":8B68
Key = ""
EndProperty
BeginProperty ListImage41 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":8E82
Key = ""
EndProperty
BeginProperty ListImage42 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":919C
Key = ""
EndProperty
BeginProperty ListImage43 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":94B6
Key = "vbAccelerator"
EndProperty
BeginProperty ListImage44 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmICQStyle.frx":97D0
Key = ""
EndProperty
EndProperty
End
Begin VB.Image imgRes
Appearance = 0 'Flat
Height = 4080
Left = 4800
Picture = "frmICQStyle.frx":99AA
Top = 120
Visible = 0 'False
Width = 840
End
End
Attribute VB_Name = "frmICQStyle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' ===========================================================================
' Name: frmICQStyle
' Author: Steve McMahon
' Date: 24 January 1999
'
' Demonstrates how to create an ICQ style menu using the Owner-Draw
' features of the vbAccelerator cNewMenu ActiveX DLL.
'
' Requires: CNEWMENU.DLL (register)
' SSUBTMR.DLL (register)
'
' ---------------------------------------------------------------------------
' Visit vbAccelerator - advanced, free VB source code.
' http://vbaccelerator.com
' ===========================================================================
' Used to transfer side logo onto the owner-draw menu:
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As
Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal
hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long)
As Long
' To ensure we shut-down when choose close whilst the button is down:
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
' The popup menu object:
Private WithEvents m_cMenu As cPopupMenu
Attribute m_cMenu.VB_VarHelpID = -1
' This constant is used as an item data to identify web site menu items
' on the pop-up menu. The "Key" property of the menu items is then used to
' hold the URL to go to:
Private Const mcWEBSITE As Long = -&H8000&
Private Sub btnAnimate_Click()
Dim lIndex As Long
' Show the popup menu and get the item the user clicks:
lIndex = m_cMenu.ShowPopupMenu(btnAnimate.left, btnAnimate.tOp,
btnAnimate.left, btnAnimate.tOp, Me.ScaleWidth - btnAnimate.left -
btnAnimate.Width, btnAnimate.tOp + btnAnimate.Height, False)
If (lIndex > 0) Then
' The web menu works, but not much else :)!
If (m_cMenu.ItemData(lIndex) = mcWEBSITE) Then
ShellEx m_cMenu.ItemKey(lIndex)
Else
Select Case m_cMenu.ItemKey(lIndex)
Case "New"
MsgBox "Clicked " & m_cMenu.Caption(lIndex), vbInformation
Case "Open"
MsgBox "Clicked " & m_cMenu.Caption(lIndex), vbInformation
Case "Settings-Basic"
MsgBox "Clicked " & m_cMenu.Caption(lIndex), vbInformation
Case "Settings-User"
MsgBox "Clicked " & m_cMenu.Caption(lIndex), vbInformation
Case "Settings-Security"
MsgBox "Clicked " & m_cMenu.Caption(lIndex), vbInformation
Case "Settings-Preferences"
MsgBox "Clicked " & m_cMenu.Caption(lIndex), vbInformation
Case "Settings-Windows"
MsgBox "Clicked " & m_cMenu.Caption(lIndex), vbInformation
Case "Help"
MsgBox "This is the vbAccelerator ICQ-Style Menu demonstrator. It
shows how to create" & vbCrLf & vbCrLf & " * A simple animated
button" & vbCrLf & " * A pop-up menu with a side bar" & vbCrLf &
vbCrLf & "For more information, visit vbAccelerator on the web at
http://vbaccelerator.com", vbInformation
Case "Close"
' If we unload here directly, we will have a problem
' because the button code will not terminate. sigh...
PostMessage Me.hWnd, WM_SYSCOMMAND, SC_CLOSE, 0
End Select
End If
Else
' lIndex=0 :: cancelled the menu.
End If
lblInfo.Caption = ""
End Sub
Private Sub Form_Load()
Dim i As Long
Dim iI As Long
' Set up animated button:
With btnAnimate
.BackColor = &H0&
.XCells = 1
.YCells = 17
.DefaultCell = 10
Set .Picture = imgRes.Picture
.CellSteps(10) = 10
.Interval = 50
End With
' Set up pop-up menu:
Set m_cMenu = New cPopupMenu
With m_cMenu
' Set up for cPopupMenu:
.hWndOwner = Me.hWnd
.ImageList = ilsIcons16
.HeaderStyle = ecnmHeaderSeparator
.GradientHighlight = True
' Now add the menu items. The items in the main menu are all
' set to to OwnerDraw so we can add the side bar logo. See
' further description in DrawItem and MeasureItem events.
' These two items demonstrates how to display a short-cut key
' next to the menu item. However it will not automatically handle
' the short-cut key, you must have a standard VB menu setup to do
' that.
i = .AddItem("&New..." & vbTab & "Ctrl+N", , , , 5, , , "New")
.OwnerDraw(i) = True
i = .AddItem("&Open..." & vbTab & "Ctrl+O", , , , 7, , , "Open")
.OwnerDraw(i) = True
i = .AddItem("-My Settings")
.OwnerDraw(i) = True
i = .AddItem("&Basic Features", , , , , , , "Settings-Basic")
.OwnerDraw(i) = True
i = .AddItem("Add/Change Current &User", , , , , , , "Settings-User")
.OwnerDraw(i) = True
i = .AddItem("Securi&ty/Privacy", , , , , , , "Settings-Security")
.OwnerDraw(i) = True
i = .AddItem("P&references", , , , , , , "Settings-Preferences")
.OwnerDraw(i) = True
i = .AddItem("&Windows/Alerts", , , , , , , "Settings-Windows")
.OwnerDraw(i) = True
i = .AddItem("-Help")
.OwnerDraw(i) = True
i = .AddItem("&Help", , , , 43, , , "Help")
.OwnerDraw(i) = True
i = .AddItem("On the We&b", , , , 38, , , "Web")
.OwnerDraw(i) = True
' Add some nice sites to the web menu. These items do not need
' to be owner-draw because there is no side bar in the submenu:
.AddItem "vbAccelerator", , mcWEBSITE, i, 42, , ,
"http://vbAccelerator.com/"
.AddItem "vbAccelerator Active Channel", , mcWEBSITE, i, 38, , ,
"http://vbAccelerator.com/vbaccel.cdf"
.AddItem "-other VB sites", , , i
.AddItem "Unlimited Realities", , mcWEBSITE, i, 38, , ,
"http://www.advantage.co.nz/ur/"
.AddItem "VBWire", , mcWEBSITE, i, 38, , , "http://vbwire.com/"
.AddItem "Matt Hart's VB HomePage", , mcWEBSITE, i, 38, , ,
"http://matthart.com/"
iI = .AddItem("Goffredo's Visual Basic Code Library", , mcWEBSITE, i, 38,
, , "http://www.cs.utexas.edu/users/gglaze/vb.htm")
.Default(iI) = True
.AddItem "VBNet", , mcWEBSITE, i, 38, , , "http://www.mvps.org/vbnet/"
.AddItem "-music sites", , , i
.AddItem "New Musical Express", , mcWEBSITE, i, 38, , ,
"http://www.nme.com/"
.AddItem "Public Enemy", , mcWEBSITE, i, 38, , ,
"http://www.public-enemy.com/"
.AddItem "MP3 Resource Site", , mcWEBSITE, i, 38, , ,
"http://www.mp3.com/"
.AddItem "Internet Underground Music Archive", , mcWEBSITE, i, 38, , ,
"http://www.iuma.com/"
.AddItem "Warp Records", , mcWEBSITE, i, 38, , , "http://www.warp.co.uk/"
.AddItem "-search", , , i
.AddItem "HotBot", , mcWEBSITE, i, 40, , , "http://www.hotbot.com/"
.AddItem "Dogpile", , mcWEBSITE, i, 40, , , "http://www.dogpile.com/"
.AddItem "-other sites", , , i
.AddItem "Mirablis ICQ", , mcWEBSITE, i, 38, , , "http://www.icq.com/"
.AddItem "I Drink - The Drink Mixing Website", , mcWEBSITE, i, 38, , ,
"http://www.idrink.com/"
.AddItem "Dave's Classics", , mcWEBSITE, i, 38, , ,
"http://www.davesclassics.com/"
i = .AddItem("-")
.OwnerDraw(i) = True
i = .AddItem("&Close", , , , , , , "Close")
.OwnerDraw(i) = True
End With
' Now prepare the side bar.
' Firstly, evaluate the menu item's height in the main menu:
Dim lHeight As Long, lT As Long
Debug.Print m_cMenu.Count
For i = 1 To m_cMenu.Count
' Check if item is in the main menu:
If (m_cMenu.hMenu(i) = m_cMenu.hMenu(1)) Then
' Add the item:
lHeight = lHeight + m_cMenu.MenuItemHeight(i)
lT = lT + 1
End If
Next i
' We use a PictureBox to hold the side logo here for convenience,
' however, you could use CreateCompatibleDC and CreateCompatibleBitmap
' to create a memory DC to hold this to avoid having the extra control.
picSideBar.Height = lHeight * Screen.TwipsPerPixelY
' Draw a gradient into it. Here I stole the code directly from the
' SideLogo/Fonts at any angle project for simplicity:
Dim c As New cLogo
With c
.DrawingObject = picSideBar
.StartColor = &H3399&
.EndColor = &H0&
.Caption = "vbAccelerator"
ilsIcons16.ListImages(1).Draw 0, 0, 0
.hImageList = ilsIcons16.hImageList
.IconIndex = 42
.Draw
End With
End Sub
Private Sub m_cMenu_Click(ItemNumber As Long)
Dim sKey As String
sKey = m_cMenu.ItemKey(ItemNumber)
Select Case sKey
Case "New"
MsgBox "New Accelerator selected!", vbExclamation
Case "Open"
MsgBox "Open Accelerator selected!", vbExclamation
End Select
End Sub
Private Sub m_cMenu_DrawItem(ByVal hDC As Long, ByVal lMenuIndex As Long, lLeft
As Long, lTop As Long, lRight As Long, lBottom As Long, ByVal bSelected As
Boolean, ByVal bChecked As Boolean, ByVal bDisabled As Boolean, bDoDefault As
Boolean)
Dim lW As Long
' The DrawItem event for Owner Draw menu items either allows you
' to draw the entire item, or just to do some new drawing then
' let the standard method do its stuff. This is useful if you
' want to add a graphic to the left or right of the menu item.
' Here we draw the relevant part of the side bar
' logo to the left of the menu then offset the
' left position so the rest of the menu draws
' after it:
Debug.Print lMenuIndex, lBottom
lW = picSideBar.Width \ Screen.TwipsPerPixelX
BitBlt hDC, lLeft, lTop, lW, lBottom - lTop, picSideBar.hDC, 0, lTop,
vbSrcCopy
lLeft = lLeft + lW + 1
bDoDefault = True
End Sub
Private Sub m_cMenu_ItemHighlight(ItemNumber As Long, bEnabled As Boolean,
bSeparator As Boolean)
' Show the user what's been highlighted. In a real application you
' would want to make these captions more descriptive:
If (m_cMenu.ItemData(ItemNumber) = mcWEBSITE) Then
lblInfo.Caption = "Visit " & m_cMenu.Caption(ItemNumber) & " (" &
m_cMenu.ItemKey(ItemNumber) & ")"
Else
lblInfo.Caption = m_cMenu.Caption(ItemNumber)
End If
End Sub
Private Sub m_cMenu_MeasureItem(ByVal lMenuIndex As Long, lWidth As Long,
lHeight As Long)
' When a menu item is owner-draw, it will raise this event to request
' its size. lWidth as lHeight will be already filled in with the
' size of the menu item as it would be if the standard drawing method
' was used.
' Here we check if the item being measured is in the main pop-up menu;
' if it is we add the width to accommodate the side bar logo:
If m_cMenu.hMenu(1) = m_cMenu.hMenu(lMenuIndex) Then
' Add the side bar width:
lWidth = lWidth + picSideBar.Width \ Screen.TwipsPerPixelX + 1
End If
End Sub
