home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR2
/
CLACKER.ZIP
/
SAMPLE.ZIP
/
GENERAPP.FRM
next >
Wrap
Text File
|
1993-07-10
|
15KB
|
406 lines
VERSION 2.00
Begin Form Clacker_Form
Caption = "Clacker Test"
ClientHeight = 4860
ClientLeft = 1215
ClientTop = 1830
ClientWidth = 5055
Height = 5550
Left = 1155
LinkTopic = "Form1"
ScaleHeight = 4860
ScaleWidth = 5055
Top = 1200
Width = 5175
Begin Clack Clacker1
hwndForm = 0
Left = 840
Top = 1200
End
Begin CommandButton BTN_Exit
Caption = "Exit"
Height = 375
Left = 3720
TabIndex = 4
Top = 240
Width = 1215
End
Begin TextBox Text2
Height = 2655
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 3
Text = "Text2"
Top = 840
Width = 4815
End
Begin CommandButton Btn_UnHook
Caption = "UnHook"
Height = 375
Left = 1080
TabIndex = 1
Top = 240
Width = 1215
End
Begin CommandButton Btn_Hook
Caption = "Hook"
Height = 375
Left = 2400
TabIndex = 2
Top = 240
Width = 1215
End
Begin TextBox TXT_MID
Height = 975
Left = 120
MultiLine = -1 'True
TabIndex = 0
Text = "Menu ID, menu not hooked"
Top = 3720
Width = 4815
End
Begin Menu nmu_File
Caption = "&File"
Begin Menu mnu_Exit
Caption = "&Exit"
End
End
Begin Menu mnu_Edit
Caption = "&Edit"
Begin Menu mnu_Cut
Caption = "Cu&t"
End
Begin Menu mnu_Copy
Caption = "&Copy"
End
Begin Menu mnu_Paste
Caption = "&Paste"
End
Begin Menu mnu_submenu
Caption = "SubMenu"
Begin Menu mnu_submenu1
Caption = "SubMenu 1"
End
Begin Menu mnu_submenu2
Caption = "SubMenu 2"
End
End
End
End
Option Explicit
Const CLACKER_START = 1
Const CLACKER_STOP = 2
Declare Function GetParent Lib "User" (ByVal hWnd As Integer) As Integer
Dim MenuStatus() As HelpTextType
Dim taContextHelp(1 To 25) As HelpTextType
Sub BTN_Exit_Click ()
mnu_Exit_Click
End Sub
Sub Btn_Hook_Click ()
Dim Msg As String
Dim hWndParent As Integer
'Msg = "hWnd HEX = " + Hex$(hWnd) + " DECIMAL = " + Str$(hWnd) + Chr$(10) + Chr(13)
'hWndParent = GetParent(hWnd)
'Msg = Msg + "Parent of Me.hWnd HEX = " + Hex$(hWndParent) + " DECIMAL = " + Str$(hWndParent)
'MsgBox Msg
Clacker1.hwndForm = Me.hWnd
Clacker1.Action = CLACKER_START
TXT_MID.Text = "Menu ID, menu hooked"
End Sub
Sub Btn_UnHook_Click ()
Clacker1.hwndForm = Me.hWnd
Clacker1.Action = CLACKER_STOP
TXT_MID.Text = "Menu ID, menu not hooked"
End Sub
Sub Clacker1_ClackerClick (hMenu As Integer, MenuID As Integer, MenuCaption As String)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PURPOSE: Determine which menu was hit.
' COMMENTS: Clacker.vbx returns all the values shown from windows.
' Read the SDK docs, to better understand Window's menu behavior.
' NOTES: 1. It is not necessary to make use of all of the return params.
' Using only the MenuID is suffecient to retreive the stored text.
' 2. Clacker does not return a caption for all menu hits. Windows does
' not provide return captions for typically unused menu items,
' ie, those which are processed by Window's default menuprocs.
' 3. Separators return MenuID = 0 for all of them.
' 4. Top level menus and submenus return hMenu = MenuID.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Msg As String
Dim ndex As Integer
Dim lMenuID As Long, lhMenu As Long
If MenuID = -1 Then Stop
If hMenu = -1 Then Stop
If MenuID < -1 Then
'change Menu ID to faked USHORT
lMenuID = MenuID + 65536
Else
lMenuID = MenuID
End If
If hMenu < -1 Then
'change Menu ID to faked USHORT
lhMenu = hMenu + 65536
Else
lhMenu = hMenu
End If
'
' debugging output
Msg = ""
Msg = Msg + "hMenu hex = " + Hex$(lhMenu) + Chr$(13) + Chr$(10)
Msg = Msg + "MenuID hex = " + Hex$(lMenuID) + Chr$(13) + Chr$(10)
If Len(MenuCaption) <> 0 Then
Msg = Msg + "MenuCaption " + MenuCaption + Chr$(13) + Chr$(10)
Else
Msg = Msg + "MenuCaption [none returned]" + Chr$(13) + Chr$(10)
End If
Debug.Print Msg
'
' user output
' search for the MenuID, get the assigned help text and display it.
For ndex = 1 To 20
If MenuStatus(ndex).lMenuID = lMenuID Then
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IMPORTANT NOTE:
' A BOGUS MenuID was initially stored in the top menu spot
' The real hMenu of a top level menu shows up here
' You can sub the bogus for the real one if desired.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If MenuStatus(ndex).lhMenu <> lhMenu Then
'
' see if it is the BOGUS MenuID
'
If MenuStatus(ndex).lhMenu <> lMenuID Then
Msg = "Bad stored hMenu" + Chr$(13) + Chr$(10)
Msg = Msg + "Stored hMenu = " + Hex$(MenuStatus(ndex).lhMenu) + Chr$(13) + Chr$(10)
Msg = Msg + "Return hMenu = " + Hex$(lhMenu) + Chr$(13) + Chr$(10)
Msg = Msg + "return MenuID= " + Hex$(lMenuID) + Chr$(13) + Chr$(10)
Debug.Print Msg
Else
Debug.Print "Bogus top level menu was stored here"
End If
End If
Msg = "MenuID = " + Hex$(lMenuID) + Chr$(13) + Chr$(10)
Msg = Msg + "hMenu = " + Hex$(hMenu) + Chr$(13) + Chr$(10)
Msg = Msg + "Help Msg Text = " + MenuStatus(ndex).strHelpMsg + Chr$(13) + Chr$(10)
If Len(MenuCaption) <> 0 Then
Msg = Msg + "Menu Caption = " + MenuCaption + Chr$(13) + Chr$(10)
Else
Msg = Msg + "Menu Caption = [No Caption returned]" + Chr$(13) + Chr$(10)
End If
TXT_MID.Text = Msg
Msg = "Found It " + Msg
Debug.Print Msg
Exit Sub
End If
Next
End Sub
Sub Form_Load ()
Dim hSysMenu As Integer
Dim hMainMenu As Integer
Dim Msg As String
Dim ndex As Integer
Top = 0
Left = 0
'' how many menu items
' system
hSysMenu = GetSystemMenu(Me.hWnd, False)
' main menu
hMainMenu = GetMenu(Me.hWnd)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IMPORTANT NOTE:
' The MenuStatus array size must be equal to or great than the total
' number of menu items in the form, or else a bounds error will occur.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
ReDim MenuStatus(1 To 25) As HelpTextType
'' fill the array with their ids
' first the system menu
Debug.Print "Setup hSysMenu"
MenuSetup hSysMenu
' now the main menu
' start where the sysmenu ends
Debug.Print "Setup hMainMenu"
MenuSetup hMainMenu
'
'
' set up help text
MenuHelpText
' Print all menu IDs to a dialog
Msg = ""
Msg = Msg + "Me.hWnd HEX = " + Hex$(hWnd) + " DECIMAL = " + Str$(hWnd) + Chr$(13) + Chr$(10)
Msg = Msg + "hSysMenu =" + Hex$(hSysMenu) + Chr$(13) + Chr$(10)
Msg = Msg + "hMainMenu =" + Hex$(hMainMenu) + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)
For ndex = 1 To 20
Msg = Msg + "Index = " + Str$(ndex) + Chr$(13) + Chr$(10)
Msg = Msg + "hMenu = " + Hex$(MenuStatus(ndex).lhMenu) + Chr$(13) + Chr$(10)
Msg = Msg + "MID = " + Hex$(MenuStatus(ndex).lMenuID) + Chr$(13) + Chr$(10)
Msg = Msg + "Help Text = " + MenuStatus(ndex).strHelpMsg + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10)
Next
Text2.Text = Msg
End Sub
Sub Form_Resize ()
If Me.WindowState = 0 Then
Me.Height = 5550
Me.Width = 5175
End If
End Sub
Sub Form_Unload (Cancel As Integer)
Clacker1.hwndForm = Me.hWnd
Clacker1.Action = CLACKER_STOP
End Sub
Sub MenuHelpText ()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PURPOSE: Load the help text string in the array.
' COMMENTS: Make sure you provide an entry for each menu in your
' menu system, even if it won't be used. This helps when
' laying out the help system and with debugging.
' NOTES: 1. To conserve stack space in the main module
' place the text strings and the array in another module
' 2. The MenuStatus array size must be equal to or great than the total
' number of menu items in the form, or else a bounds error will occur.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
MenuStatus(1).strHelpMsg = "<System Menu>"
MenuStatus(2).strHelpMsg = "Restore previous window position"
MenuStatus(3).strHelpMsg = "Move the current window Window"
MenuStatus(4).strHelpMsg = "Change the size of current Window"
MenuStatus(5).strHelpMsg = "Minimize current Window"
MenuStatus(6).strHelpMsg = "Maximize current Window"
MenuStatus(7).strHelpMsg = "[separator]" '[separator], no MenuID and no text
MenuStatus(8).strHelpMsg = "Close current Window"
MenuStatus(9).strHelpMsg = "[separator]" '[separator], no MenuID and no text
MenuStatus(10).strHelpMsg = "Switch to different task"
MenuStatus(11).strHelpMsg = "<Main Form Menu>"
MenuStatus(12).strHelpMsg = "<File Menu>"
MenuStatus(13).strHelpMsg = "Exit the program"
MenuStatus(14).strHelpMsg = "<Edit Menu>"
MenuStatus(15).strHelpMsg = "Cut selected text from document"
MenuStatus(16).strHelpMsg = "Copy selected text to clipboard"
MenuStatus(17).strHelpMsg = "Paste clipboard text into document"
MenuStatus(18).strHelpMsg = "Main Submenu text"
MenuStatus(19).strHelpMsg = "Submenu1 text message"
MenuStatus(20).strHelpMsg = "Submenu2 text message"
End Sub
Sub MenuSetup (hMenu As Integer)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' PURPOSE: Save the menu item ID information into the passed array
' COMMENTS: MenuSetup() is called recursively to load sub-menus
' NOTES: 1. The MenuStatus array size must be equal to or great than the total
' number of menu items in the form, or else a bounds error will occur.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim nItemCount As Integer
Dim lMenuID, lMenu As Long
Dim nItemPos As Integer
Dim nResult As Integer
Dim nMenuID As Integer
Static nElement As Integer ' Static for pointer locating the last element inserted
Debug.Print "New hMenu = "; Hex$(hMenu)
Debug.Print
nItemPos = 0
nElement = nElement + 1
'
'
' store the top most menu
If hMenu < -1 Then
'change Menu ID to a faked USHORT
lMenu = hMenu + 65536
Else
lMenu = hMenu
End If
MenuStatus(nElement).lhMenu = lMenu
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' IMPORTANT NOTE:
' Store the hMenu in the menuID spot as a FLAG
' The MenuID returned from Clacker WILL NOT MATCH THIS
' Clacker will return the real top level hMenu from windows.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
lMenuID = hMenu
MenuStatus(nElement).lMenuID = lMenuID
Debug.Print "nItemPos = "; nItemPos
Debug.Print "nElement = "; nElement
Debug.Print "MenuStatus(nElement).nMenuID = "; Hex$(MenuStatus(nElement).lMenuID)
Debug.Print "MenuStatus(nElement).lhMenu = "; Hex$(MenuStatus(nElement).lhMenu)
Debug.Print
nItemCount = GetMenuItemCount(hMenu)
For nItemPos = 0 To nItemCount - 1
' Enumerate all sub-menus
' each sub menu starts at zero
' the menu id for this position
nMenuID = GetMenuItemID(hMenu, nItemPos)
If nMenuID = -1 Then
'
' if the first item is -1
' it's a submenu ( cascade menu )
nMenuID = GetSubMenu(hMenu, nItemPos)
'
' since it is a submenu need to
' call this function recursively
Debug.Print "Recurse"
MenuSetup nMenuID
Else
'
'normal menu item, save the menu item ID
'
' bump the position so we start at 2,
' after the first hMenu is added
nElement = nElement + 1
' Menu ID is a USHORT type, but VB has none so,
' change Menu ID to unsigned short as required for saving
' and later matching the return value from Clacker
If nMenuID < -1 Then
'change Menu ID to a faked USHORT
lMenuID = nMenuID + 65536
Else
lMenuID = nMenuID
End If
'
' Put a menu item in the array
MenuStatus(nElement).lMenuID = lMenuID
MenuStatus(nElement).lhMenu = hMenu
Debug.Print "nItemPos = "; nItemPos
Debug.Print "nElement = "; nElement
Debug.Print "MenuStatus(nElement).nMenuID = "; Hex$(MenuStatus(nElement).lMenuID)
Debug.Print "MenuStatus(nElement).lhMenu = "; Hex$(MenuStatus(nElement).lhMenu)
Debug.Print
End If
Next
End Sub
Sub mnu_Exit_Click ()
'
' process cannot terminate with menus still hooked to dll
Clacker1.hwndForm = Me.hWnd
Clacker1.Action = CLACKER_STOP
End
End Sub