[ 1 ] [ 2 ] [ 3 ] [ 4 ] 

*---------------------------------------------

*-- Sample for Hook Operation design pattern

*-- Copyright 1997 by Steven Black

*-- Version 1.0 May 22 1997

*---------------------------------------------

 

*-- Create a hookable form

oForm= CREATE("Frm")

 

*-- Describe what the user should do

oForm.Caption= "RightClick around to execute hooks"

 

*-- add a hookable textbox

oForm.Addobject("txt", "Txt")

 

*-- add a hookable combobox

oForm.Addobject("Cbo", "Cbo")

oForm.Cbo.Top= 30

 

*-- add dropdown and interactivechange behavior to

*-- combobox by using hooks

LOCAL loTemp

loTemp= CREATE("DropDown")

oForm.Cbo.SetoHook( loTemp)

loTemp= CREATE("Interactivechange")

oForm.Cbo.SetoHook( loTemp)

RELEASE loTemp

oForm.Cbo.ToolTipText="Make a selection to execute hooks"

oForm.Cbo.StatusBarText="Make a selection to execute hooks"

 

*-- Give all controls the Form's Right-click behavior

oForm.txt.SetoHook( oForm)

oForm.cbo.SetoHook( oForm)

 

*-- add a general shared debug utility object

oForm.Addobject( "Debug", "DebugMenuHook")

oForm.Debug.Top= 60

 

*-- Give all controls the debug menu behavior

*-- (via form, which is already in the hook chain)

oForm.SetoHook( oForm.Debug)

 

*-- Show the works, though you wouldn't normally

*-- make the debug hook object visible

oForm.Setall("Visible", .T.)

oForm.Show()

READ EVENTS

 

**************************************************

* Abstract Hook Behavior Class

**************************************************

*-- Class:        abstracthook

*-- ParentClass:  label

*-- BaseClass:    label

*-- Baseclass for hooks

*

DEFINE CLASS abstracthook AS label

  Caption = "Hook"

  ohook = .NULL.

  width= 150

  BackColor= RGB(0,255,0)

  Name = "abstracthook"

 

  PROCEDURE Init

    *-- Say something smart

    THIS.Caption= THIS.Class

  ENDPROC

 

  PROCEDURE release

    *-- Release from memory.

    RELEASE THIS

  ENDPROC

 

  PROCEDURE GarbageCollect

    *-- Clean up pointers

    THIS.oHook= .NULL.

  ENDPROC

 

  *=== Hooked Events and Methods ====

  * SetoHook( o)

  * RightClick()

  * PopUpMenu()

  * InteractiveChange()

  * DropDown()

 

  PROCEDURE setohook

    *-- Automate the hook setting process. If a hook

    *-- already exists, hook to it, thus adding to the

    *-- hook chain.

    PARAMETERS toPassed

    IF TYPE( "THIS.oHook")= "O" AND ;

      PEMSTATUS( THIS.oHook, "oHook", 5)

      THIS.oHook.SetoHook( toPassed)

    ELSE

      THIS.oHook= toPassed

    ENDIF

  ENDPROC

 

  PROCEDURE RightClick

    IF TYPE( "THIS.oHook")= "O" AND ;

      PEMSTATUS( THIS.oHook, "RightClick", 5)

     

      THIS.oHook.RightClick

    ENDIF

    RELEASE POPUPS Shortcut

    DEFINE POPUP shortcut SHORTCUT RELATIVE FROM MROW(),MCOL()

   

    THIS.PopupMenu()

    IF CNTBAR( "Shortcut") > 0

      ACTIVATE POPUP Shortcut

    ENDIF

  ENDPROC

 

  PROCEDURE popupmenu

    *-- Delegate to the implementation chain

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "PopUpMenu", 5)

       RETURN THIS.oHook.PopupMenu()

    ENDIF

  ENDPROC

 

  *-- Occurs when the user changes the value of a

  *-- control using the keyboard or the mouse.

  PROCEDURE interactivechange

    *-- Delegate to the implementation chain

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "InteractiveChange", 5)

       RETURN THIS.oHook.InteractiveChange()

    ENDIF

  ENDPROC

 

  *-- Occurs when the list portion of a ComboBox

  *-- control is about to drop down after the drop-down ;

  *-- arrow is clicked.

  PROCEDURE dropdown

    *-- Delegate to the implementation chain

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "DropDown", 5)

       RETURN THIS.oHook.DropDown()

    ENDIF

  ENDPROC

