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

*ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»*
*º Module Name: WIERDGET.PRG º*
*º Description: Demo of different things you can do with the º*
*º GET CLASS. º*
*º Notes......: COMPILE with the /n switch. º*
*º Use F1 for help. Specify DEMO on the command º*
*º line to load the GETs with data. º*
*º Author.....: Micheal Todd Charron º*
*º Date.......: Feb. 9, 1991 º*
*º History....: They program came from learning the ins and º*
*º outs of the GET CLASS. Actually this program º*
*º was finished a couple of months ago but I am º*
*º a reluctant commenter. º*
*º I have left out the function that replaces the º*
*º letters in the GETs with upside down letters. º*
*º º*
*º Copyright..: (c) Micro Tech Consultant Services, 1991 º*
*º (c) The people at Nantucket Canada, 1991 º*
*ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ*
#include "inkey.ch"
#include "funcs.ch"

// Define the locations of the objects in the GET array.
#define mGet1 aGet[ 1 ]
#define mGet2 aGet[ 2 ]
#define mGet3 aGet[ 3 ]
#define mGet4 aGet[ 4 ]

// Declaring this varible as STATIC before any functions makes it visible
// to all functions within this .PRG.
STATIC oDispGet

FUNCTION WIERDGET( IfDemo )
LOCAL aGet
LOCAL cDefCol, cDispVar, c_Get_No_1, c_Get_No_2, c_Get_No_3,;
c_Get_No_4, cThisGet
LOCAL nKey := 0, nLastGet, nGet
LOCAL lInsert := .T.

ALTD( 0 )

// Creates the object for the bottom display GET
oDispGet := GETNEW( 19, 8, { |x| IF( x == Nil, cDispVar,;
cDispVar := x ) }, 'cDispVar', , 'w+/rb, w+/r' )
nLastGet := nGet := 1
// Initializes the GETs with 60 spaces
cDispVar := c_Get_No_1 := c_Get_No_2 := c_Get_No_3 := c_Get_No_4 :=;
SPACE( 60 )

// Checks if user has requested that Demo GETs be set up
IF IfDemo != NIL .AND. UPPER( IfDemo ) == 'DEMO'
cDispVar := c_Get_No_1 :=;
PADR( 'The rain in spain falls mainly on the plain',;
60 )
c_Get_No_2 := PADR( 'Is there really anything to life', 60 )
c_Get_No_3 :=;
PADR( 'I have a headache, it could be this music', 60 )
c_Get_No_4 := PADR( 'If I could have three wishes? Ah!', 60 )
ENDIF

CLS
Panel( .T. )
SETBLINK( .F. )

// Sets up the rest of the GETs
aGet := { GETNEW( 4, 8, { |x| IF( x == Nil, c_Get_No_1,;
c_Get_No_1 := x ) }, "c_Get_No_1", , 'w+/rb, w+/r' ),;
GETNEW( 6, 8, { |x| IF( x == Nil, c_Get_No_2,;
c_Get_No_2 := x ) }, "c_Get_No_2", , 'w+/rb, w+/b' ),;
GETNEW( 8, 8, { |x| IF( x == Nil, c_Get_No_3,;
c_Get_No_3 := x ) }, "c_Get_No_3", , 'w+/rb, w+/gr' ),;
GETNEW( 10, 8, { |x| IF( x == Nil, c_Get_No_4,;
c_Get_No_4 := x ) }, "c_Get_No_4", , 'w+/rb, w+/bg' ) }

// Draws the GET area
Shad( 2, 5, 12, 70 , .T., 'w+/g' )
SETCOLOR( 'n/g' )
@2, 32 SAY ' WIERD GETS '

// Displays the GETs with the first one set up for input
GetShad( mGet1, .T., 'n/g' )
mGet2:DISPLAY()
mGet3:DISPLAY()
mGet4:DISPLAY()

// Draws the Info Area
Shad( 15, 5, 21, 70, .T., 'n/gr*' )

