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

/*
BOXLIB.PRG
Copyright (c) 1989, 1990, The Leylan Factor

The Leylan Factor
98-626 Moanalua Loop, #201
Aiea, HI 96701-5172

(808) 487-2230

Compuserve : 74216,3212

distribute freely with this header intact

Compile : clipper boxlib /n/w
*/

#include "inkey.ch"
#include "achoice.ch"
#include "boxlib.ch"

STATIC bhObj := {}
STATIC aPick := {}


FUNCTION BoxNew( nTop, nLeft, nLength, nWidth, cColor, nShadow, cFrame, cTitle )
nShadow := IF(nShadow == 1, 1, 0)
RETURN {nTop, nLeft, nLength, nWidth, cColor, nShadow, cFrame, cTitle, 0, 0, 0, 0, ""}



FUNCTION BoxTop( bhObj, uValue )
LOCAL xValue := Box:Top
IF !(uValue == NIL)
Box:Top := uValue
ENDIF
RETURN xValue



FUNCTION BoxLeft( bhObj, uValue )
LOCAL xValue := Box:Left
IF !(uValue == NIL)
Box:Left := uValue
ENDIF
RETURN xValue



FUNCTION BoxLength( bhObj, uValue )
LOCAL xValue := Box:Length
IF !(uValue == NIL)
Box:Length := uValue
ENDIF
RETURN xValue



FUNCTION BoxWidth( bhObj, uValue )
LOCAL xValue := Box:Width
IF !(uValue == NIL)
Box:Width := uValue
ENDIF
RETURN xValue



FUNCTION BoxColor( bhObj, uValue )
LOCAL xValue := Box:Color
IF !(uValue == NIL)
Box:Color := uValue
ENDIF
RETURN xValue



FUNCTION BoxShadow( bhObj, uValue )
LOCAL xValue := Box:Shadow
IF !(uValue == NIL)
Box:Shadow := IF(uValue == 1, 1, 0)
ENDIF
RETURN xValue



FUNCTION BoxFrame( bhObj, uValue )
LOCAL xValue := Box:Frame
IF !(uValue == NIL)
Box:Frame := uValue
ENDIF
RETURN xValue



FUNCTION BoxTitle( bhObj, uValue )
LOCAL xValue := Box:Title
IF !(uValue == NIL)
Box:Title := uValue
ENDIF
RETURN xValue



FUNCTION BoxBottom( bhObj )
RETURN Box:Bottom



FUNCTION BoxRight( bhObj )
RETURN Box:Right



FUNCTION BoxShow( bhObj )
LOCAL xColor := SETCOLOR( Box:Color )

BoxSave( bhObj )

/* draw box */
@ Box:Top, Box:Left, Box:Bottom, Box:Right BOX Box:Frame

/* say title */
IF !EMPTY( Box:Title )

@ Box:Top, Box:Left SAY SUBS( Box:Frame, 1, 2 ) + ;
PADR( Box:Title, Box:Width - 3, SUBS( Box:Frame, 2, 1 ) ) + ;
SUBS( Box:Frame, 3, 1 )

ENDIF

/* draw shadow */
IF Box:Shadow > 0
Shadow( Box:Top, Box:Left, Box:Bottom, Box:Right, MAXROW(), MAXCOL() )
ENDIF

SETCOLOR( xColor )

RETURN bhObj



FUNCTION BoxDrag( bhBox, bhRealm )
LOCAL cScrn, xColor, nKey, nShell
LOCAL xTop, xLeft, xLength, xWidth, xBottom, xRight
LOCAL nRtop, nRleft, nRlength, nRwidth, nRbottom, nRright

/* assign object */
bhObj := bhRealm

/* init range limits */
nRtop := Box:Top
nRleft := Box:Left
nRlength := Box:Length
nRwidth := Box:Width
nRbottom := Box:Bottom
nRright := Box:Right

/* assign object */
bhObj := bhBox

/* copy attributes */
xTop := Box:Top
xLeft := Box:Left
xLength := Box:Length
xWidth := Box:Width
xBottom := Box:Bottom
xRight := Box:Right

xColor := SETCOLOR( "W/N" )

nShell := 1
WHILE (nShell > 0)

cScrn := SAVESCREEN( xTop, xLeft, xBottom, xRight )
@ xTop, xLeft, xBottom, xRight BOX "ÉÍ»º¼ÍȺ"

nKey := INKEY(0)

RESTSCREEN( xTop, xLeft, xBottom, xRight, cScrn )

DO CASE

CASE nKey == K_HOME
xTop := 0
xLeft := 0