ENDDEFINE

 

**************************************************

* Developer's Debug Menu Behavior (partial)

**************************************************

*-- Class:        debugmenuhook

*-- ParentClass:  abstracthook

*-- BaseClass:    label

*-- Hook that produces debug choices in the

*-- current shortcut menu

*

DEFINE CLASS debugmenuhook AS abstracthook

  Name = "debugmenuhook"

  PROCEDURE popupmenu

    DoDefault()

    DEFINE BAR 1001 OF shortcut PROMPT "\-"

    DEFINE BAR 1002 OF shortcut PROMPT "Debug" ;

      MESSAGE "Invokes the debug window"

    DEFINE BAR 1003 OF shortcut PROMPT "\<Trace" ;

      MESSAGE "Invokes the trace window"

    DEFINE BAR 1004 OF shortcut PROMPT "\<Cancel" ;

      MESSAGE "Cancel execution"

    DEFINE BAR 1005 OF shortcut PROMPT "\<Suspend" ;

      MESSAGE "Suspend execution"

  ENDPROC

ENDDEFINE

 

**************************************************

* Drop Down Behavior

**************************************************

*-- Class:        DropDown

*-- ParentClass:  abstracthook

*-- BaseClass:    label

*-- Hook implementing dropdown eventbehavioor

*

DEFINE CLASS DropDown AS abstracthook

  noldbackcolor = 0

  Name = "DropDown"

 

  PROCEDURE Destroy

    _SCREEN.BackColor= THIS.nOldBackColor

  ENDPROC

 

  PROCEDURE Init

    DODEFAULT()

    THIS.nOldBackColor= _SCREEN.BackColor

  ENDPROC

 

  PROCEDURE dropdown

    _SCREEN.BackColor= RAND()*255^3

  ENDPROC

ENDDEFINE

 

**************************************************

* Interactive Change Behavior

**************************************************

*-- Class:        Interactivechange

*-- ParentClass:  abstracthook

*-- BaseClass:    label

*-- Hook implementing interactivechange behavior

*

DEFINE CLASS Interactivechange AS abstracthook

  Name = "Interactivechange"

 

  PROCEDURE interactivechange

    DoDefault()

    ACTIVATE SCREEN

    ?"Interactive Change Fires"

  ENDPROC

ENDDEFINE

 

**************************************************

* Hookable Combobox

**************************************************

*-- Class:        cbo

*-- ParentClass:  combobox

*-- BaseClass:    combobox

*

DEFINE CLASS cbo AS combobox

  Height = 23

  Width = 200

  *-- Hook reference

  ohook = .NULL.

  Name = "cbo"

 

  PROCEDURE Init

    THIS.AddItem( "FoxTeach")

    THIS.AddItem( "Great Lakes GREAT Database Workshop")

    THIS.AddItem( "Minneapolis User's Confernence")

    THIS.AddItem( "Devcon")

    THIS.AddItem( "German FoxPro User's Conference")

    THIS.AddItem( "Dutch FoxPro User's Conference")

    THIS.AddItem( "Mid-Atlantic FoxPro Conference")

  ENDPROC

 

  PROCEDURE GarbageCollect

    *-- Clean up pointers 

    THIS.oHook= .NULL.

  ENDPROC

 

  *-- Releases from memory.

  PROCEDURE release

    RELEASE THIS

  ENDPROC

 

  *=== Hooked Events and Methods ====

  * SetoHook( o)

  * RightClick()

  * PopUpMenu()

  * DblCLick()

  * Click()

  * InteractiveChange()

  * DropDown()

 

  PROCEDURE setohook

    *-- Automate the hook setting process. If a hook

    *-- already exists, hook to it, thus adding to the

    *-- hook chain.

    PARAMETERS toPassed

    IF TYPE( "THIS.oHook")= "O" AND ;

      PEMSTATUS( THIS.oHook, "oHook", 5)

     

      THIS.oHook.SetoHook( toPassed)

    ELSE

      THIS.oHook= toPassed

    ENDIF

  ENDPROC

 

  PROCEDURE RightClick

    *-- Pre-process hook

    IF TYPE( "THIS.oHook")= "O" AND ;

      PEMSTATUS( THIS.oHook, "RightClick", 5)

     

      THIS.oHook.RightClick

    ENDIF

    *-- Define a shortcut menu

    RELEASE POPUPS ShortCut

    DEFINE POPUP shortcut SHORTCUT RELATIVE ;

      FROM MROW(),MCOL()

    *-- Delegate to a shortcut builder

    THIS.PopupMenu()

   

    *-- Activate the shortcut

    IF CNTBAR( "Shortcut") > 0

      ACTIVATE POPUP Shortcut

    ENDIF

  ENDPROC

 

  PROCEDURE popupmenu

    *-- Delegate to the implementation chain

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "PopUpMenu", 5)

       RETURN THIS.oHook.PopUpMenu()

    ENDIF

  ENDPROC

 

  PROCEDURE DblClick

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "DblClick", 5)

      THIS.oHook.DblClick

    ENDIF

  ENDPROC

 

  PROCEDURE Click

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "Click", 5)

       RETURN THIS.oHook.Click()

    ENDIF

  ENDPROC

 

  PROCEDURE DropDown

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "DropDown", 5)

       RETURN THIS.oHook.DropDown()

    ENDIF

  ENDPROC

 

  PROCEDURE InteractiveChange

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "InteractiveChange", 5)

       RETURN THIS.oHook.InteractiveChange()

    ENDIF

  ENDPROC