SETCOLOR( 'n/gr*' )
@16, 9 SAY 'Space Left:' + SPACE( 8 ) + 'Cursor Position:' +;
SPACE( 12 ) + 'Color:'
@18, 8 SAY 'Current Get:' + SPACE( 10 ) + 'Variable Name:'

// Displays the Info area GET
GetShad( oDispGet, .T., 'n/gr*' )

InfoDisp( mGet1, nGet )

// Positions the cursor to the first position in the first GET
DEVPOS( mGet1:ROW, mGet1:COL )

// Loops until the user wants to exit
DO WHILE nKey != K_F10

SETCURSOR( 1 )

nKey := INKEY( 0 )

DO CASE
CASE nKey == K_F1
HelpScreen()

CASE nKey == K_ENTER .OR. nKey == K_DOWN
nGet++

CASE nKey == K_UP
IF( nGet == 1, Nil, nGet-- )

CASE nKey == K_BS
aGet[ nGet ]:BACKSPACE()

CASE nKey == K_DEL
aGet[ nGet ]:DELETE()

CASE nKey == K_LEFT
aGet[ nGet ]:LEFT()

CASE nKey == K_RIGHT
aGet[ nGet ]:RIGHT()

CASE nKey == K_HOME
aGet[ nGet ]:HOME()

CASE nKey == K_END
aGet[ nGet ]:END()

CASE nKey == K_CTRL_LEFT
aGet[ nGet ]:WORDLEFT()

CASE nKey == K_CTRL_RIGHT
aGet[ nGet ]:WORDRIGHT()

CASE nKey == K_CTRL_HOME
nGet := 1

CASE nKey == K_CTRL_END
nGet := LEN( aGet )

CASE nKey == K_CTRL_T
aGet[ nGet ]:DELWORDRIGHT()

CASE nKey == K_CTRL_Y
aGet[ nGet ]:DELEND()

CASE nKey == K_CTRL_U
aGet[ nGet ]:UNDO()

// Toggles the INSERT mode and displays the mode.
CASE nKey == K_INS
lInsert := IF( lInsert, .F., .T. )
cDefCol := SETCOLOR( 'n/g' )
@12, 64 SAY IF( lInsert, ' INS ', ' OVR ' )

CASE Range( nKey, 32, 160 )
IF( lInsert, aGet[ nGet ]:INSERT( CHR( nKey ) ),;
aGet[ nGet ]:OVERSTRIKE( CHR( nKey ) ) )

CASE nKey == K_CTRL_F1
nGet := 1

CASE nKey == K_CTRL_F2
nGet := 2

CASE nKey == K_CTRL_F3
nGet := 3

CASE nKey == K_CTRL_F4
nGet := 4

CASE nKey == K_ALT_M
Capitilize( aGet[ nGet ] )

CASE nKey == K_ALT_F1
IF( nGet == 1, Nil, Exchange( aGet[ nGet ], mGet1 ) )

CASE nKey == K_ALT_F2
IF( nGet == 2, Nil, Exchange( aGet[ nGet ], mGet2 ) )

CASE nKey == K_ALT_F3
IF( nGet == 3, Nil, Exchange( aGet[ nGet ], mGet3 ) )

CASE nKey == K_ALT_F4
IF( nGet == 4, Nil, Exchange( aGet[ nGet ], mGet4 ) )

CASE nKey == K_ALT_D
InsertDateTime( aGet[ nGet ], DTOC( DATE() ) )

CASE nKey == K_ALT_T
InsertDateTime( aGet[ nGet ], TIME() )

CASE nKey == K_ALT_R
ReverseLetters( aGet[ nGet ] )

CASE nKey == K_ALT_L
ScrollLetters( oDispGet )

CASE nKey == K_ALT_U
ScrollLetters( aGet[ nGet ] )

CASE nKey == K_ALT_B
ScrollLetters( aGet[ nGet ], oDispGet )

CASE nKey == K_F10 .OR. nKey == K_ESC .OR. nKey == K_PGUP .OR.;
nKey == K_PGDN
// Pop up an Exit dialog box
nKey := IF( TimeToExit() = 1, K_F10, 0 )