CASE nKey == K_END
xTop := ( nRlength - xLength - Box:Shadow )
xLeft := 0

CASE nKey == K_PGUP
xTop := 0
xLeft := ( nRwidth - xWidth - Box:Shadow )

CASE nKey == K_PGDN
xTop := ( nRlength - xLength - Box:Shadow )
xLeft := ( nRwidth - xWidth - Box:Shadow )

CASE nKey == K_UP
xTop := MAX( nRtop, xTop - 1 )

CASE nKey == K_DOWN
xTop := MIN( nRlength - xLength - Box:Shadow, xTop + 1 )


CASE nKey == K_LEFT
xLeft := MAX( nRleft, xLeft - 1 )

CASE nKey == K_RIGHT
xLeft := MIN( nRwidth - xWidth - Box:Shadow, xLeft + 1 )

CASE nKey == K_ESC
nShell := 0

CASE nKey == K_ENTER
Box:Top := xTop
Box:Left := xLeft
Box:Length := xLength
Box:Width := xWidth

nShell := 0

ENDCASE

xBottom := ( xTop + xLength - 1 )
xRight := ( xLeft + xWidth - 1 )

END WHILE (nShell > 0)

SETCOLOR( xColor )

RETURN bhBox



FUNCTION BoxSize( bhBox, bhRealm )
LOCAL cScrn, xColor, nKey, nShell
LOCAL xTop, xLeft, xBottom, xRight
LOCAL nRtop, nRleft, nRlength, nRwidth, nRbottom, nRright

/* assign object */
bhObj := bhRealm

/* init range limits */
nRtop := Box:Top
nRleft := Box:Left
nRlength := Box:Length
nRwidth := Box:Width
nRbottom := Box:Bottom
nRright := Box:Right

/* assign object */
bhObj := bhBox

/* copy attributes */
xTop := Box:Top
xLeft := Box:Left
xBottom := Box:Bottom
xRight := Box:Right

xColor := SETCOLOR( "W/N" )

nShell := 1
WHILE (nShell > 0)

cScrn := SAVESCREEN( xTop, xLeft, xBottom, xRight )
@ xTop, xLeft, xBottom, xRight BOX "ÉÍ»º¼ÍȺ"

nKey := INKEY(0)

RESTSCREEN( xTop, xLeft, xBottom, xRight, cScrn )

DO CASE

CASE nKey == K_HOME
xBottom := ( xTop + 4 )
xRight := ( xLeft + 5 )

CASE nKey == K_END
xBottom := ( nRbottom - Box:Shadow )
xRight := ( xLeft + 5 )

CASE nKey == K_PGUP
xBottom := ( xTop + 4 )
xRight := ( nRright - Box:Shadow )

CASE nKey == K_PGDN
xBottom := ( nRbottom - Box:Shadow )
xRight := ( nRright - Box:Shadow )

CASE nKey == K_UP
xBottom := MAX( xTop + 4, xBottom - 1 )

CASE nKey == K_DOWN
xBottom := MIN( nRbottom - Box:Shadow, xBottom + 1 )

CASE nKey == K_LEFT
xRight := MAX( xRight - 1, xLeft + 5 )

CASE nKey == K_RIGHT
xRight := MIN( nRright - Box:Shadow, xRight + 1 )

CASE nKey == K_ESC
nShell := 0

CASE nKey == K_ENTER
Box:Top := xTop
Box:Left := xLeft
Box:Length := ( xBottom - xTop + 1 )
Box:Width := ( xRight - xLeft + 1 )

nShell := 0

ENDCASE

END WHILE (nShell > 0)

SETCOLOR( xColor )

RETURN bhBox



FUNCTION BoxReshow( bhObj, nMsg )
LOCAL cScrn, xColor

DO CASE

CASE nMsg == BX_FRAME

xColor := SETCOLOR( Box:Color )

/* draw frame */
@ Box:Top, Box:Left, Box:Bottom, Box:Right BOX LEFT( Box:Frame, 8 )

/* say title */
IF !EMPTY( Box:Title )

@ Box:Top, Box:Left SAY SUBS( Box:Frame, 1, 2 ) + ;
PADR( Box:Title, Box:Width - 3, SUBS( Box:Frame, 2, 1 ) ) + ;
SUBS( Box:Frame, 3, 1 )

ENDIF

SETCOLOR( xColor )

CASE nMsg == BX_TITLE

xColor := SETCOLOR( Box:Color )

/* say title */
@ Box:Top, Box:Left SAY SUBS( Box:Frame, 1, 2 ) + ;
PADR( Box:Title, Box:Width - 3, SUBS( Box:Frame, 2, 1 ) ) + ;
SUBS( Box:Frame, 3, 1 )

