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 / samples5 / ch10 / sysmenu.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1997-02-16  |  4.6 KB  |  131 lines
  1. VERSION 5.00
  2. Object = "{C5089F43-6EDC-101C-B41C-00AA0036005A}#4.0#0"; "dwsbc32d.ocx"
  3. Begin VB.Form frmSysMenu 
  4.    Caption         =   "Change System Menu & Context Menus"
  5.    ClientHeight    =   1560
  6.    ClientLeft      =   1095
  7.    ClientTop       =   1515
  8.    ClientWidth     =   5790
  9.    LinkTopic       =   "Form1"
  10.    PaletteMode     =   1  'UseZOrder
  11.    ScaleHeight     =   1560
  12.    ScaleWidth      =   5790
  13.    Begin VB.PictureBox picTarget 
  14.       Height          =   495
  15.       Left            =   720
  16.       ScaleHeight     =   465
  17.       ScaleWidth      =   885
  18.       TabIndex        =   3
  19.       Top             =   840
  20.       Visible         =   0   'False
  21.       Width           =   915
  22.    End
  23.    Begin VB.CheckBox chkContext 
  24.       Caption         =   "Replace Context Menu"
  25.       Height          =   255
  26.       Left            =   2700
  27.       TabIndex        =   2
  28.       Top             =   960
  29.       Width           =   2115
  30.    End
  31.    Begin VB.CommandButton cmdAddSystem 
  32.       Caption         =   "Add To System Menu"
  33.       Height          =   495
  34.       Left            =   2700
  35.       TabIndex        =   1
  36.       Top             =   300
  37.       Width           =   1995
  38.    End
  39.    Begin VB.TextBox txtMenu 
  40.       Height          =   315
  41.       Left            =   660
  42.       TabIndex        =   0
  43.       Text            =   "NewMenu"
  44.       Top             =   360
  45.       Width           =   1815
  46.    End
  47.    Begin DwsbcLibDemo.SubClass SubClass1 
  48.       Left            =   5160
  49.       Top             =   780
  50.       _Version        =   262144
  51.       _ExtentX        =   847
  52.       _ExtentY        =   847
  53.       _StockProps     =   0
  54.       CtlParam        =   "frmSysMenu"
  55.       Persist         =   0
  56.       RegMessage1     =   ""
  57.       RegMessage2     =   ""
  58.       RegMessage3     =   ""
  59.       RegMessage4     =   ""
  60.       RegMessage5     =   ""
  61.       Type            =   0
  62.       Messages        =   "SYSMENU.frx":0000
  63.    End
  64. Attribute VB_Name = "frmSysMenu"
  65. Attribute VB_GlobalNameSpace = False
  66. Attribute VB_Creatable = False
  67. Attribute VB_PredeclaredId = True
  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 OLE_HANDLE, msg As OLE_HANDLE, wp As OLE_HANDLE, 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.