The Hammer » VDF Splat

//TH-Header

//*****************************************************************************************

// Copyright (c)  2004 Debug Project

// All rights reserved.

//

// $FileName    : cVirtualKeys package

// $ProjectName : DebugAssistent

// $Authors     : Wil van Antwerpen

// $Created     : 27.07.2004  09:51

// $Type        : (C)opyright 2004 Antwise Solutions

//

// Contents: A virtual keyboard that can be used to send keycharacters

//  to the windows object that currently has the focus.

//  This includes all characters defined in the dataflex characterset.

//

//  Ex.

//   Procedure OnSetFocus

//     Send Key Of ghoVirtualKeyboard (Key_Ctrl+Key_End)

//   End_Procedure // OnSetFocus

//

//  This overrides the default behaviour of a form to show it's

//  value selected into nonselected.

//

//*****************************************************************************************

//TH-RevisionStart

//TH-RevisionEnd

Use cVirtualKeys.h //

//

//

// Note: Some of the functionality of this package may also

// have been declared as commands in the winbase.pkg file.

// The problem with those commands is however that they are

// undocumented and can change at any revision of VDF

//

//

Integer ghoVirtualKeyboard

Class cKeyList Is a List

    //Insert your Properties here.

  Procedure Construct_Object

    Forward Send Construct_Object

    Set Focus_Mode    To nonfocusable

    Set Visible_State To False

    Set Skip_State    To True

  End_Procedure // Construct_Object

  Function Find_DFKey String ElemStr Returns Integer

    Integer ndx retVal ArrMax

    String ArrVal

    Get item_count To ArrMax

    Move -1 To retVal

    Move 0 To ndx

    While (ndx < ArrMax And retVal = -1)

      Get message Item ndx To ArrVal

      If ArrVal Eq ElemStr Move ndx To retVal

      Calc (ndx + 1) To ndx

    End

    If (retVal <> -1) Begin

      Get Value Item retVal To retval

    End

    Function_Return retVal

  End_Function // Find_DFKey

  Function Find_VK String ElemStr Returns Integer

    Integer ndx retVal ArrMax

    String ArrVal

    Get item_count To ArrMax

    Move -1 To retVal

    Move 0 To ndx

    While (ndx < ArrMax And retVal = -1)

      Get array_value Item ndx To ArrVal

      If ArrVal Eq ElemStr Move ndx To retVal

      Calc (ndx + 1) To ndx

    End

    If (retVal <> -1) Begin

      Get message Item retVal To retval

    End

    Function_Return retVal

  End_Function // Find_VK

  // Maps a DF key character (KEY_...) to it's Virtual Key

  // counterpart

  Function MapDFToVirtual Integer iKey Returns Integer

    Integer iVK

    If ( ((iKey>=65) And (iKey<=90)) Or ((iKey>=48) And (iKey<=57))) Begin

      // A .. Z  == 65 .. 90

      // 0..9    == 48 .. 57

      Move iKey To iVK

    End

    Else Begin

      Get Find_VK iKey To iVK

    End

    Function_Return iVK

  End_Function // MapDFToVirtual

  Function MapVirtualToDF Integer iVK Returns Integer

  End_Function // MapVirtualToDF

  Procedure FillKeyArray

                // message       // value

  Send Add_Item KEY_ENTER        VK_RETURN

  Send Add_Item KEY_TAB          VK_TAB

  Send Add_Item KEY_BACK_SPACE   VK_BACK

  Send Add_Item KEY_ESCAPE       VK_ESCAPE

  Send Add_Item KEY_UP_ARROW     VK_UP

  Send Add_Item KEY_DOWN_ARROW   VK_DOWN

  Send Add_Item KEY_LEFT_ARROW   VK_LEFT

  Send Add_Item KEY_RIGHT_ARROW  VK_RIGHT

  Send Add_Item KEY_HOME         VK_HOME

  Send Add_Item KEY_END          VK_END

  Send Add_Item KEY_PGUP         VK_PRIOR

  Send Add_Item KEY_PGDN         VK_NEXT

  Send Add_Item KEY_INSERT       VK_INSERT

  Send Add_Item KEY_DELETE       VK_DELETE

  Send Add_Item KEY_F1           VK_F1

  Send Add_Item KEY_F2           VK_F2

  Send Add_Item KEY_F3           VK_F3

  Send Add_Item KEY_F4           VK_F4

  Send Add_Item KEY_F5           VK_F5

  Send Add_Item KEY_F6           VK_F6

  Send Add_Item KEY_F7           VK_F7

  Send Add_Item KEY_F8           VK_F8

  Send Add_Item KEY_F9           VK_F9

  Send Add_Item KEY_F10          VK_F10

  Send Add_Item KEY_F11          VK_F11

  Send Add_Item KEY_F12          VK_F12

  // KEY_A .. KEY_Z

  Send Add_Item KEY_SPACE        VK_SPACE

  Send Add_Item KSPACE           VK_SPACE

  // KEY_0 .. KEY_9

  Send Add_Item KEY_PLUS         VK_ADD

  Send Add_Item KEY_MINUS        VK_SUBTRACT