ENDCASE

IF nGet == LEN( aGet ) + 1
// Pop up an Exit dialog box
IF( TimeToExit() == 1, nKey := K_F10, Nil )
nGet := LEN( aGet )
ENDIF

// If the GET has changed, the old GET loses it's
// shadow and the new GET's shadow is drawn
IF nLastGet != nGet
aGet[ nLastGet ]:ASSIGN()
GetShad( aGet[ nLastGet ], .F., 'n/g' )
GetShad( aGet[ nGet ], .T., 'n/g' )
DispGet( oDispGet, aGet[ nGet ] )
nLastGet := nGet
ENDIF

// Displays the current Info for the current GET
InfoDisp( aGet[ nGet ], nGet )
// Replaces the bottom get with the current GET's buffer
oDispGet:VARPUT( aGet[ nGet ]:BUFFER )
oDispGet:UPDATEBUFFER()
// Returns the cursor in the current GET
DEVPOS( aGet[ nGet ]:ROW, aGet[ nGet ]:COL +;
aGet[ nGet ]:POS - 1 )

ENDDO

Credit()

RETURN Nil



* * * *
*
* Function Capitilize()
*
// Capitilize every letter in the current get
FUNCTION Capitilize( oGet1 )
LOCAL nI

SETCURSOR( 0 )
// If no value in cargo capitilize the current GET's buffer
IF oGet1:CARGO == Nil
oGet1:CARGO := oGet1:BUFFER

FOR nI := 1 TO LEN( oGet1:BUFFER )
// Stuffs the capitilized leftmost character into
// leftmost position of the current GET.
oGet1:BUFFER := UPPER( LEFT( oGet1:BUFFER, nI ) ) +;
RIGHT( oGet1:BUFFER, LEN( oGet1:BUFFER ) - nI )
oDispGet:BUFFER := oGet1:BUFFER
oGet1:DISPLAY()
oDispGet:DISPLAY()
NEXT nI
// If the current GET hasn't been edited since being capitilized
// the old value will be returned to the current GET.
ELSEIF UPPER( oGet1:CARGO ) == oGet1:BUFFER
FOR nI := 1 TO LEN( oGet1:BUFFER )
oGet1:BUFFER := LEFT( oGet1:CARGO, nI ) +;
RIGHT( oGet1:BUFFER, LEN( oGet1:BUFFER ) - nI )
oDispGet:BUFFER := oGet1:BUFFER
oGet1:DISPLAY()
oDispGet:DISPLAY()
NEXT nI
oGet1:CARGO := Nil
ELSE
oGet1:CARGO := Nil
ENDIF
SETCURSOR( 1 )

RETURN Nil



* * * *
*
* Function Exchange()
*
// Exchanges the values contained in one GET with that of another
FUNCTION Exchange( oCurGet, oSelGet )
LOCAL cHoldLast
LOCAL nI

FOR nI := 1 TO LEN( oCurGet:BUFFER )
// Stores the last character of the current GET
cHoldLast := RIGHT( oCurGet:BUFFER, 1 )
// Stuffs the last character of the other GET into the
// leftmost position of the current GET.
oCurGet:BUFFER := RIGHT( oSelGet:VARGET(), 1 ) +;
LEFT( oCurGet:BUFFER, LEN( oCurGet:BUFFER ) - 1 )
// Stuffs the stored character into the leftmost position
// of the other GET
oSelGet:VARPUT( cHoldLast +;
LEFT( oSelGet:VARGET(), LEN( oSelGet:VARGET() ) - 1 ) )

oDispGet:BUFFER := oCurGet:BUFFER
oCurGet:DISPLAY()
oDispGet:DISPLAY()
oSelGet:DISPLAY()

NEXT nI

RETURN Nil



* * * *
*
* Function InsertDateTime()
*
// Inserts the Date or Time into the current GET.
FUNCTION InsertDateTime( oGet, cDateTime )
LOCAL cStuffChr
LOCAL nI

