home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples4 / ch10 / sysmenu.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  4.5 KB  |  131 lines
  1. VERSION 4.00
  2. Begin VB.Form frmSysMenu 
  3.    Caption         =   "Change System Menu & Context Menus"
  4.    ClientHeight    =   1560
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1515
  7.    ClientWidth     =   5790
  8.    Height          =   1965
  9.    Left            =   1035
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   1560
  12.    ScaleWidth      =   5790
  13.    Top             =   1170
  14.    Width           =   5910
  15.    Begin VB.PictureBox picTarget 
  16.       Height          =   495
  17.       Left            =   720
  18.       ScaleHeight     =   465
  19.       ScaleWidth      =   885
  20.       TabIndex        =   3
  21.       Top             =   840
  22.       Visible         =   0   'False
  23.       Width           =   915
  24.    End
  25.    Begin VB.CheckBox chkContext 
  26.       Caption         =   "Replace Context Menu"
  27.       Height          =   255
  28.       Left            =   2700
  29.       TabIndex        =   2
  30.       Top             =   960
  31.       Width           =   2115
  32.    End
  33.    Begin VB.CommandButton cmdAddSystem 
  34.       Caption         =   "Add To System Menu"
  35.       Height          =   495
  36.       Left            =   2700
  37.       TabIndex        =   1
  38.       Top             =   300
  39.       Width           =   1995
  40.    End
  41.    Begin VB.TextBox txtMenu 
  42.       Height          =   315
  43.       Left            =   660
  44.       TabIndex        =   0
  45.       Text            =   "NewMenu"
  46.       Top             =   360
  47.       Width           =   1815
  48.    End
  49.    Begin DwsbcLibDemo.SubClass SubClass1 
  50.       Left            =   5160
  51.       Top             =   780
  52.       _Version        =   262144
  53.       _ExtentX        =   847
  54.       _ExtentY        =   847
  55.       _StockProps     =   0
  56.       CtlParam        =   "frmSysMenu"
  57.       Persist         =   0
  58.       RegMessage1     =   ""
  59.       RegMessage2     =   ""
  60.       RegMessage3     =   ""
  61.       RegMessage4     =   ""
  62.       RegMessage5     =   ""
  63.       Type            =   0
  64.       Messages        =   "SYSMENU.frx":0000
  65.    End
  66. Attribute VB_Name = "frmSysMenu"
  67. Attribute VB_Creatable = False
  68. Attribute VB_Exposed = False
  69. Option Explicit
  70. ' Copyright 
  71.  1997 by Desaware Inc. All Rights Reserved.
  72. Dim CurrentID&
  73. Dim NewContextMenu&
  74. Const WM_CONTEXTMENU = &H7B
  75. Const WM_SYSCOMMAND = &H112
  76. Const WM_MENUBASE = &H2000
  77. Const WM_COMMAND = &H111
  78. Const SCOFFSET = 2000
  79. Private Sub cmdAddSystem_Click()
  80.     Dim sm&, di&
  81.     If Len(txtMenu.Text) = 0 Then
  82.         MsgBox "Must specify menu text"
  83.         Exit Sub
  84.     End If
  85.     sm& = GetSystemMenu(hwnd, False)
  86.     di& = AppendMenu(sm, MF_STRING, SCOFFSET + CurrentID, txtMenu.Text)
  87.     CurrentID = CurrentID + 1
  88. End Sub
  89. Private Sub Form_Load()
  90.     Dim di&
  91.     NewContextMenu = CreatePopupMenu()
  92.     di = AppendMenu(NewContextMenu, MF_STRING, WM_MENUBASE, "Entry 1")
  93.     di = AppendMenu(NewContextMenu, MF_STRING, WM_MENUBASE + 1, "Entry 2")
  94.     di = AppendMenu(NewContextMenu, MF_STRING, WM_MENUBASE + 2, "Entry 3")
  95.     SubClass1.AddHwnd = txtMenu.hwnd
  96.     SubClass1.AddHwnd = picTarget.hwnd
  97. End Sub
  98. Private Sub Form_Unload(Cancel As Integer)
  99.     If NewContextMenu Then Call DestroyMenu(NewContextMenu)
  100. End Sub
  101. ' This event is triggered for every WM_SYSCOMMAND message
  102. Private Sub SubClass1_WndMessage(hwnd As Long, msg As Long, wp As Long, lp As Long, retval As Long, nodef As Integer)
  103.     Dim sm&, di&
  104.     Dim usestring$
  105.     Dim usex%, usey%
  106.     Select Case msg
  107.         Case WM_COMMAND
  108.             ' We only care about WM_COMMAND messages to picture control
  109.             If hwnd <> picTarget.hwnd Then Exit Sub
  110.             Call agDWORDto2Integers(wp, usex, usey)
  111.             MsgBox "Received command # " & Hex$(usex)
  112.             nodef = True
  113.         Case WM_SYSCOMMAND
  114.             ' If it's not one of the ones we added, just exit
  115.             If wp < SCOFFSET Or wp >= (SCOFFSET + CurrentID) Then Exit Sub
  116.             ' Get the text for this menu entry
  117.             sm& = GetSystemMenu(hwnd, False)
  118.             usestring$ = String$(128, 0)
  119.             di = GetMenuString(sm, wp, usestring, 127, MF_BYCOMMAND)
  120.             MsgBox Left$(usestring, di), vbOKOnly, "System Menu Clicked is:"
  121.             nodef = True
  122.         Case WM_CONTEXTMENU
  123.             ' Only trap the context menu if requested
  124.             If chkContext.value = 0 Then Exit Sub
  125.             ' Get the location of the mouse click
  126.             Call agDWORDto2Integers(lp, usex, usey)
  127.             Call TrackPopupMenuBynum(NewContextMenu, TPM_LEFTALIGN Or TPM_RIGHTBUTTON, usex, usey, 0, picTarget.hwnd, 0)
  128.             nodef = True    ' Don't let control get the message!
  129.     End Select
  130. End Sub
  131.