SETCOLOR( xColor )

ENDCASE

RETURN bhObj



STATIC FUNCTION BoxSave( bhObj )

/* save attributes */
Box:xTop := Box:Top
Box:xLeft := Box:Left
Box:xBottom := Box:Bottom
Box:xRight := Box:Right

Box:xScrn := SAVESCREEN( Box:Top, Box:Left, Box:Bottom + Box:Shadow, Box:Right + Box:Shadow )

RETURN bhObj



FUNCTION BoxUnshow( bhObj )
RESTSCREEN( Box:xTop, Box:xLeft, Box:xBottom + Box:Shadow, Box:xRight + Box:Shadow, Box:xScrn )
RETURN bhObj



FUNCTION BoxClear( bhObj )
LOCAL xColor := SETCOLOR( Box:Color )
@ Box:Top + 1, Box:Left + 1, Box:Bottom - 1, Box:Right - 1 BOX REPL( RIGHT( Box:Frame, 1), 9)
SETCOLOR( xColor )

RETURN bhObj



FUNCTION BoxSay( bhObj, nRow, nCol, cMsg )
LOCAL xColor

/* if within box */
IF ((Box:Top + nRow) + 1 < Box:Bottom)
IF ((Box:Left + nCol) < Box:Right)

xColor := SETCOLOR( Box:Color )
cMsg := LEFT(cMsg + SPACE( Box:Width ), MIN( LEN( cMsg ), (Box:Width - 2 - nCol) ))
@ (Box:Top + nRow) + 1, (Box:Left + nCol) + 1 SAY cMsg
SETCOLOR( xColor )

ENDIF
ENDIF

RETURN bhObj



FUNCTION BoxAsay( bhObj, nRow, nCol, aMsg )
LOCAL xColor, nMax, nCnt, cMsg

xColor := SETCOLOR( Box:Color )

nMax := LEN( aMsg )

/* for each element */
FOR nCnt := 1 TO nMax

/* if within box */
IF ((Box:Top + nRow + nCnt) < Box:Bottom)
IF ((Box:Left + nCol) < Box:Right)

cMsg := LEFT( aMsg[nCnt] + SPACE( Box:Width ), MIN( LEN( aMsg[nCnt] ), (Box:Width - 2 - nCol) ))
@ (Box:Top + nRow + nCnt), (Box:Left + nCol) + 1 SAY cMsg

ENDIF

ELSE
nCnt += nMax

ENDIF

NEXT nCnt

SETCOLOR( xColor )

RETURN bhObj



FUNCTION BoxPick( bhObj, aList )
LOCAL xColor, nKey, nShell

/* assign pick list */
aPick := aList

xColor := SETCOLOR( Box:Color )

nShell := 1
WHILE (nShell > 0)

nKey := ACHOICE( Box:Top + 1, Box:Left + 3, Box:Bottom - 1, Box:Right - 2, ;
aPick[1], .T., "BoxPicku", aPick[2], aPick[3] )

IF nKey > 0
nShell := 0

ELSE
IF (LASTKEY() == K_ESC)
nKey := 0
nShell := 0

ENDIF

ENDIF

END WHILE (nShell > 0)

SETCOLOR( xColor )

RETURN nKey



FUNCTION BoxPicku( nMode, nListEle, nListOff )
LOCAL nRet, nKey, xColor

CLEAR TYPEAHEAD

DO CASE

CASE nMode == AC_IDLE
nRet := AC_CONT

CASE nMode == AC_HITTOP
TONE( 100, 2 )
nRet := AC_CONT

CASE nMode == AC_HITBOTTOM
TONE( 100, 2 )
nRet := AC_CONT

CASE nMode == AC_EXCEPT

nKey := LASTKEY()

DO CASE

CASE nKey == K_ESC
nRet := AC_ABORT

CASE nKey == K_HOME
nListEle := nListOff := 1
nRet := AC_ABORT

CASE nKey == K_END
nListEle := nListOff := LEN( aPick[1] )
nRet := AC_ABORT

CASE nKey == K_LEFT
TONE( 100, 2 )
nRet := AC_CONT

CASE nKey == K_RIGHT
TONE( 100, 2 )
nRet := AC_CONT

CASE nKey == K_ENTER
nRet := AC_SELECT

OTHERWISE
nRet := AC_GOTO

ENDCASE

OTHERWISE

TONE( 500, 5 )
nRet := AC_ABORT

ENDCASE

aPick[2] := nListEle
aPick[3] := nListOff

RETURN nRet