FOR nI = 1 TO LEN( cDateTime )
cStuffChr := SUBSTR( cDateTime, nI, 1 )
oGet:INSERT( cStuffChr )
oDispGet:INSERT( cStuffChr )
NEXT nI

RETURN Nil



* * * *
*
* Function ReverseLetters()
*
// Reverses the order of the letters within the current GET
FUNCTION ReverseLetters( oGet1 )
LOCAL nI

SETCURSOR( 0 )
FOR nI := 1 TO LEN( oGet1:BUFFER )
// Stuffs the leftmost character into the rightmost cursor
// position.
oGet1:BUFFER := LEFT( oGet1:BUFFER, nI - 1 ) +;
RIGHT( oGet1:BUFFER, 1 ) +;
SUBSTR( oGet1:BUFFER, nI, LEN( oGet1:BUFFER ) - nI )
oDispGet:BUFFER := oGet1:BUFFER
oGet1:DISPLAY()
oDispGet:DISPLAY()
NEXT nI
SETCURSOR( 1 )

RETURN Nil



* * * *
*
* Function ScrollLetters()
*
// Scrolls letters across the current GET and the bottom GET according to
// which objects are passed.
FUNCTION ScrollLetters( oGet1, oGet2 )
LOCAL nI

FOR nI := 1 TO LEN( oGet1:BUFFER )
// Stuffs the rightmost character of the GET into the
// leftmost position.
oGet1:BUFFER := RIGHT( oGet1:BUFFER, 1 ) +;
LEFT( oGet1:BUFFER, LEN( oGet1:BUFFER ) - 1 )
IF oGet2 == Nil
oGet1:DISPLAY()
ELSE
oGet2:BUFFER := oGet1:BUFFER
oGet1:DISPLAY()
oGet2:DISPLAY()
ENDIF
NEXT nI

RETURN Nil



* * * *
*
* Function HelpScreen()
*
// The Help Screen.
FUNCTION HelpScreen()
LOCAL cDefCol, SaveFullScreen()

SETCURSOR( 0 )

Shad( 1, 1, 21, 76, .T., 'gr+/b' )
SETCOLOR( 'gr+/b' )
@2, 4 SAY 'GET NAVIGATION KEYS' + SPACE( 18 ) + 'GET EXIT KEYS'
@7, 41 SAY 'GET WIERD KEYS'
@13, 4 SAY 'GET EDITING KEYS'

@1, 38 SAY 'Ñ'
@2, 38 TO 20, 38
@21, 38 SAY 'Ï'
@12, 1 SAY 'Ç' + REPLICATE( 'Ä', 36 ) + '´'
@6, 38 SAY 'Ã' + REPLICATE( 'Ä', 37 ) + '¶'

SETCOLOR( 'w+/b' )
@3, 2 SAY REPLICATE( '-', 36 )
@3, 39 SAY REPLICATE( '-', 37 )
@14, 2 SAY REPLICATE( '-', 36 )
@8, 39 SAY REPLICATE( '-', 37 )

@4, 12 SAY CHR( 26 ) + ' - Right'
@5, 12 SAY CHR( 27 ) + ' - Left'
@6, 7 SAY 'Ctrl ' + CHR( 26 ) + ' - Word Right'
@7, 7 SAY 'Ctrl ' + CHR( 27 ) + ' - Word Left'
@8, 12 SAY CHR( 25 ) + ' - Down'
@9, 12 SAY CHR( 24 ) + ' - Up'
@10, 9 SAY 'Home - First Char of Get'
@11, 10 SAY 'End - Last Char of Get'

@15, 7 SAY 'Delete - Delete Char'
@16, 4 SAY 'Backspace - Backspace Char'
@17, 7 SAY 'Ctrl T - Delete Word Right'
@18, 7 SAY 'Ctrl Y - Delete to End of Get'
@19, 7 SAY 'Ctrl U - Undo Changes in Get'
@20, 7 SAY 'Insert - Toggle Insert Mode'

@4, 48 SAY 'PgDn'
@5, 48 SAY 'PgUp'
@4, 61 SAY 'Escape'
@5, 61 SAY 'F10'

