VB5 ContextMenu Demonstration (21K)
VB6 Context Menu Demonstration (21K)
25 Nov 2002
First Posted
Subclassing Without The Crashes
vbAccelerator - Contents of code file: frmContextMenu.frm
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmContextMenu
Caption = "Custom Context Menu Demonstration"
ClientHeight = 5085
ClientLeft = 5220
ClientTop = 4035
ClientWidth = 6675
Icon = "frmContextMenu.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5085
ScaleWidth = 6675
Begin VB.ListBox lstTest
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2400
Left = 120
MultiSelect = 2 'Extended
TabIndex = 1
Top = 2460
Width = 6435
End
Begin VB.TextBox txtTest
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2355
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Text = "frmContextMenu.frx":014A
Top = 60
Width = 6435
End
Begin MSComctlLib.ImageList ilsIcons16
Left = 240
Top = 4800
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 43
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":01EF
Key = "PASTE"
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":0509
Key = "CUT"
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":0823
Key = "COPY"
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":0B3D
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":0E57
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":1171
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":148B
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":17A5
Key = ""
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":1ABF
Key = ""
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":1DD9
Key = ""
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":20F3
Key = ""
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":240D
Key = ""
EndProperty
BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":2727
Key = ""
EndProperty
BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":2A41
Key = ""
EndProperty
BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":2D5B
Key = ""
EndProperty
BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":3075
Key = ""
EndProperty
BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":338F
Key = ""
EndProperty
BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":36A9
Key = ""
EndProperty
BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":39C3
Key = ""
EndProperty
BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":3CDD
Key = ""
EndProperty
BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":3FF7
Key = ""
EndProperty
BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":4311
Key = ""
EndProperty
BeginProperty ListImage23 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":462B
Key = ""
EndProperty
BeginProperty ListImage24 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":4945
Key = ""
EndProperty
BeginProperty ListImage25 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":4C5F
Key = ""
EndProperty
BeginProperty ListImage26 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":4F79
Key = ""
EndProperty
BeginProperty ListImage27 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":5293
Key = ""
EndProperty
BeginProperty ListImage28 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":55AD
Key = ""
EndProperty
BeginProperty ListImage29 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":58C7
Key = ""
EndProperty
BeginProperty ListImage30 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":5BE1
Key = ""
EndProperty
BeginProperty ListImage31 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":5EFB
Key = ""
EndProperty
BeginProperty ListImage32 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":6215
Key = ""
EndProperty
BeginProperty ListImage33 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":652F
Key = ""
EndProperty
BeginProperty ListImage34 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":6849
Key = ""
EndProperty
BeginProperty ListImage35 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":6B63
Key = ""
EndProperty
BeginProperty ListImage36 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":6E7D
Key = "UNDO"
EndProperty
BeginProperty ListImage37 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":7197
Key = ""
EndProperty
BeginProperty ListImage38 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":74B1
Key = ""
EndProperty
BeginProperty ListImage39 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":77CB
Key = "Web"
EndProperty
BeginProperty ListImage40 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":7AE5
Key = ""
EndProperty
BeginProperty ListImage41 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":7DFF
Key = ""
EndProperty
BeginProperty ListImage42 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":8119
Key = ""
EndProperty
BeginProperty ListImage43 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmContextMenu.frx":8433
Key = "vbAccelerator"
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmContextMenu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents cP As cPopupMenu
Attribute cP.VB_VarHelpID = -1
Private WithEvents cO As cOwnerDrawContextMenu
Attribute cO.VB_VarHelpID = -1
Private cTextEdit As cTextBoxEdit
Private Sub createMenus()
Dim i As Long
i = cP.AddItem("TOP0", , , , ilsIcons16.ListImages("UNDO").Index - 1, , ,
"TEXTBOX")
cP.AddItem "&Undo", , , i, , , , "T:UNDO"
cP.AddItem "-", , , i
cP.AddItem "Cu&t" & vbTab & "Ctrl+X", , , i,
ilsIcons16.ListImages("CUT").Index - 1, , , "T:CUT"
cP.AddItem "&Copy" & vbTab & "Ctrl+C", , , i,
ilsIcons16.ListImages("COPY").Index - 1, , , "T:COPY"
cP.AddItem "&Paste" & vbTab & "Ctrl+V", , , i,
ilsIcons16.ListImages("PASTE").Index - 1, , , "T:PASTE"
cP.AddItem "-", , , i
cP.AddItem "Select &All" & vbTab & "Ctrl+A", , , i, , , , "T:SELECTALL"
i = cP.AddItem("TOP1", , , , , , , "LISTBOX")
cP.AddItem "Cu&t" & vbTab & "Ctrl+X", , , i,
ilsIcons16.ListImages("CUT").Index - 1, , , "L:CUT"
cP.AddItem "&Copy" & vbTab & "Ctrl+C", , , i,
ilsIcons16.ListImages("COPY").Index - 1, , , "L:COPY"
cP.AddItem "&Paste" & vbTab & "Ctrl+V", , , i,
ilsIcons16.ListImages("PASTE").Index - 1, , , "L:PASTE"
cP.AddItem "-", , , i
cP.AddItem "Select &All" & vbTab & "Ctrl+A", , , i, , , , "L:SELECTALL"
cP.AddItem "Invert Selection", , , i, , , , "L:INVERT"
End Sub
Private Sub cO_ContextMenu(ByVal Key As String, bDoDefault As Boolean)
Select Case Key
Case "txtTest"
cTextEdit.TextBox = txtTest
cP.Enabled(cP.IndexForKey("T:CUT")) = cTextEdit.CanCut
cP.Enabled(cP.IndexForKey("T:COPY")) = cTextEdit.CanCopy
cP.Enabled(cP.IndexForKey("T:PASTE")) = cTextEdit.CanPaste
cP.Enabled(cP.IndexForKey("T:UNDO")) = cTextEdit.CanUndo
Case "lstTest"
cP.Enabled(cP.IndexForKey("L:CUT")) = (lstTest.SelCount > 0)
cP.Enabled(cP.IndexForKey("L:COPY")) = (lstTest.SelCount > 0)
cP.Enabled(cP.IndexForKey("L:PASTE")) = cTextEdit.CanPaste
End Select
End Sub
Private Sub cP_Click(ItemNumber As Long)
Dim sKey As String
Dim i As Long
Dim sClip As String
Dim iPos As Long, iNextPos As Long
lstTest.AddItem "Clicked: " & ItemNumber & ",Caption=" &
cP.Caption(ItemNumber)
sKey = cP.ItemKey(ItemNumber)
If Left$(sKey, 2) = "T:" Then
Select Case Mid$(sKey, 3)
Case "UNDO"
cTextEdit.Undo
Case "CUT"
cTextEdit.Cut
Case "COPY"
cTextEdit.Copy
Case "PASTE"
cTextEdit.Paste
Case "SELECTALL"
txtTest.SetFocus
txtTest.SelStart = 0
txtTest.SelLength = Len(txtTest.Text)
End Select
ElseIf Left$(sKey, 2) = "L:" Then
Select Case Mid$(sKey, 3)
Case "CUT"
For i = lstTest.ListCount - 1 To 0 Step -1
If lstTest.Selected(i) Then
lstTest.RemoveItem i
End If
Next i
Case "COPY"
For i = lstTest.ListCount - 1 To 0 Step -1
If lstTest.Selected(i) Then
If Len(sClip) > 0 Then
sClip = sClip & vbCrLf
End If
sClip = sClip & lstTest.List(i)
End If
Next i
Clipboard.SetText sClip
Case "PASTE"
sClip = Clipboard.GetText()
iPos = 1
Do
iNextPos = InStr(iPos, sClip, vbCrLf)
If iNextPos > 0 Then
lstTest.AddItem Mid$(sClip, iPos, iNextPos - iPos)
iPos = iNextPos + 2
Else
lstTest.AddItem Mid$(sClip, iPos)
End If
Loop While iNextPos > 0
Case "SELECTALL"
For i = 0 To lstTest.ListCount - 1
lstTest.Selected(i) = True
Next i
Case "INVERT"
For i = 0 To lstTest.ListCount - 1
lstTest.Selected(i) = Not (lstTest.Selected(i))
Next i
End Select
End If
End Sub
Private Sub Form_Load()
Set cP = New cPopupMenu
cP.hWndOwner = Me.hWnd
cP.ImageList = ilsIcons16
createMenus
Set cO = New cOwnerDrawContextMenu
cO.PopupMenu = cP
cO.Add "txtTest", txtTest.hWnd, "T:UNDO"
cO.Add "lstTest", lstTest.hWnd, "L:CUT"
Set cTextEdit = New cTextBoxEdit
End Sub