ENDDEFINE

 

 

**************************************************

*-- Class:        frm

*-- ParentClass:  form

*-- BaseClass:    form

*-- Form with Rightmouse Behavior

*

DEFINE CLASS frm AS form

  DoCreate = .T.

  Caption = "Hooked Form"

  ohook = .NULL.

  AutoCenter= .T.

  Name = "frm"

  Showtips= .T.

 

  PROCEDURE Release

    *-- Release from memory

    THIS.GarbageCollect()

    RELEASE THIS

  ENDPROC

 

  PROCEDURE GarbageCollect

    *-- Clean up pointers

    *-- ... recursively 

    LOCAL lni

    FOR lni= 1 TO THIS.ControlCount

      THIS.Controls[lni].GarbageCollect()

    ENDFOR

    THIS.oHook= .NULL.

  ENDPROC

 

  PROCEDURE QueryUnload

    *-- Clean up first

    THIS.GarbageCollect()

  ENDPROC

 

  PROCEDURE Destroy

    CLEAR EVENTS

  ENDPROC

 

  *=== Hooked Events and Methods ====

  * SetoHook( o)

  * RightClick()

  * PopUpMenu()

  * InteractiveChange()

  * DropDown()

 

  PROCEDURE setohook

    *-- Automate the hook setting process. If a hook

    *-- already exists, hook to it, thus adding to the

    *-- hook chain.

    LPARAMETERS txPassed

    IF !ISNULL( THIS.oHook)

      THIS.oHook.SetOhook( txPassed)

    ELSE

      THIS.oHook= TXPassed

    ENDIF

  ENDPROC

 

  PROCEDURE RightClick

    *-- Define a shortcut

    RELEASE POPUPS Shortcut

    DEFINE POPUP shortcut SHORTCUT RELATIVE ;

      FROM MROW(),MCOL()

    *-- Delegate to a shortcut specialty method

    THIS.PopupMenu()

    *-- Activate the shortcut

    IF CNTBAR( "Shortcut") > 0   

      ACTIVATE POPUP Shortcut

    ENDIF

  ENDPROC

 

  PROCEDURE popupmenu

    *-- 3 sample shortcut menu bars

    DEFINE BAR 100 OF shortcut PROMPT "Properties" ;

      MESSAGE "Display the properties sheet"

    DEFINE BAR 200 OF shortcut PROMPT "Builders" ;

      MESSAGE "Invoke custom builders"

    DEFINE BAR 300 OF shortcut PROMPT "Code" ;

      MESSAGE "Edit underlying code"

    *-- Delegate to the implementation chain

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "PopUpMenu", 5)

       RETURN THIS.oHook.PopupMenu()

    ENDIF

  ENDPROC

 

  PROCEDURE dropdown

    *-- Occurs when the list portion of a ComboBox

    *-- control is about to drop down after the

    *-- drop-down arrow is clicked. 

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "DropDown", 5)

       RETURN THIS.oHook.DropDown()

    ENDIF

  ENDPROC

 

  PROCEDURE interactivechange

    *-- Occurs when the user changes the value ;

    *-- of a control using the keyboard or the mouse. 

    *-- Fire pre-process hook

    IF ! ISNULL( THIS.oHook) AND ;

      TYPE( "THIS.oHook") = "O" AND ;

      PEMSTATUS( THIS.oHook, "InteractiveChange", 5)

       RETURN THIS.oHook.InteractiveChange()

    ENDIF

  ENDPROC

