Use Windows.pkg
Use DFClient.pkg
Use Winbase.pkg

Class cAcceleratorKeyMixin Is A Mixin
    //****************************************************************************
    // $Module name: DefineAccKeyProperties
    // $Author     : VO
    // Created     : 15-09-96 @ 16:33
    //
    // Description
    //  Add two properties to the object.
    //  1. phoKeyDestination: We can store the accelerator key destination object
    //     in this property. If not assigned by yourself the key destination (the
    //     on_key location) will be the parent object.
    //  2. piKeyModifier: Default is the Key_Ctrl plus your underlined character
    //     but you can also store key_alt or key_shift in the property. Note that
    //     a menubar overrides a key_alt+<char> combination if present.
    //
    // $Rev History
    //  15-09-96 Module header created
    //****************************************************************************
    Procedure DefineAccKeyProperties
        Property Handle phoKeyDestination (Parent (Self))
        Property Integer piKeyModifier Key_Ctrl
    End_Procedure
    
    //****************************************************************************
    // $Module name: AcceleratorKeyDef
    // $Author     : VO
    // Created     : 24-05-07 @ 14:33
    //
    // Description
    //  This method will find the underlined key in the value of the button (the
    //  label). If present a keymapping based on the keymodifier (usually 
    //  key_ctrl) and the underlined character will be formed. If possible - the
    //  key exists - the key id will be returned in the byref variable. The message
    //  property value will be returned as the message to be send. Finally the 
    //  aux_value property is read and returned. If the latter one is 0 the current
    //  object ID will be used instead.
    //
    //  The function returns true when the function could create a key mapping.
    //
    // $Rev History
    //  24-05-07 Module header created
    //****************************************************************************
    Function AcceleratorKeyDef Integer BYREF iKey Integer BYREF iMsg Handle BYREF hoDestination Returns Boolean
        String sItemValue sKeyChar
        Integer iKeyChar iKeyModifier iPos
        Boolean bSuccess
    
        Get Value To sItemValue
        Move (Pos ("&", sItemValue)) To iPos
        If (iPos > 0) Begin
            Move (Uppercase ("KEY_" - Mid (sItemValue, 1, iPos + 1))) To sKeyChar
            Move (Eval (sKeyChar)) To iKeyChar
            If (iKeyChar > 0) Begin
                Get piKeyModifier To iKeyModifier
                Move (iKeyModifier + iKeyChar) To iKey
                Get Message To iMsg
                Get Aux_Value To hoDestination
                If (hoDestination = 0) Begin
                    Move Self To hoDestination
                End
                Move True To bSuccess
            End
        End
        
        Function_Return bSuccess
    End_Function
    
    //****************************************************************************
    // $Module name: AssignAcceleratorKey
    // $Author     : VO
    // Created     : 15-09-96 @ 16:33
    //
    // Description
    //  This method construct a keymapping (via AccelatorKeyDef) and if sucessful
    //  the key mapping will be added or removed from the key destination object.
    //  The trick in this routine is that a part of the code is executed as if
    //  the code was part of the key destination object.
    //
    // $Rev History
    //  15-09-96 Module header created
    //****************************************************************************
    Procedure AssignAcceleratorKey Boolean bRemove
        Integer iKey iMsg
        Boolean bKeyDefined
        Handle hoDestination hoSelf hoKeyDestination
    
        Get AcceleratorKeyDef (&iKey) (&iMsg) (&hoDestination) To bKeyDefined
        If (bKeyDefined) Begin
            Get phoKeyDestination To hoKeyDestination
            If (hoKeyDestination > 0) Begin
                Move Self To hoSelf
                Move hoKeyDestination To Self
                If (bRemove) Begin
                    On_Key iKey Send Default_Key Of hoDestination                
                End
                Else Begin
                    On_Key iKey Send iMsg Of hoDestination
                End
                Move hoSelf To Self
            End
        End
    End_Procedure
    
    //****************************************************************************
    // $Module name: Set Label
    // $Author     : VO
    // Created     : 15-09-96 @ 16:33
    //
    // Description
    //  This method is augmented to assign an accelerator key for execution of
    //  the object's message.
    //
    // $Rev History
    //  15-09-96 Module header created
    //****************************************************************************
    Procedure Set Label String sLabelText
        Forward Send End_Construct_Object
    
        Send AssignAcceleratorKey True
        Forward Set Label To sLabelText
        Send AssignAcceleratorKey False
    End_Procedure
End_Class

Class cMyButton Is A Button
    Import_Class_Protocol cAcceleratorKeyMixin
    
    //****************************************************************************
    // $Module name: Construct_Object
    // $Author     : VO
    // Created     : 15-09-96 @ 16:33
    //
    // Description
    //  Send a message to define extra properties.
    //
    // $Rev History
    //  15-09-96 Module header created
    //****************************************************************************
    Procedure Construct_Object
        Forward Send Construct_Object
        
        Send DefineAccKeyProperties
    End_Procedure    
End_Class

Deferred_View Activate_oTestacckey for ;
Object oTestacckey is a dbView

    Set Border_Style to Border_Thick
    Set Size to 200 300
    Set Location to 2 2
    
    Object oTestButton is a cMyButton
        Set Location to 11 11
        Set Size To 14 70
        Set Label to "&Test Key"
        
        Procedure OnClick
            Send Info_Box "Message Fired"
        End_Procedure    
    End_Object

    Object oReassingButton is a Button
        Set Location to 29 11
        Set Size To 14 70
        Set Label to "Reassign"
    
        Procedure OnClick
            Set Label Of oTestButton To "&Reassigned Test"
        End_Procedure    
    End_Object

CD_End_Object