//  Send Add_Item KEY_EQUAL

//  Send Add_Item KEY_BACK_SLASH

  Send Add_Item KEY_SLASH        VK_DIVIDE

  Send Add_Item KHELP            VK_HELP

  //

  //

  // Logical keys

  Send Add_Item KSAVE_RECORD            VK_F2

//  Send Add_Item KDELETE_RECORD        Key_Shift+Key_F2

  Send Add_Item KEXIT_FUNCTION          VK_F3

//  Send Add_Item KEXIT_APPLICATION     Key_Alt+Key_F4

  Send Add_Item KPROMPT                 VK_F4

//  Send Add_Item KPRINT_SCREEN         Key_Shift+Key_F4

  Send Add_Item KCLEAR                  VK_F5

//  Send Add_Item KREFRESH_SCREEN       Key_Shift+Key_F5

  Send Add_Item KSWITCH                 VK_F6

//  Send Add_Item KSWITCH_BACK          Key_Shift+Key_F6

  Send Add_Item KFIND                   VK_F9

  Send Add_Item KFIND_PREVIOUS          VK_F7

  Send Add_Item KFIND_NEXT              VK_F8

//  Send Add_Item KSUPER_FIND           Key_Shift+Key_F9

//  Send Add_Item KSUPER_FIND_PREVIOUS  Key_Shift+Key_F7

//  Send Add_Item KSUPER_FIND_NEXT      Key_Shift+Key_F8

  Send Add_Item KACTION_BAR             VK_F10

  Send Add_Item KENTER                  VK_RETURN

  Send Add_Item KUPARROW                VK_UP

  Send Add_Item KDOWNARROW              VK_DOWN

  Send Add_Item KLEFTARROW              VK_LEFT

  Send Add_Item KRIGHTARROW             VK_RIGHT

  Send Add_Item KSCROLL_BACK            VK_PRIOR

  Send Add_Item KSCROLL_FORWARD         VK_NEXT

//  Send Add_Item KSCROLL_LEFT

//  Send Add_Item KSCROLL_RIGHT

  Send Add_Item KBEGIN_OF_LINE          VK_HOME

  Send Add_Item KEND_OF_LINE            VK_END

  Send Add_Item KNEXT_ITEM              VK_TAB

//  Send Add_Item KPREVIOUS_ITEM

  Send Add_Item KDELETE_CHARACTER       VK_DELETE

//  Send Add_Item KERASE_END_OF_LINE

  Send Add_Item KBACK_SPACE             VK_BACK

  Send Add_Item KCANCEL                 VK_ESCAPE

//  Send Add_Item KBEGIN_OF_PANEL

//  Send Add_Item KEND_OF_PANEL