ENDDEFINE

 

**************************************************

*-- Class:        txt (c:\_workshop\hooks.vcx)

*-- ParentClass:  textbox

*-- BaseClass:    textbox

*-- Textbox with Rightmouse Behavior

*

DEFINE CLASS txt AS textbox

  Height = 23

  Width = 100

  *-- Hook reference

  ohook = .NULL.

  Name = "txt"

 

  PROCEDURE GarbageCollect

    *-- Clean up pointers 

    THIS.oHook= .NULL.

  ENDPROC

 

  *-- Releases from memory.

  PROCEDURE release

    RELEASE THIS

  ENDPROC

 

  PROCEDURE popupmenu

    DEFINE BAR _med_cut OF shortcut PROMPT "Cu\<t" ;

      KEY CTRL+X, "Ctrl+X" ;

      MESSAGE ;

       "Removes the selection and places it onto the Clipboard"

    DEFINE BAR _med_copy OF shortcut PROMPT "\<Copy" ;

      KEY CTRL+C, "Ctrl+C" ;

      MESSAGE "Copies the selection onto the Clipboard"

    DEFINE BAR _med_paste OF shortcut PROMPT "\<Paste" ;

      KEY CTRL+V, "Ctrl+V" ;

      MESSAGE "Pastes the contents of the Clipboard"

    DEFINE BAR _med_slcta OF shortcut PROMPT "Se\<lect All" ;

      KEY CTRL+A, "Ctrl+A" ;

      MESSAGE "Selects all text or items in the current window"

    DEFINE BAR _med_clear OF shortcut PROMPT "Cle\<ar" ;

      MESSAGE ;

        "Removes the selection and does not place it onto the Clipboard"

    *-- Delegate to the implementation chain

    loTemp= THIS.oHook

    IF ! ISNULL( loTemp) AND ;

      TYPE( "loTemp") = "O" AND ;

      PEMSTATUS( loTemp, "PopUpMenu", 5)

       RETURN loTemp.PopupMenu()

    ENDIF

  ENDPROC

 

  PROCEDURE setohook

    *-- Automate the hook setting process. If a hook

    *-- already exists, hook to it, thus adding to the

    *-- hook chain.

    PARAMETERS toPassed

    IF TYPE( "THIS.oHook.oHook")<> "U"

      THIS.oHook.SetoHook( toPassed)

    ELSE

      THIS.oHook= toPassed

    ENDIF

  ENDPROC

 

  PROCEDURE Click

    IF ! ISNULL( This.oHook)

      THIS.oHook.Click

    ENDIF

  ENDPROC

 

  PROCEDURE RightClick

    RELEASE POPUPS ShortCut

    DEFINE POPUP shortcut SHORTCUT RELATIVE ;

      FROM MROW(),MCOL()

    THIS.PopupMenu()

    IF CNTBAR( "Shortcut") > 0

      ACTIVATE POPUP Shortcut

    ENDIF

  ENDPROC

 

  PROCEDURE DblClick

    IF ! ISNULL( This.oHook)

      THIS.oHook.DblClick

    ENDIF

  ENDPROC

ENDDEFINE

Listing 13. Several objects sharing common shortcut menus using chained hooks.

When you rightclick over the textbox, control is passed to the hook, which invokes a context sensitive shortcut menu. Some other things to draw from this example:

The hooked objects and the hooks don’t need to be of the same Baseclass.  Hooks can be lightweight objects, like labels, lines, or even Relations (which are ultra-lightweight).

Hooks can be shared by more than one object. There is nothing stopping us from having all the controls on our form pointing to the same hook.

Conclusion

Classes with seeded with hook operations are generally more flexible than those that aren’t. If you define hook operations consistently and predictably throughout your application, then it’s usually possible to attach new behavior to satisfy the needs of a particular instance without subclassing. Moreover, hook operations can be reckoned and bound at run time.

Interesting also that the hook operation design pattern is applicable in both object and non-object oriented programming.

[ 1 ] [ 2 ] [ 3 ] [ 4 ]