home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Programming Tool Box
/
SIMS_2.iso
/
vb_code1
/
clak20
/
generapp.frm
< prev
next >
Wrap
Text File
|
1993-12-23
|
13KB
|
393 lines
VERSION 2.00
Begin Form Clacker_Form
Caption = "Clacker Test"
ClientHeight = 4860
ClientLeft = 1215
ClientTop = 1785
ClientWidth = 5055
Height = 5550
Left = 1155
LinkTopic = "Form1"
ScaleHeight = 4860
ScaleWidth = 5055
Top = 1155
Width = 5175
Begin Clack Clacker1
hwndForm = 0
Left = 360
SystemMenu = -1 'True
Top = 240
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"
HelpContextID = 9
Begin Menu mnu_Exit
Caption = "&Exit"
HelpContextID = 1
End
End
Begin Menu mnu_Edit
Caption = "&Edit"
HelpContextID = 2
Begin Menu mnu_Cut
Caption = "Cu&t"
HelpContextID = 3
End
Begin Menu mnu_Copy
Caption = "&Copy"
HelpContextID = 4
End
Begin Menu mnu_Paste
Caption = "&Paste"
HelpContextID = 5
End
Begin Menu mnu_submenu
Caption = "SubMenu"
HelpContextID = 6
Begin Menu mnu_submenu1
Caption = "SubMenu 1"
HelpContextID = 7
End
Begin Menu mnu_submenu2
Caption = "SubMenu 2"
HelpContextID = 8
End
End
End
End
Option Explicit
Const CLACKER_START = 1
Const CLACKER_STOP = 2
Dim CRLF As String
Dim MenuStatus(1 To 25) As HelpTextType '' help string array
Dim LocalMenuIDArray() As Long '' local menu ID array
Sub BTN_Exit_Click ()
'' user initiated exit
mnu_Exit_Click
End Sub
Sub Btn_Hook_Click ()
'' PURPOSE: Hook up the menu to CLACKER.VBX
'' COMMENTS: Each form with a menu to monitor
'' should have a similar statement block
'''''''''''''''''''''''''''''''''''''''''''''''''''
'' set the HWND of this form
Clacker1.hwndForm = Me.hWnd
'' issue the action command
Clacker1.Action = CLACKER_START ''1
'' put up some status info
TXT_MID.Text = "Menu ID, menu hooked"
End Sub
Sub Btn_UnHook_Click ()
'' user initiated unhook command
'' unhook the menu
Clacker1.Action = CLACKER_STOP ''2
'' some status text
TXT_MID.Text = "Menu Unhooked"
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.
' Parametrs returned are:
' hMenu the menu handle
' MenuID the resource ID of the menu ( actually a Unsigned Integer )
' MenuCaption the menu caption text
' 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, separators and those menu items 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.
' 5. How to get to the status text...
' Make a text array with the text strings you want to use for each menu item
' Use the ndex value as a position of the match to fetch the text string.
' 6. Break Points in this Sub suspends execution in a menu call so the VB menus
' will be disabled until the Sub exits. Use Debug.Print statements instead
' of break points to debug you code.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Msg As String
Dim ndex As Integer
Dim lMenuID As Long
'' for diagnostic use to show what is going on
'' put up data we start with
Msg = "Returned MenuID = " + Str$(MenuID) + Chr$(13) + Chr$(10)
Msg = Msg + "Returned hMenu = " + Str$(hMenu) + Chr$(13) + Chr$(10)
Msg = Msg + "MenuCaption = " + MenuCaption + Chr$(13) + Chr$(10)
Debug.Print Msg
''
''
'' VB has no unsigned integer data type so .... this
'' conversion is necessary before using the MenuID returned
''
'' change the MenuID to a USHORT if required
'' this is to pick up the system menu items
If MenuID < -1 Then
lMenuID = MenuID + 65536
Else
lMenuID = MenuID
End If
'' end conversion code
'' find a matching value
For ndex = 1 To UBound(LocalMenuIDArray)
If LocalMenuIDArray(ndex) = lMenuID Then
'' found the matching MenuID that was stored in our local array
''
''
'' this is to just put up some diagnostic text
Msg = "MenuID = " + Str$(MenuID) + Chr$(13) + Chr$(10)
Msg = Msg + "hMenu = " + Str$(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
Debug.Print "LocalMenuIDArray(ndex) = "; LocalMenuIDArray(ndex)
''
'' leave the loop with ndex pointing
'' to the desired text string position
Exit For
End If
'' for diagnostic use to show what is going on...
'' if we fail to find a match we put this up each
'' time to just do something interesting here
TXT_MID.Text = "No Match"
Next
'' for diagnostic use to show what is going on
'' put up where we found a match
Debug.Print "ndex = "; ndex
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' at this point ndex is the position of our desired text string.
'' use ndex to get to the text and place it in the status box.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub
Sub Clacker1_ClearStatusClick ()
'' PURPOSE: Event returned by CLACKER.VBX
''COMMENTS: Event is returned when a menu item is
'' actually selected by the user.
'' USEAGE: Clear the status line of text if desired
''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Msg As String
Msg = "Illustrates the clear function for the staus text." + CRLF
Msg = Msg + "You would normally just output a blank line" + CRLF
Msg = Msg + "when a menu command is actually executed."
TXT_MID.Text = Msg
End Sub
Sub Clacker1_RefreshHwndClick (MenuItemCount As Integer)
'' PURPOSE: Event returned by CLACKER.VBX
''COMMENTS: Event is returned in response to the CLACKER.VBX
'' being issued the command "Clacker1.RefreshHwnd = [HWND]
'' USEAGE: Load the local array from the CLACKER.VBX control
'' with the menu IDs of all menu items associated
'' with the hwnd sent.
''
'' This local array is then used for finding the position of the
'' status text to display.
''
'' The MenuID returned in the array is the same as the MenuID parameter
'' returned in the ClackerClick() event
''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ndex As Integer
Dim Msg As String
'' A return value of 0 indicates the menu was not found
'' or the hwnd passed was no good
If (MenuItemCount = 0) Then
' just for debugging, don't use in final apps
MsgBox "MenuItemCount = 0"
Exit Sub
Else
Debug.Print ""
Debug.Print "MenuItemCount = "; MenuItemCount
End If
'' set the array size to MenuItemCount
ReDim LocalMenuIDArray(1 To MenuItemCount)
'' fill the array
For ndex = 1 To MenuItemCount
'' move the data to the loacal array
LocalMenuIDArray(ndex) = Clacker1.MenuIDArray(ndex)
'' for diagnostic use to show what is going on
'' put up data we stored
Debug.Print "LocalMenuIDArray(" + Str$(ndex) + ") = "; Str$(Clacker1.MenuIDArray(ndex))
Next ndex
End Sub
Sub Form_Load ()
Dim hSysMenu As Integer
Dim hMainMenu As Integer
Dim Msg As String
Dim ndex As Integer
'' first load the global constant
CRLF = Chr$(13) + Chr$(10)
If Me.WindowState = 0 Then
Top = 0
Left = 0
End If
'' fill the local array
Clacker1.RefreshHwnd = Me.hWnd
''
'' The array is filled and the event
'' Clacker1_RefreshHwndClick (MenuItemCount As Integer)
'' is used to transfer the values into the LocalHwndArray[]
''
''
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)
'' good programming practice to clean up
'' unhook the menu
Clacker1.Action = CLACKER_STOP ''2
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 mnu_Exit_Click ()
'
' process should not terminate with menus still hooked in dll
Clacker1.Action = CLACKER_STOP ''2
End
End Sub