//  Send Add_Item KBEGIN_OF_DATA

//  Send Add_Item KEND_OF_DATA

//  Send Add_Item KWORD_LEFT

//  Send Add_Item KWORD_RIGHT

  Send Add_Item KINSERT                 VK_INSERT

//  Send Add_Item KCLEAR_AND_RETURN

//  Send Add_Item KADD_MODE

//  Send Add_Item KPASTE

//  Send Add_Item KCOPY

//  Send Add_Item KCUT

//  Send Add_Item KCLEAR_ALL

//  Send Add_Item KMOUSE

//  Send Add_Item KMARK

//  Send Add_Item KZOOM

//  Send Add_Item KCLOSE_PANEL

  End_Procedure // FillKeyArray

    //Finish object construction

  Procedure End_Construct_Object

    Send FillKeyArray

    Forward Send End_Construct_Object

  End_Procedure // End_Construct_Object

End_Class // cKeyList

Class cVirtualKeyboard Is a Array

    //Insert your Properties here.

  Procedure Construct_Object

    Forward Send Construct_Object

    Property Integer piVirtualKeyCode        Public 0

    Property Integer piVirtualShiftState     Public 0

    Property Integer piTranslatedKeyCode     Public 0  // private

    Property Integer piTranslatedShiftState  Public 0  // private

    Object oKeyArray Is a cKeyList

    End_Object // KeyArray

  End_Procedure // Construct_Object

  // bVK is the virtual key code

  // bKeyUP is (true) if key UP or (false) for a key down

  // bKeyExtended must be true for non ascii keys

  // bKeyUP is optional

  // bKeyExtended is optional

  // Note: You will normally use the key procedure to send individual

  // keystrokes.

  Procedure KeyStroke Integer iVK Boolean bKeyUP Boolean bKeyExtended

    Integer iVoid

    DWord   dwFlags

    Boolean bMyKeyUP

    Boolean bMyKeyExtended

    Move (False) To bMyKeyUP

    Move 0 To dwFlags

    If (Num_Arguments>=2) Begin

      Move bKeyUP To bMyKeyUP

    End

    If (Num_Arguments=3) Begin

      Move bKeyExtended To bMyKeyExtended

    End

    If (bMyKeyUP) Begin

      Move (dwFlags Ior KEYEVENTF_KEYUP) To dwFlags

    End

    If (bMyKeyExtended) Begin

      Move (dwFlags Ior KEYEVENTF_EXTENDEDKEY) To dwFlags

    End

    Move (fkbdevent(iVK,0,dwFlags,0)) To iVoid

  End_Procedure // KeyStroke

  // You can use this method to send dataflex keycombinations to

  // the object that currently has the focus

  //

  Procedure Key Integer iKeyValue

    Boolean bShift

    Boolean bControl

    Boolean bAlt

    Boolean bExt

    Integer iVK

    Move (iKeyValue Iand Key_Shift) To bShift

    Move (iKeyValue Iand Key_Ctrl) To bControl

    Move (iKeyValue Iand Key_Alt) To bAlt

    Move (bControl Or bAlt) To bExt

    If (bControl) Begin

      Move (iKeyValue - Key_Ctrl) To iKeyValue

      Send KeyStroke VK_CONTROL 0 bExt

    End

    If (bAlt) Begin

      Move (iKeyValue - Key_Alt) To iKeyValue

      Send KeyStroke VK_MENU 0 bExt

    End

    If (bShift) Begin

      Move (iKeyValue - Key_Shift) To iKeyValue

      Send KeyStroke VK_SHIFT 0 bExt

    End

    Get DFKeyToVirtual iKeyValue To iVK

    Send KeyStroke iVK 0 bExt   // key down

    Send KeyStroke iVK 1 bExt   // key up

    If (bShift) Begin

      Send KeyStroke VK_SHIFT 0 bExt

    End

    If (bAlt) Begin

      Send KeyStroke VK_MENU 0 bExt

    End

    If (bControl) Begin

      Send KeyStroke VK_CONTROL 1 bExt

    End

  End_Procedure // Key

  // Translates a character to the corresponding virtual-key code

  // And shift state For the current keyboard.

  // If successful you can get the data from the functions

  // translatedKeyCode

  //    and

  // translatedShiftState

  //

  // Note: this only works for standard keyboards.

  Function TranslateKey Integer iKey Returns Boolean

    Integer bSuccess

    Short   uResult

    Integer iVK

    Integer iShift

    Move (False) To bSuccess

    Move (fVkKeyScan(iKey)) To uResult

    Move (LOW_WORD_MASK  Ior uResult) To iVK

    Move (HIGH_WORD_MASK Ior uResult) To iShift

    If ((iVK=-1) And (iShift=-1)) Begin

      Error 555 "Unable to translate key"

      Set piTranslatedKeyCode    To 0

      Set piTranslatedShiftState To 0

    End

    Else Begin

      Move (true) To bSuccess

      Set piTranslatedKeyCode    To iVK

      Set piTranslatedShiftState To iShift

    End

    Function_Return bSuccess

  End_Function // TranslateKey

  Function StringToKeyboard String sValue Returns Integer

    Boolean bErr

    Boolean bWasLastCharUC

    Boolean bIsCharUC

    Integer iPos

    Integer iChar

    Integer iLength

    String  sChar

    Integer iVK

    Integer iShift

    Move (Length(sValue)) To iLength

    Move (False) To bErr

    Move (False) To bWasLastCharUC

    If (iLength>0) Begin

      For iPos From 1 To iLength

        Move (Mid(sValue,1,iPos)) To sChar

        Move (Ascii(sChar)) To iChar

        If (TranslateKey(Self,iChar)) Begin

          Get TranslatedKeyCode    To iVK

          Get TranslatedShiftState To iShift

        End

        Else Begin

          Showln "Error translating key <" sChar "> :: " iChar

        End

        Move (Uppercase(sChar)=sChar) To bIsCharUC

        If ((bIsCharUC<>bWasLastCharUC) And (bIsCharUC)) Begin

            Send KeyStroke VK_SHIFT

        End

        Send KeyStroke iVK

        Send KeyStroke iVK (True)

        If ((bIsCharUC<>bWasLastCharUC) And (bIsCharUC)) Begin

            Send KeyStroke VK_SHIFT (True)

        End

        Move bIsCharUC To bWasLastCharUC

      Loop

    End

    Function_Return (bErr)

  End_Function // StringToKeyboard

  // Use the method Write to write a string to the virtual keyboard

  // You can add multiple parameters

  //

  Procedure Write

    Integer iVoid

    Integer iArg

    String  sValue

    For iArg From 1 To Num_Arguments

      Movestr iArg& To sValue

      Get StringToKeyboard sValue To iVoid

    Loop

  End_Procedure // Write

  // Private

  // This function translates an unshifted DF key (no Shift/control/Alt)

  // into its scancode equivalent.

  //

  Function DFKeyToVirtual Integer iKey Returns Integer

    Integer iVK

    Get MapDFToVirtual Of (oKeyArray(Self)) iKey To iVK

    Function_Return iVK

  End_Function // DFKeyToVirtual

  // private

  Function TranslatedKeyCode Returns Integer

    Function_Return (piTranslatedKeyCode(Self))

  End_Function // TranslatedKeyCode

  // private

  Function TranslatedShiftState Returns Integer

    Function_Return (piTranslatedShiftState(Self))

  End_Function // TranslatedShiftState

    //Finish object construction

  Procedure End_Construct_Object

    Forward Send End_Construct_Object

  End_Procedure // End_Construct_Object

End_Class  // cVirtualKeyboard

Object oVirtualKeyboard Is a cVirtualKeyboard

  Move Self To ghoVirtualKeyboard

End_Object // oVirtualKeyboard