Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : OOPMENU.ZIP
Filename : BASEMENU.PRG

 
Output of file : BASEMENU.PRG contained in archive : OOPMENU.ZIP
/*
BaseMenu.prg - Class(y) base menu class

Copyright (c) 1991, 1992 Chris Muller and Anton van Straaten
*/

EXTERNAL CsyMnuRT // for run-time version; remove if you have Class(y)

#include "class(y).ch"
#include "inkey.ch"


#define DFLT_MONO "N/W,W+/W,W+/N,N/W,W/N"
#define DFLT_COLOR "N/BG,R/BG,W+/R,W/BG,W/R"


CREATE CLASS BaseMenu
VAR hotKeys
VAR lSelected

METHOD wait // wait for user response
METHOD moveHilite

PROTECTED:
VAR items
VAR currPos, newPos
VAR parent
VAR window
VAR lMove
VAR finished
VAR hasFocus

METHOD askParent
METHOD initWin DEFERRED
METHOD addNewItem

EXPORT:
VAR colorSpec

METHOD addItem DEFERRED
METHOD draw
METHOD exec
METHOD postEvent
METHOD childRow, childCol DEFERRED

MESSAGE left METHOD moveLeft
METHOD right, up, down
METHOD top, bottom
METHOD selectCurr
METHOD quit
METHOD reset
METHOD setFocus, killFocus
END CLASS


CONSTRUCTOR new( aItems )
LOCAL i

::hotKeys := ""
::items := {}
::currPos := 1
::lSelected := .f.
::hasFocus := .f.

::colorSpec := IF( IsColor(), DFLT_COLOR, DFLT_MONO )

IF aItems != NIL
FOR i := 1 TO LEN( aItems )
::addItem( aItems[i, 1], aItems[i, 2] )
NEXT
END
RETURN


METHOD PROCEDURE draw
LOCAL i

::initWin()

FOR i := 1 TO LEN( ::items )
::items[i]:draw( ::window )
NEXT i
RETURN


METHOD PROCEDURE addNewItem( nRow, nCol, cLabel, oAction, lActive )
LOCAL nPos := AT( '~', cLabel )

IF nPos > 0
::hotKeys += UPPER( SUBSTR( cLabel, nPos + 1, 1 ) )
END
AADD( ::items, MenuItem():new( nRow, nCol, cLabel, oAction, lActive ) )
RETURN


METHOD PROCEDURE exec( oParent )
::parent := oParent
SET CURSOR OFF
IF ::window == NIL
::draw()
ELSE
::window:show()
ENDIF
::setFocus()
::wait()
::killFocus()
::window:hide()
IF oParent == NIL
SET CURSOR ON
ENDIF
RETURN


METHOD PROCEDURE wait
LOCAL nItems := LEN( ::items )
LOCAL iMsg := 0

::items[::currPos]:hilite( ::window )

::finished := .f.
::lMove := .f.

WHILE !::finished

// wait for the user to cause an event
iMsg := inkey( 0 )

::postEvent( iMsg )

WHILE ::lMove .or. ::lSelected
IF ::lMove
// perform wrap
IF ::newPos > nItems
::newPos := 1
ELSEIF ::newPos < 1
::newPos := nItems
END
::moveHilite()
ENDIF

IF ::lSelected
::killFocus()
::lSelected := .f.
::items[::currPos]:action:exec( self )
::setFocus()
ENDIF
ENDDO
ENDDO
RETURN


METHOD postEvent( iMsg )
LOCAL cAltKey

DO CASE
CASE iMsg == K_RIGHT ; ::right()
CASE iMsg == K_LEFT ; ::left()
CASE iMsg == K_UP ; ::up()
CASE iMsg == K_DOWN ; ::down()
CASE iMsg == K_HOME ; ::top()
CASE iMsg == K_END ; ::bottom()
CASE iMsg == K_ESC ; ::quit()
CASE iMsg == K_ENTER ; ::selectCurr()

CASE iMsg > 32 .and. iMsg < 127
::newPos := AT( UPPER( CHR( iMsg ) ), ::hotKeys )
::lMove := ::newPos > 0 .and. ::newPos <> ::currPos

CASE !EMPTY( cAltKey := Alt2Alpha( iMsg ) )
::newPos := at( cAltKey, ::hotKeys )
IF ::newPos == 0
::askParent( iMsg )
ELSE
::lMove := ::newPos <> ::currPos
::selectCurr()
ENDIF
ENDCASE
RETURN ::lMove .OR. ::lSelected .OR. ::finished


METHOD PROCEDURE askParent( iMsg )
// post event with parent but only give up focus if it causes
// parent to move (ie. will not reinvoke this menu)
::finished := ::parent:postEvent( iMsg ) .AND. ; // event caused an action in the parent, which must be:
( ( ::parent:lMove .OR. ::parent:finished ) .OR.; // a move or a quit, or
( !::hasFocus .AND. ::parent:lSelected ) ; // a reselect of a parent menu (but not this menu)
)

IF !::finished
::parent:reset()
ENDIF
RETURN


METHOD PROCEDURE right
::newPos := ::currPos + 1
::lMove := .t.
RETURN


METHOD PROCEDURE moveLeft
::newPos := ::currPos - 1
::lMove := .t.
RETURN


METHOD PROCEDURE up
::newPos := ::currPos - 1
::lMove := .t.
RETURN


METHOD PROCEDURE down
::newPos := ::currPos + 1
::lMove := .t.
RETURN


METHOD PROCEDURE top
::newPos := 1
::lMove := .t.
RETURN


METHOD PROCEDURE bottom
::newPos := LEN( ::items )
::lMove := .t.
RETURN


METHOD PROCEDURE quit
::finished := .t.
RETURN


METHOD PROCEDURE selectCurr
::lSelected := .t.
RETURN


METHOD PROCEDURE reset
::lSelected := .f.
::lMove := .f.
::finished := .f.
RETURN


METHOD PROCEDURE setFocus
::hasFocus := .t.
RETURN


METHOD PROCEDURE killFocus
::hasFocus := .f.
RETURN


METHOD PROCEDURE moveHilite
IF ::lMove .AND. ::hasFocus
::items[::currPos]:draw( ::window ) // dehilite
::currPos := ::newPos
::items[::currPos]:hilite( ::window ) // hilite
::lMove := .f.
ENDIF
RETURN


// eof basemenu.prg


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : OOPMENU.ZIP
Filename : BASEMENU.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/