Programmer 7500/MAX_PROGRAMMERS.iso/VISUAL_B/CODIGO_1/CLAK20/GENERAPP.FRM

Visual Basic Form | 1993-12-23 | 12.8 KB | 327 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
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