@9, 50 SAY 'Alt U - Scroll Upper Get'
@10, 50 SAY 'Alt L - Scroll Lower Get'
@11, 50 SAY 'Alt B - Scroll Both Gets'
@12, 50 SAY 'Alt R - Reverse Gets'
@13, 50 SAY 'Alt M - Capitilize Gets'
@14, 50 SAY 'Alt D - Insert Date'
@15, 50 SAY 'Alt T - Insert Time'
@17, 41 SAY 'Alt F1, F2,'
@18, 49 SAY 'F3, F4 - Exchange Gets'
@19, 41 SAY 'Ctrl F1, F2,'
@20, 49 SAY 'F3, F4 - Goto Get'

SETCOLOR( 'w+/n' )
@24, 52 SAY 'Press Any Key to Continue...'

INKEY( 0 )

SETCOLOR( cDefCol )
RestFullScreen()
SETCURSOR( 1 )

RETURN Nil



* * * *
*
* Function GetShad()
*
// If lShad is true the GET receives input focus and is displayed with a
// shadow. If lShad is false the GET's input focus is taken away.
FUNCTION GetShad( oGetObj, lShad, cClrs )
LOCAL cDefCol := SETCOLOR( cClrs )

IF lShad
// Moves the GET one column to the left and draws a shadow
oGetObj:COL --
oGetObj:SETFOCUS()
@ oGetObj:ROW + 1, oGetObj:COL + 1 SAY ;
REPLICATE( 'ß', LEN( oGetObj:BUFFER ) )
@ oGetObj:ROW, oGetObj:COL + LEN( oGetObj:BUFFER ) SAY 'Ü'

// Returns the cursor to the current Get
DEVPOS( oGetObj:ROW, oGetObj:COL )

ELSE
// Moves the Get one column to the right and erases the shadow
oGetObj:COL ++
@ oGetObj:ROW, oGetObj:COL - 1 SAY ' '
@ oGetObj:ROW + 1, oGetObj:COL SAY ;
REPLICATE( ' ', LEN( oGetObj:BUFFER ) )
oGetObj:KILLFOCUS()
ENDIF

RETURN Nil



* * * *
*
* Function DispGet()
*
// Sets up the Info GET with the color of the current GET
FUNCTION DispGet( oDispGet, oGet )

oDispGet:COLORSPEC := oGet:COLORSPEC
oDispGet:SETFOCUS()
oDispGet:RESET()

RETURN Nil



* * * *
*
* Function InfoDisp()
*
// Displays the info on the current GET
FUNCTION InfoDisp( oGet, nGet )
LOCAL cDefCol := SETCOLOR( 'b/gr*' )

@16, 21 SAY STR( 60 - LEN( TRIM( oGet:BUFFER ) ), 2 )
@16, 45 SAY STR( oGet:POS, 2 )
@16, 63 SAY PADR( UPPER( SUBSTR( oGet:COLORSPEC,;
AT( ',', oGet:COLORSPEC ) + 1 ) ), 5 )
@18, 21 SAY STR( nGet, 1 )
@18, 45 SAY oGet:NAME()

// Returns the cursor to the current GET
DEVPOS( oGet:ROW, oGet:COL + oGet:POS -1 )
SETCOLOR( cDefCol )

RETURN Nil



* * * *
*
* Function TimeToExit()
*
// Exit Dialog Box
FUNCTION TimeToExit()
LOCAL cDefCol, cDefColor := SETCOLOR( 'w+/r' ),;
cFullScrn := SAVESCREEN( 0, 0, 24, 79 )
LOCAL nExitCh := 1

BoxShad( 8, 30, 12, 48, 'w+/r' )

@9, 33 SAY 'Do You Really'
@10, 33 SAY 'Want to Exit?'
@11, 34 PROMPT ' YES '
@11, 41 PROMPT ' NO '
MENU TO nExitCh

SETCOLOR( cDefColor )
RESTSCREEN( 0, 0, 24, 79, cFullScrn )

RETURN nExitCh