home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR2 / CLACKER.ZIP / SAMPLE.ZIP / GENERAPP.FRM next >
Text File  |  1993-07-10  |  15KB  |  406 lines
  1. VERSION 2.00
  2. Begin Form Clacker_Form 
  3.    Caption         =   "Clacker Test"
  4.    ClientHeight    =   4860
  5.    ClientLeft      =   1215
  6.    ClientTop       =   1830
  7.    ClientWidth     =   5055
  8.    Height          =   5550
  9.    Left            =   1155
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   4860
  12.    ScaleWidth      =   5055
  13.    Top             =   1200
  14.    Width           =   5175
  15.    Begin Clack Clacker1 
  16.       hwndForm        =   0
  17.       Left            =   840
  18.       Top             =   1200
  19.    End
  20.    Begin CommandButton BTN_Exit 
  21.       Caption         =   "Exit"
  22.       Height          =   375
  23.       Left            =   3720
  24.       TabIndex        =   4
  25.       Top             =   240
  26.       Width           =   1215
  27.    End
  28.    Begin TextBox Text2 
  29.       Height          =   2655
  30.       Left            =   120
  31.       MultiLine       =   -1  'True
  32.       ScrollBars      =   3  'Both
  33.       TabIndex        =   3
  34.       Text            =   "Text2"
  35.       Top             =   840
  36.       Width           =   4815
  37.    End
  38.    Begin CommandButton Btn_UnHook 
  39.       Caption         =   "UnHook"
  40.       Height          =   375
  41.       Left            =   1080
  42.       TabIndex        =   1
  43.       Top             =   240
  44.       Width           =   1215
  45.    End
  46.    Begin CommandButton Btn_Hook 
  47.       Caption         =   "Hook"
  48.       Height          =   375
  49.       Left            =   2400
  50.       TabIndex        =   2
  51.       Top             =   240
  52.       Width           =   1215
  53.    End
  54.    Begin TextBox TXT_MID 
  55.       Height          =   975
  56.       Left            =   120
  57.       MultiLine       =   -1  'True
  58.       TabIndex        =   0
  59.       Text            =   "Menu ID, menu not hooked"
  60.       Top             =   3720
  61.       Width           =   4815
  62.    End
  63.    Begin Menu nmu_File 
  64.       Caption         =   "&File"
  65.       Begin Menu mnu_Exit 
  66.          Caption         =   "&Exit"
  67.       End
  68.    End
  69.    Begin Menu mnu_Edit 
  70.       Caption         =   "&Edit"
  71.       Begin Menu mnu_Cut 
  72.          Caption         =   "Cu&t"
  73.       End
  74.       Begin Menu mnu_Copy 
  75.          Caption         =   "&Copy"
  76.       End
  77.       Begin Menu mnu_Paste 
  78.          Caption         =   "&Paste"
  79.       End
  80.       Begin Menu mnu_submenu 
  81.          Caption         =   "SubMenu"
  82.          Begin Menu mnu_submenu1 
  83.             Caption         =   "SubMenu 1"
  84.          End
  85.          Begin Menu mnu_submenu2 
  86.             Caption         =   "SubMenu 2"
  87.          End
  88.       End
  89.    End
  90. End
  91. Option Explicit
  92.  
  93. Const CLACKER_START = 1
  94. Const CLACKER_STOP = 2
  95.  
  96. Declare Function GetParent Lib "User" (ByVal hWnd As Integer) As Integer
  97.  
  98. Dim MenuStatus() As HelpTextType
  99.  
  100. Dim taContextHelp(1 To 25) As HelpTextType
  101.  
  102. Sub BTN_Exit_Click ()
  103.     mnu_Exit_Click
  104. End Sub
  105.  
  106. Sub Btn_Hook_Click ()
  107. Dim Msg As String
  108. Dim hWndParent As Integer
  109.  
  110.     'Msg = "hWnd HEX = " + Hex$(hWnd) + "    DECIMAL = " + Str$(hWnd) + Chr$(10) + Chr(13)
  111.     'hWndParent = GetParent(hWnd)
  112.     'Msg = Msg + "Parent of Me.hWnd HEX = " + Hex$(hWndParent) + "    DECIMAL = " + Str$(hWndParent)
  113.     'MsgBox Msg
  114.  
  115.     Clacker1.hwndForm = Me.hWnd
  116.     Clacker1.Action = CLACKER_START
  117.  
  118.     TXT_MID.Text = "Menu ID, menu hooked"
  119.  
  120. End Sub
  121.  
  122. Sub Btn_UnHook_Click ()
  123.  
  124.     Clacker1.hwndForm = Me.hWnd
  125.     Clacker1.Action = CLACKER_STOP
  126.  
  127.     TXT_MID.Text = "Menu ID, menu not hooked"
  128. End Sub
  129.  
  130. Sub Clacker1_ClackerClick (hMenu As Integer, MenuID As Integer, MenuCaption As String)
  131. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  132. ' PURPOSE: Determine which menu was hit.
  133. ' COMMENTS: Clacker.vbx returns all the values shown from windows.
  134. '           Read the SDK docs, to better understand Window's menu behavior.
  135. ' NOTES:    1. It is not necessary to make use of all of the return params.
  136. '               Using only the MenuID is suffecient to retreive the stored text.
  137. '           2. Clacker does not return a caption for all menu hits. Windows does
  138. '               not provide return captions for typically unused menu items,
  139. '               ie, those which are processed by Window's default menuprocs.
  140. '           3. Separators return MenuID = 0 for all of them.
  141. '           4. Top level menus and submenus return hMenu = MenuID.
  142. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  143. Dim Msg As String
  144. Dim ndex As Integer
  145. Dim lMenuID As Long, lhMenu As Long
  146.  
  147. If MenuID = -1 Then Stop
  148. If hMenu = -1 Then Stop
  149.  
  150.     If MenuID < -1 Then
  151.         'change Menu ID to faked USHORT
  152.         lMenuID = MenuID + 65536
  153.     Else
  154.         lMenuID = MenuID
  155.     End If
  156.     If hMenu < -1 Then
  157.         'change Menu ID to faked USHORT
  158.         lhMenu = hMenu + 65536
  159.     Else
  160.         lhMenu = hMenu
  161.     End If
  162.     '
  163.     ' debugging output
  164.     Msg = ""
  165.     Msg = Msg + "hMenu  hex = " + Hex$(lhMenu) + Chr$(13) + Chr$(10)
  166.     Msg = Msg + "MenuID hex = " + Hex$(lMenuID) + Chr$(13) + Chr$(10)
  167.     If Len(MenuCaption) <> 0 Then
  168.         Msg = Msg + "MenuCaption  " + MenuCaption + Chr$(13) + Chr$(10)
  169.     Else
  170.         Msg = Msg + "MenuCaption  [none returned]" + Chr$(13) + Chr$(10)
  171.     End If
  172.     Debug.Print Msg
  173.     '
  174.     ' user output
  175.     ' search for the MenuID, get the assigned help text and display it.
  176.     For ndex = 1 To 20
  177.         If MenuStatus(ndex).lMenuID = lMenuID Then
  178.             ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  179.             ' IMPORTANT NOTE:
  180.             ' A BOGUS MenuID was initially stored in the top menu spot
  181.             ' The real hMenu of a top level menu shows up here
  182.             ' You can sub the bogus for the real one if desired.
  183.             ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  184.             If MenuStatus(ndex).lhMenu <> lhMenu Then
  185.               '
  186.               ' see if it is the BOGUS MenuID
  187.               '
  188.               If MenuStatus(ndex).lhMenu <> lMenuID Then
  189.                 Msg = "Bad stored hMenu" + Chr$(13) + Chr$(10)
  190.                 Msg = Msg + "Stored hMenu = " + Hex$(MenuStatus(ndex).lhMenu) + Chr$(13) + Chr$(10)
  191.                 Msg = Msg + "Return hMenu = " + Hex$(lhMenu) + Chr$(13) + Chr$(10)
  192.                 Msg = Msg + "return MenuID= " + Hex$(lMenuID) + Chr$(13) + Chr$(10)
  193.                 Debug.Print Msg
  194.               Else
  195.                 Debug.Print "Bogus top level menu was stored here"
  196.               End If
  197.             End If
  198.             Msg = "MenuID = " + Hex$(lMenuID) + Chr$(13) + Chr$(10)
  199.             Msg = Msg + "hMenu = " + Hex$(hMenu) + Chr$(13) + Chr$(10)
  200.             Msg = Msg + "Help Msg Text = " + MenuStatus(ndex).strHelpMsg + Chr$(13) + Chr$(10)
  201.             If Len(MenuCaption) <> 0 Then
  202.                 Msg = Msg + "Menu Caption = " + MenuCaption + Chr$(13) + Chr$(10)
  203.             Else
  204.                 Msg = Msg + "Menu Caption = [No Caption returned]" + Chr$(13) + Chr$(10)
  205.             End If
  206.             TXT_MID.Text = Msg
  207.             Msg = "Found It " + Msg
  208.             Debug.Print Msg
  209.             Exit Sub
  210.         End If
  211.     Next
  212. End Sub
  213.  
  214. Sub Form_Load ()
  215. Dim hSysMenu As Integer
  216. Dim hMainMenu As Integer
  217. Dim Msg As String
  218. Dim ndex As Integer
  219.  
  220.     Top = 0
  221.     Left = 0
  222.  
  223.     '' how many menu items
  224.     ' system
  225.     hSysMenu = GetSystemMenu(Me.hWnd, False)
  226.     ' main menu
  227.     hMainMenu = GetMenu(Me.hWnd)
  228.     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  229.     ' IMPORTANT NOTE:
  230.     '   The MenuStatus array size must be equal to or great than the total
  231.     '   number of menu items in the form, or else a bounds error will occur.
  232.     '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  233.     ReDim MenuStatus(1 To 25) As HelpTextType
  234.     '' fill the array with their ids
  235.     ' first the system menu
  236.     Debug.Print "Setup hSysMenu"
  237.     MenuSetup hSysMenu
  238.     ' now the main menu
  239.     ' start where the sysmenu ends
  240.     Debug.Print "Setup hMainMenu"
  241.     MenuSetup hMainMenu
  242.     '
  243.     '
  244.     ' set up help text
  245.     MenuHelpText
  246.     ' Print all menu IDs to a dialog
  247.     Msg = ""
  248.     Msg = Msg + "Me.hWnd HEX = " + Hex$(hWnd) + "    DECIMAL = " + Str$(hWnd) + Chr$(13) + Chr$(10)
  249.     Msg = Msg + "hSysMenu  =" + Hex$(hSysMenu) + Chr$(13) + Chr$(10)
  250.     Msg = Msg + "hMainMenu =" + Hex$(hMainMenu) + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)
  251.     For ndex = 1 To 20
  252.         Msg = Msg + "Index = " + Str$(ndex) + Chr$(13) + Chr$(10)
  253.         Msg = Msg + "hMenu = " + Hex$(MenuStatus(ndex).lhMenu) + Chr$(13) + Chr$(10)
  254.         Msg = Msg + "MID = " + Hex$(MenuStatus(ndex).lMenuID) + Chr$(13) + Chr$(10)
  255.         Msg = Msg + "Help Text    = " + MenuStatus(ndex).strHelpMsg + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)
  256.     Next
  257.     Text2.Text = Msg
  258. End Sub
  259.  
  260. Sub Form_Resize ()
  261.     If Me.WindowState = 0 Then
  262.         Me.Height = 5550
  263.         Me.Width = 5175
  264.     End If
  265. End Sub
  266.  
  267. Sub Form_Unload (Cancel As Integer)
  268.     Clacker1.hwndForm = Me.hWnd
  269.     Clacker1.Action = CLACKER_STOP
  270. End Sub
  271.  
  272. Sub MenuHelpText ()
  273. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  274. '  PURPOSE: Load the help text string in the array.
  275. ' COMMENTS: Make sure you provide an entry for each menu in your
  276. '           menu system, even if it won't be used. This helps when
  277. '           laying out the help system and with debugging.
  278. '    NOTES: 1. To conserve stack space in the main module
  279. '               place the text strings and the array in another module
  280. '           2. The MenuStatus array size must be equal to or great than the total
  281. '               number of menu items in the form, or else a bounds error will occur.
  282. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  283.  
  284.     MenuStatus(1).strHelpMsg = "<System Menu>"
  285.     MenuStatus(2).strHelpMsg = "Restore previous window position"
  286.     MenuStatus(3).strHelpMsg = "Move the current window Window"
  287.     MenuStatus(4).strHelpMsg = "Change the size of current Window"
  288.     MenuStatus(5).strHelpMsg = "Minimize current Window"
  289.     MenuStatus(6).strHelpMsg = "Maximize current Window"
  290.     MenuStatus(7).strHelpMsg = "[separator]"        '[separator], no MenuID and no text
  291.     MenuStatus(8).strHelpMsg = "Close current Window"
  292.     MenuStatus(9).strHelpMsg = "[separator]"        '[separator], no MenuID and no text
  293.     MenuStatus(10).strHelpMsg = "Switch to different task"
  294.     MenuStatus(11).strHelpMsg = "<Main Form Menu>"
  295.     MenuStatus(12).strHelpMsg = "<File Menu>"
  296.     MenuStatus(13).strHelpMsg = "Exit the program"
  297.     MenuStatus(14).strHelpMsg = "<Edit Menu>"
  298.     MenuStatus(15).strHelpMsg = "Cut selected text from document"
  299.     MenuStatus(16).strHelpMsg = "Copy selected text to clipboard"
  300.     MenuStatus(17).strHelpMsg = "Paste clipboard text into document"
  301.     MenuStatus(18).strHelpMsg = "Main Submenu text"
  302.     MenuStatus(19).strHelpMsg = "Submenu1 text message"
  303.     MenuStatus(20).strHelpMsg = "Submenu2 text message"
  304.  
  305. End Sub
  306.  
  307. Sub MenuSetup (hMenu As Integer)
  308. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  309. '  PURPOSE: Save the menu item ID information into the passed array
  310. ' COMMENTS: MenuSetup() is called recursively to load sub-menus
  311. '    NOTES: 1. The MenuStatus array size must be equal to or great than the total
  312. '              number of menu items in the form, or else a bounds error will occur.
  313. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  314. Dim nItemCount As Integer
  315. Dim lMenuID, lMenu As Long
  316. Dim nItemPos As Integer
  317. Dim nResult As Integer
  318. Dim nMenuID As Integer
  319. Static nElement As Integer  ' Static for pointer locating the last element inserted
  320.  
  321. Debug.Print "New hMenu = "; Hex$(hMenu)
  322. Debug.Print
  323.     nItemPos = 0
  324.     nElement = nElement + 1
  325.     '
  326.     '
  327.     ' store the top most menu
  328.     If hMenu < -1 Then
  329.         'change Menu ID to a faked USHORT
  330.         lMenu = hMenu + 65536
  331.     Else
  332.         lMenu = hMenu
  333.     End If
  334.     MenuStatus(nElement).lhMenu = lMenu
  335.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  336.     ' IMPORTANT NOTE:
  337.     ' Store the hMenu in the menuID spot as a FLAG
  338.     ' The MenuID returned from Clacker WILL NOT MATCH THIS
  339.     ' Clacker will return the real top level hMenu from windows.
  340.     ''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  341.     lMenuID = hMenu
  342.     MenuStatus(nElement).lMenuID = lMenuID
  343.     
  344.     Debug.Print "nItemPos = "; nItemPos
  345.     Debug.Print "nElement = "; nElement
  346.     Debug.Print "MenuStatus(nElement).nMenuID = "; Hex$(MenuStatus(nElement).lMenuID)
  347.     Debug.Print "MenuStatus(nElement).lhMenu   = "; Hex$(MenuStatus(nElement).lhMenu)
  348.     Debug.Print
  349.  
  350.     nItemCount = GetMenuItemCount(hMenu)
  351.  
  352.     For nItemPos = 0 To nItemCount - 1
  353.         ' Enumerate all sub-menus
  354.         ' each sub menu starts at zero
  355.         ' the menu id for this position
  356.         nMenuID = GetMenuItemID(hMenu, nItemPos)
  357.         If nMenuID = -1 Then
  358.             '
  359.             ' if the first item is -1
  360.             '   it's a submenu ( cascade menu )
  361.             nMenuID = GetSubMenu(hMenu, nItemPos)
  362.             '
  363.             ' since it is a submenu need to
  364.             ' call this function recursively
  365.             Debug.Print "Recurse"
  366.             MenuSetup nMenuID
  367.         Else
  368.             '
  369.             'normal menu item, save the menu item ID
  370.             '
  371.             ' bump the position so we start at 2,
  372.             '   after the first hMenu is added
  373.             nElement = nElement + 1
  374.             ' Menu ID is a USHORT type, but VB has none so,
  375.             ' change Menu ID to unsigned short as required for saving
  376.             ' and later matching the return value from Clacker
  377.             If nMenuID < -1 Then
  378.                 'change Menu ID to a faked USHORT
  379.                 lMenuID = nMenuID + 65536
  380.             Else
  381.                 lMenuID = nMenuID
  382.             End If
  383.             '
  384.             ' Put a menu item in the array
  385.             MenuStatus(nElement).lMenuID = lMenuID
  386.             MenuStatus(nElement).lhMenu = hMenu
  387.             
  388.             Debug.Print "nItemPos = "; nItemPos
  389.             Debug.Print "nElement = "; nElement
  390.             Debug.Print "MenuStatus(nElement).nMenuID = "; Hex$(MenuStatus(nElement).lMenuID)
  391.             Debug.Print "MenuStatus(nElement).lhMenu   = "; Hex$(MenuStatus(nElement).lhMenu)
  392.             Debug.Print
  393.     
  394.         End If
  395.     Next
  396. End Sub
  397.  
  398. Sub mnu_Exit_Click ()
  399.     '
  400.     ' process cannot terminate with menus still hooked to dll
  401.     Clacker1.hwndForm = Me.hWnd
  402.     Clacker1.Action = CLACKER_STOP
  403.     End
  404. End Sub
  405.  
  406.