*ðððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððð*
* Program Name.: CC_DEMO.PRG
* Program Desc.: DEMO for CC.LIB, the ClipCode Clipper S'87 Library
* Client.......: CCA Product Development
* Language.....: Clipper Summer '87
* Start Date...: September 1989
* Last Revision: 09-13-90
  Version      = "Version 1.03"
  Copyright    = "(c) 1989-1990 ClipCode Associates"
* Programmer...: R. Stribling
*ðððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððð*
* LINK: TLINK /xl cc_demo,cc_demo, ,c:\clp\CLIPPER c:\clp\CC c:\clp\EXTEND
*ðððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððððð*
*  TO DO:
*  - 
*------------------------------------------------------------------------------*
*  DONE:
*  - 
*------------------------------------------------------------------------------*
*  Revision History
*  - Version 1.03  10-31-90 Added: MENUH, MENUV, MENUPD, MSGBOX, PDM_FSETUP,
*                           PDM_INIT, PDM_HELP, SAYATT, SETSCRSTAT, STR2REC,
*                           ASTORE, CLEARLKEY
*                           Modified: POPMSG, ALONGEST
*  - Version à.32  09-13-90 Added: ATNEXT, BOXSAVE, BOXREST, CHRCNT, FEOF
*                           Modified: POPCHOICE, POPGET, POPMSG, DBLBOX,
*                           SHADOWBOX (all modified for BOXSAVE & BOXREST)
*  - Version à.31  07-31-90 Added: FREADLN, FWRITLN, DELAY, SIZEDBF
*                           AFTYPE, ARESTC, ARESTD, ARESTL, ARESTN, ARESTX
*                           ASIZE,  ASAVEC, ASAVED, ASAVEL, ASAVEN, ASAVEX
*                           Modified: POPGET (valid default fix)
*  - Version à.30  05-28-90 Added: BLINKOFF, BLINKON
*  - Version à.29  05-16-90 Added: ADD_REC, BELL, FDATETIME, FIL_LOCK
*                           NET_USE, REC_LOCK, TABKEY, TABKEYSH
*  - Version à.28  11-13-89 Added: ALPHAAT, DATE2STR, POPGET, REPLPOS,
*                           SCRBLANK, STR2DATE, STR2TIME, TIME2STR, TIME2VAL
*  - Version à.27  10-03-89 Added: ClipCode Associates Copyright to all Source
*                           Modified: SHADOWBOX color default = 7
*  - Version à.26  09-26-89 Added: DBLBOX, SETCURSOR
*                           Modified: TESTSCREEN
*  - Version à.25  09-18-89 Fixed: SAFEPAK
*                           Modified: LJUST, RJUST, ZFILL
*  - Version à.24  09-18-89 Added: CENTER, CTRPOS
*  - Version à.23  09-07-89 Demo
*------------------------------------------------------------------------------*

***  Environment  ***
SET CONFIRM OFF
SET DELETED ON                          && Filter out Deleted Records
SET EXACT OFF
SET SCOREBOARD OFF

*** Declare PUBLIC Variables ***
CONSTANTS()                             && CC Function: PUBLIC Std mneumonics
PUBLIC Selection, Cur_SS

*** Set Special Keys ***
*?*SET KEY  -2 TO Exit2DOS                 && F3  Exit to DOS
SET FUNCTION  7 TO EscChr
SET FUNCTION 10 TO CtrlWChr

EXTERNAL TabKey, TabKeySh               && Simulate Field Exit keys
SET KEY   9 TO TabKey                   && TAB
SET KEY 271 TO TabKeySh                 && SHIFT-TAB

*** ARRAY Initialization ***
PRIVATE aLen, ss
aLen= ASIZE("CC_DEMO.ARR")

PRIVATE aMenu[aLen]
ARESTC( aMenu,"CC_DEMO.ARR" )

FOR ss= 1 TO aLen
  aMenu[ss]= aMenu[ss]+"()"
NEXT

*==============================================================================*
PRIVATE Choice, mText, W2Col

*** Display the screen ***
SET COLOR TO W+/B
W2Col = 14
@ 01,00,23,79 BOX "ÉÍ»º¼ÍȺ "
@ 02,W2Col TO 22,W2Col
@ 01,W2Col SAY "Ñ"
@ 23,W2Col SAY "Ï"

SET COLOR TO W+/G
@ 00,00 CLEAR TO 00,79
mText = "ClipCode CC.LIB  "+CHR(17)+CHR(16)+"  CLIPPER FUNCTION LIBRARY  "+CHR(17)+CHR(16)+"  Demo Program"
@ 00,CtrTxt( mText ) SAY mText

SET COLOR TO N/W
@ 24,00 SAY " Bar="+CHR(24)+CHR(25)+"  Enter=Select  F1=Help  F3=Exit       "+Copyright+" "

Choice = 1
Done0 = .F.
SET COLOR TO W+/B
DO WHILE .NOT. Done0

  Selection = 0
  Cur_Proc  = PROCNAME()
               *Syntx: scr_co-ords,aList,aTF , UDF  InitSel
  Choice    = ACHOICE( 02,01,22,13,aMenu,Null,"ACE",Choice )

  IF LASTKEY() = Esc                    && User escaped out of READ
    Exit2DOS()
    Choice = Selection
    LOOP
  ELSE
    ChoiceStr = aMenu[Choice]
  ENDIF

  IF Selection > 0
    Choice    = Selection
    ChoiceStr = aMenu[Choice]
    *?*ChoiceStr = ALLTRIM( STR( Selection ) )
  ENDIF

  LastCol_0 = SETCOLOR()
  SAVE SCREEN TO SCRN_0

  DO CASE
  CASE ChoiceStr == "ASTORE()"
    D_ASTORE()
  CASE ChoiceStr == "ALONGEST()"
    D_ALONGEST()
  CASE ChoiceStr == "ADD_REC()"
    D_ADD_REC()
  CASE ChoiceStr == "BEEP()"
    D_BEEP()
  CASE ChoiceStr == "BLINKOFF()"
    D_BLINKOFF()
  CASE ChoiceStr == "BLINKON()"
    D_BLINKOFF()
  CASE ChoiceStr == "DBLBOX()"
    D_DBLBOX()
  CASE ChoiceStr == "BOXREST()"
    D_BOXSAVE()
  CASE ChoiceStr == "BOXSAVE()"
    D_BOXSAVE()
  CASE ChoiceStr == "REC_LOCK()"
    D_REC_LOCK()
  CASE ChoiceStr == "FIL_LOCK()"
    D_FIL_LOCK()
  CASE ChoiceStr == "MENUH()"
    D_MENUH()
  CASE ChoiceStr == "MENUV()"
    D_MENUV()
  CASE ChoiceStr == "MSGBOX()"
    D_MSGBOX()
  CASE ChoiceStr == "NET_USE()"
    D_NET_USE()
  CASE ChoiceStr == "POPCHOICE()"
    D_POPCHOICE()
  CASE ChoiceStr == "POPMSG()"
    D_POPMSG()
  CASE ChoiceStr == "SAYATT()"
    D_SAYATT()
  CASE ChoiceStr == "SETCURSOR()"
    D_SETCURSOR()
  CASE ChoiceStr == "SETPOS()"
    D_SETPOS()
  CASE ChoiceStr == "SETSCRSTAT()"
    D_SETSCRSTAT()
  CASE ChoiceStr == "STR2REC()"
    D_STR2REC()
  CASE ChoiceStr == "TESTSCREEN()"
    TESTSCREEN()
    ANYKEYPANEL()
  CASE ChoiceStr == "ZFILL()"
    D_ZFILL()
  OTHERWISE
    POPMSG( "You selected option "+LTRIM( STR(Choice) )+": "+aMenu[Choice] )
  ENDCASE

  RESTORE SCREEN FROM SCRN_0
  SETCOLOR(LastCol_0)

ENDDO WHILE .NOT. Done0

Exit2DOS(.T.)
QUIT
*==============================================================================*

*------------------------------------------------------------------------------*
* DRIVER for BEEP()
*------------------------------------------------------------------------------*
FUNCTION D_BEEP

PRIVATE nbr

nbr= POPMSG("Press 1-9 for that number of BEEPS")-48
IF nbr > 0 .AND. nbr < 10
  BEEP(nbr)
ELSE
  POPMSG( "CHICKEN!...  Press [Space] to continue..." )
ENDIF

RETURN .T.

*------------------------------------------------------------------------------*
* DRIVER for BOXSAVE() / BOXREST()
*------------------------------------------------------------------------------*
FUNCTION D_BOXSAVE

TESTSCREEN()
sv_s= BOXSAVE(10,20,21,59)
SET COLOR TO W+/N
@ 10,20 CLEAR TO 21,59
@ 11,24 SAY "SAVE THE AREA:"
@ 12,24 SAY "sv_s= BOXSAVE(10,20,21,59)"
@ 14,24 SAY "& RESTORE IT:"
@ 15,24 SAY "BOXREST( sv_s )"
@ 17,24 SAY "THEN RESTORE IT ANYWHERE!:"
@ 18,24 SAY "BOXREST( sv_s,9,18 )"
@ 19,24 SAY "BOXREST( sv_s,8,16 )..etc."
AnyKeyPanel()
BOXREST( sv_s )
INKEY(1)
BOXREST( sv_s,9,18 )
INKEY(.1)
BOXREST( sv_s,8,16 )
INKEY(.1)
BOXREST( sv_s,7,14 )
INKEY(.1)
BOXREST( sv_s,6,12 )
INKEY(.1)
BOXREST( sv_s,5,10 )
INKEY(.1)
BOXREST( sv_s,4, 8 )
INKEY(.1)
BOXREST( sv_s,3, 6 )
INKEY(.1)
BOXREST( sv_s,2, 4 )
INKEY(.1)
BOXREST( sv_s,1, 2 )
INKEY(.1)
BOXREST( sv_s,0, 0 )
AnyKeyPanel()
RETURN .T.

*------------------------------------------------------------------------------*
* DRIVER for BLINKOFF() / BLINKON()
*------------------------------------------------------------------------------*
FUNCTION D_BLINKOFF

SET CURSOR OFF
TESTSCREEN()

PRIVATE tr,lc, br,rc
tr = 08
lc = 20
br = 16
rc = 60

ATT(tr,lc, br,rc, 143 )         && HEX2DEC("8F")
IF TOG_BL() = 27
  RETURN .T.
ENDIF
ATT(tr,lc, br,rc, 159)          && HEX2DEC("9F")
IF TOG_BL() = 27
  RETURN .T.
ENDIF
ATT(tr,lc, br,rc, 175)          && HEX2DEC("AF")
IF TOG_BL() = 27
  RETURN .T.
ENDIF
ATT(tr,lc, br,rc, 191)          && HEX2DEC("BF")
IF TOG_BL() = 27
  RETURN .T.
ENDIF
ATT(tr,lc, br,rc, 207)          && HEX2DEC("CF")
IF TOG_BL() = 27
  RETURN .T.
ENDIF
ATT(tr,lc, br,rc, 223)          && HEX2DEC("DF")
IF TOG_BL() = 27
  RETURN .T.
ENDIF
ATT(tr,lc, br,rc, 224)          && HEX2DEC("E0")
IF TOG_BL() = 27
  RETURN .T.
ENDIF
ATT(tr,lc, br,rc, 240)          && HEX2DEC("F0")
IF TOG_BL() = 27
  RETURN .T.
ENDIF

SET CURSOR ON
BLINKON()
RETURN .T.
*------------------------------------------------------------------------------*
*------------------------------------------------------------------------------*
FUNCTION TOG_BL

BLINKON()
IF AnyKeyPanel() = 27
  RETURN 27
ENDIF
BLINKOFF()
IF AnyKeyPanel() = 27
  RETURN 27
ENDIF

RETURN 0
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* DRIVER for ALONGEST()
*------------------------------------------------------------------------------*
FUNCTION D_ALONGEST

@ 01,00 CLEAR TO 23,79
@ 02,00 SAY ""

TEXT
  ALONGEST()  Determine the longest string in an array

  Syntax....: mLen = ALONGEST( aArray )
  Parameters: aArray: the array to be searched
  Returns...: the length of the longest string in a string array
  Cautions..: should be a string array
  CC Calls..: none
  Alias.....: none
  Example...: mLen = ALONGEST(aArray)

  PRIVATE aText[3], mLen
  aText[1] = "Apple"
  aText[2] = "Grapefruit"
  aText[3] = "Orange"
  mLen = ALONGEST( aText )
  ? mLen
ENDTEXT

PRIVATE aText[3], mLen
aText[1] = "Apple"
aText[2] = "Grapefruit"
aText[3] = "Orange"
?
? ALONGEST( aText )
AnyKeyPanel()

RETURN Null
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* DRIVER for ADD_REC()
*------------------------------------------------------------------------------*
FUNCTION D_ADD_REC

@ 01,00 CLEAR TO 23,79
@ 04,00 SAY ""

TEXT
  Text from ClipCode Norton Guide:
  ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
  ADD_REC()   Network: Attempts to add a new record

  Syntax....: ADD_REC( [delay] )
  Parameters: delay: [optional] seconds to wait for success (default: 5)
  Returns...: .T. if record appended / .F. if fails
  Cautions..: The new record is current and locked 
  CC Calls..: POPMSG()
  Alias.....: none
  Example...: IF ADD_REC(5)
                REPLACE Price WITH newprice
              ELSE
                ? "Could not add a record at this time"
              ENDIF
ENDTEXT
AnyKeyPanel()

RETURN Null
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* DRIVER for FIL_LOCK()
*------------------------------------------------------------------------------*
FUNCTION D_FIL_LOCK

@ 01,00 CLEAR TO 23,79
@ 04,00 SAY ""

TEXT
  Text from ClipCode Norton Guide:
  ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
  FIL_LOCK()  Network: Attempts to lock the current shared file

  Syntax....: FIL_LOCK( [secs] )
  Parameters: [secs]: optional number of seconds to attempt lock
  Returns...: .T. if succeeds / .F. if fails
  Cautions..: none
  CC Calls..: POPMSG()
  Alias.....: none
  Example...: IF FIL_LOCK(5)
                REPLACE ALL Price WITH Price * 1.1
              ELSE
                ? "File not available"
              ENDIF
ENDTEXT

AnyKeyPanel()

RETURN Null
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* DRIVER for NET_USE()
*------------------------------------------------------------------------------*
FUNCTION D_NET_USE

@ 01,00 CLEAR TO 23,79
@ 04,00 SAY ""

TEXT
  Text from ClipCode Norton Guide:
  ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
  NET_USE()   Network: Attempts to open a file for exclusive or shared use

  Syntax....: NET_USE( mfile [,alias] [,ex_use] [,wait] )
  Parameters:    mfile: name of the .DBF file to open
  [optional]   [alias]: alias of the .DBF file to open    (default = filename)
   "      "   [ex_use]: mode of open (.T.= exclusive /.F. (default = shared)
   "      "     [wait]: seconds to wait (0 = wait forever)(default = 5 sec)
  Returns...: .T. if succeeds / .F. if fails
  Cautions..: none
  CC Calls..: POPMSG()
  Alias.....: none
  Example...: IF NET_USE( "ACCOUNTS","",.T.,5 )
                SET INDEX TO  NAME
              ELSE
                ? "Account file not available"
              ENDIF
ENDTEXT

AnyKeyPanel()

RETURN Null
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* DRIVER for REC_LOCK()
*------------------------------------------------------------------------------*
FUNCTION D_REC_LOCK

@ 01,00 CLEAR TO 23,79
@ 04,00 SAY ""

TEXT
  Text from ClipCode Norton Guide:
  ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
  REC_LOCK()  Network: Attempts to lock the current record

  Syntax....: REC_LOCK( [seconds] )
  Parameters: [seconds]: the number of seconds to retry (default = 5)
  Returns...: .T. if succeeds / .F. if fails
  Cautions..: none
  CC Calls..: POPMSG()
  Alias.....: none
  Example...: IF REC_LOCK(5)
                REPLACE Price WITH newprice
              ELSE
                ? "Record not available"
              ENDIF
ENDTEXT

AnyKeyPanel()

RETURN Null
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* DRIVER for POPCHOICE()
*------------------------------------------------------------------------------*
FUNCTION D_POPCHOICE

PRIVATE Choice

TestScreen()

PRIVATE Header[2]
Header[1] = "Lawrence's"
Header[2] = "Count!"

PRIVATE Footer[2]
Footer[1] = " Bar"
Footer[2] = "Enter=Select"

PRIVATE PICS[4]
PICS[1] = "A One and a" 
PICS[2] = "Two and a" 
PICS[3] = "Three and a" 
PICS[4] = "Four!" 
Choice = PopChoice( PICS, Header, Footer )

SET COLOR TO W+/N
@ 18,00 CLEAR TO 22, 23
@ 19,02 SAY "You picked number: "
?? ALLTRIM(STR( Choice ) )
IF Choice = 0
  @ 21,02 SAY "(No selection)"
ELSE
  @ 21,02 SAY '= "'+PICS[Choice]+'"'
ENDIF
?
?
WAIT
RETURN NULL
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Demo ZFILL()
*------------------------------------------------------------------------------*
FUNCTION D_ZFILL

PRIVATE mRow, mCol, mLongest

mLongest = 'ZFILL( "12345",10 ) = ' +ZFILL( "12345",10 )
mRow = 02
mCol = CTRPOS( mLongest,W2Col,79 )

SET COLOR TO GR+/B
@ mRow   ,W2Col+2 SAY 'ZFILL() = Zero Fill Function'
@ ROW()+3,W2Col+2 SAY 'String Parameter:'
SET COLOR TO W+/B
@ ROW()+2,mCol    SAY '       Field Length = 10'
@ ROW()+2,mCol    SAY '     Numeric String = "12345"'
@ ROW()+2,mCol    SAY 'ZFILL( "12345",10 ) = ' +ZFILL( "12345",10 )

SET COLOR TO GR+/B
@ ROW()+3,W2Col+2 SAY 'Numeric Parameter:'
SET COLOR TO W+/B
@ ROW()+2,mCol    SAY '       Field Length = 10'
@ ROW()+2,mCol    SAY '             Number = ' +STR( 12345 )
@ ROW()+2,mCol    SAY '  ZFILL( 12345,10 ) = ' +ZFILL( 12345,10 )

AnyKeyPanel()

RETURN NULL
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver for DBLBOX()
*------------------------------------------------------------------------------*
FUNCTION D_DBLBOX

PRIVATE SaveScrn

TESTSCREEN()

SaveScrn = DBLBOX( 04,20, 14,60 )
AnyKeyPanel()
BOXREST( SaveScrn )
INKEY(0)

SaveScrn = DBLBOX( 04,20, 14,60, 1,"","",8 )
INKEY(0)
BOXREST( SaveScrn )
INKEY(0)

SaveScrn = DBLBOX( 04,20, 14,60, 0,"W+/R","W/B",8 )
INKEY(0)
BOXREST( SaveScrn )
INKEY(0)

SaveScrn = DBLBOX( 04,20, 14,60, 2,"GR+/G","BG/W",8 )
INKEY(0)
BOXREST( SaveScrn )
INKEY(0)

RETURN Null
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
FUNCTION AnyKeyPanel

PRIVATE LastColor, SaveCrs, mKey

SaveCrs = SETCURSOR(.F.)
LastColor  = SETCOLOR()
SET COLOR TO W+/G
@ 24,00 SAY CENTER( "Press any key to continue...",80 )
mKey = INKEY(0)

SETCOLOR( LastColor )
SETCURSOR( SaveCrs )

RETURN mKey
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver for: SETCURSOR()
*------------------------------------------------------------------------------*
FUNCTION D_SETCURSOR

PRIVATE SaveCrs

CLEAR SCREEN

? "Save the original cursor status..."
SaveCrs = SETCURSOR()
? "The Cursor is ON (T/F): "
?? SaveCrs
INKEY(0)
?
? "Now...SET CURSOR ON"
SET CURSOR ON
INKEY(0)
?
? "What is the Cursor Status?"
? "Status: "
IF SETCURSOR()
  ?? "The Cursor is ON!"
ELSE
  ?? "The Cursor is OFF!"
ENDIF
INKEY(0)
?
? "OK, Now... SET CURSOR OFF"
SETCURSOR(.F.)
INKEY(0)
?
? "What is the Cursor Status?"
? "Status: "
IF SETCURSOR()
  ?? "The Cursor is ON!"
ELSE
  ?? "The Cursor is OFF!"
ENDIF
INKEY(0)
?
? "Restore the original cursor status..."
SETCURSOR( SaveCrs )
INKEY(0)
?

RETURN Null
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Function: EXIT2DOS()
*------------------------------------------------------------------------------*
FUNCTION Exit2DOS

PARAMETERS Any
PRIVATE    PopCHR, LastCol, SCRN

IF PCOUNT() = 0
  PopCHR = UPPER( CHR( POPMSG( "Do you wish to Exit to DOS?  (Y/N)","YNP"+EscChr,09 ) ) )

  DO CASE
  CASE PopCHR == "Y"
    SET COLOR TO
    CLEAR
    SET CURSOR ON
    QUIT
  CASE PopCHR == "P"
    SaveCur = SETCURSOR(.T.)
    LastCol = SETCOLOR()
    SAVE SCREEN TO SCRN
    RUN PFM
    RESTORE SCREEN FROM SCRN
    SETCOLOR(LastCol)
    SETCURSOR(SaveCur)

  ENDCASE

ENDIF

RETURN Null                                             && End of: EXIT2DOS()
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Function: WELCOME()
*------------------------------------------------------------------------------*
FUNCTION WELCOME

PRIVATE aText[12]
aText[01] = " "
aText[02] = "          WELCOME TO CLIPCODE DEMO "
aText[03] = " "
aText[04] = "   (c) 1989-1990 by ClipCode Assoicates"
aText[05] = " ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ "
aText[06] = " To select a Main Menu option, use your arrow keys to"
aText[07] = " move the light bar to the desired option, or type the"
aText[08] = " option number.  Then press Enter to select the option."
aText[09] = " ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ "
aText[10] = " "
aText[11] = " Press any key to begin..."
aText[12] = " "
SET CURSOR OFF
POPMSG( aText )
SET CURSOR ON

RETURN Null                                             && End of: WELCOME()
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Procedure: HELP
*------------------------------------------------------------------------------*
PROCEDURE HELP

PARAMETERS mProc, mLine, mVar
PRIVATE    mRow, mCol, Screen_H, SaveColor, mText, mFile

IF mProc = "HELP" .OR. mProc = "MEMOEDIT"
  RETURN
ENDIF

mFile = "CC_030.html"
IF .NOT. FILE( mFile )
  POPMSG("Help File NOT Found.  Press any key to continue...")
  RETURN
ENDIF

SAVE SCREEN TO Screen_H
SaveColor = SETCOLOR()
mRow = ROW()
mCol = COL()

CLEAR SCREEN
@ 00,00 TO 23,79 DOUBLE
SET COLOR TO B/W
mText = " CC.LIB - GENERAL HELP TEXT "
@ 00,CtrTxt(mText) SAY mText
@ 24,00 CLEAR TO 24,79
@ 24,02 SAY CHR(24)+CHR(25)+"  PgUp  PgDn  Esc=Cancel"
@ 24,46 SAY Copyright
SETCOLOR(SaveColor)
MEMOEDIT(MEMOREAD(mFile),02,02,22,77,.F.)

SETCOLOR(SaveColor)
RESTORE SCREEN FROM Screen_H
@ mRow,mCol SAY ""

RETURN                                          && End of: PROCEDURE HELP
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Function: ACE()
* Purpose.: UDF for ACHOICE
*             This UDF allows an array to be edited using @ ...SAY...GET
*------------------------------------------------------------------------------*
FUNCTION ACE

PARAMETERS Mode, SS_Ptr, WinRow
PRIVATE    Ret_Val, LKey, PopCHR

Cur_SS = SS_Ptr
LKey   = LASTKEY()

DO CASE
CASE Mode = ACE_Idle
  Ret_Val = ACE_Cont

CASE Mode = ACE_Excptn

  DO CASE
  CASE LKey = Enter                     &&  Enter
   Ret_Val = ACE_Select

  CASE LKey = -2                        &&  F3
    Exit2DOS()
    Ret_Val = ACE_Cont

  CASE LKey = Esc                       &&  Esc
    Selection = Cur_SS
    Ret_Val = ACE_Quit

  OTHERWISE
    Ret_Val = ACE_NxMatch

  ENDCASE

OTHERWISE

  Ret_Val = ACE_Cont

ENDCASE

RETURN Ret_Val                                                 && End of: ACE()
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* DRIVER for ASTORE()
*------------------------------------------------------------------------------*
FUNCTION D_ASTORE

CLEAR SCREEN
@0,0 SAY "STRINGS: 12 Element Array                     ( all tests are x1000 )"
?        "~~~~~~~~~~~~~~~~~~~~~~~~~"
? "DIRECT  "
tm1= SECONDS()
FOR cnt= 1 TO 1000
  PRIVATE colors[12]
  colors[1]=  "N/W"
  colors[2]=  "W+/B"
  colors[3]=  "N/W"
  colors[4]=  "W+/B"
  colors[5]=  "N/W"
  colors[6]=  "W+/B"
  colors[7]=  "N/W"
  colors[8]=  "W+/B"
  colors[9]=  "N/W"
  colors[10]= "W+/B"
  colors[11]= "N/W"
  colors[12]= "W+/B"
NEXT
a= SECONDS()-tm1
?? a
? "ASTORE()"
tm1= SECONDS()
FOR cnt= 1 TO 1000
  PRIVATE colors[12]
  ASTORE( colors,"N/W","W+/B","N/W","W+/B","N/W","W+/B","N/W","W+/B","N/W","W+/B","N/W","W+/B" )
NEXT
b= SECONDS()-tm1
?? b
? "DIRECT / ASTORE"
?? b/a
?

? "INTEGERS: 12 Element Array"
? "~~~~~~~~~~~~~~~~~~~~~~~~~~"
? "DIRECT  "
tm1= SECONDS()
FOR cnt= 1 TO 1000
  PRIVATE colors[12]
  colors[1]=  1
  colors[2]=  2
  colors[3]=  3
  colors[4]=  4
  colors[5]=  5
  colors[6]=  6
  colors[7]=  7
  colors[8]=  8
  colors[9]=  9
  colors[10]= 10
  colors[11]= 11
  colors[12]= 12
NEXT
a= SECONDS()-tm1
?? a
? "ASTORE()"
tm1= SECONDS()
FOR cnt= 1 TO 1000
  PRIVATE colors[12]
  ASTORE( colors,1,2,3,4,5,6,7,8,9,10,11,12 )
NEXT
b= SECONDS()-tm1
?? b
? "DIRECT / ASTORE"
?? b/a
?

? "STRINGS: 2 Element Array"
? "~~~~~~~~~~~~~~~~~~~~~~~~"
? "DIRECT  "
tm1= SECONDS()
FOR cnt= 1 TO 1000
  PRIVATE colors[2]
  colors[1]=  "N/W"
  colors[2]=  "W+/B"
NEXT
a= SECONDS()-tm1
?? a
? "ASTORE()"
tm1= SECONDS()
FOR cnt= 1 TO 1000
  PRIVATE colors[2]
  ASTORE( colors,"N/W","W+/B" )
NEXT
b= SECONDS()-tm1
?? b
? "DIRECT / ASTORE"
?? b/a
?

? "INTEGERS: 2 Element Array"
? "~~~~~~~~~~~~~~~~~~~~~~~~~"
? "DIRECT  "
tm1= SECONDS()
FOR cnt= 1 TO 1000
  PRIVATE colors[2]
  colors[1]=  1
  colors[2]=  2
NEXT
a= SECONDS()-tm1
?? a
? "ASTORE()"
tm1= SECONDS()
FOR cnt= 1 TO 1000
  PRIVATE colors[2]
  ASTORE( colors,1,2 )
NEXT
b= SECONDS()-tm1
?? b
? "DIRECT / ASTORE"
?? b/a
?

ANYKEYPANEL()

RETURN .T.                                              && End of: ASTORE()
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Program Name: Driver for MENUH.PRG
*------------------------------------------------------------------------------*
FUNCTION D_MENUH

SET CURSOR OFF

mNbr= 4
PRIVATE aProm[mNbr], atrg[mNbr], tpos[mNbr], aColms[mNbr], aColr[mNbr]
aProm[1]=  " OK "
aProm[2]=  " No "
aProm[3]=  " Cancel "
aProm[4]=  " Help "

*Trgs[1]=   "O"
*Trgs[2]=   "c"
*Trgs[3]=   "e"

aColms[1]= 1
aColms[2]= aColms[1]+LEN(aProm[1])+2
aColms[3]= aColms[2]+LEN(aProm[2])+2
aColms[4]= aColms[3]+LEN(aProm[3])+2

aColr[1]=  "W/B"                                && hcolor when not selected
aColr[2]=  "W+/B"                               && hcolor for unselected trigger
aColr[3]=  "R/W"                                && hcolor for selected option
aColr[4]=  "W+/W"                               && hcolor for selected trigger

iopt= 2

lkey= 0
CLEAR
FOR rw= 2 TO 22
            *  @iopt, row, acolms, aprompt, acolr, atrg, atpos
  pick= MENUH( @iopt,  rw, aColms,   aProm, aColr )
  @ rw, 40 SAY ""
  ?? pick
NEXT
SET CURSOR ON

RETURN .T.
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver for MENUV()
*------------------------------------------------------------------------------*
FUNCTION D_MENUV

SET CURSOR OFF

TESTSCREEN()

dim= 6
PRIVATE aProm[dim], atrg[dim], tpos[dim], aRows[dim], active[dim], aMsg[dim]
aProm[1]=  " Open a new file "
aProm[2]=  " Display another file "
aProm[3]=  " Save as... "
aProm[4]=  " Change file name "
aProm[5]=  "-"
aProm[6]=  " Quit "

active[1]= .T.
active[2]= .T.
active[3]= .T.
active[4]= .F.
active[5]= .F.
active[6]= .T.

aMsg[1]=  "Open a new file for editing or execution"
aMsg[2]=  "Display another file in a popup window for reference"
aMsg[3]=  "Write current file to disk as file name ..."
aMsg[4]=  "Change the output file name"
aMsg[5]=  "-"
aMsg[6]=  "Exit to DOS"

PRIVATE aColr[6]
aColr[1]=  "W/B"                                && vcolor for unselected option
aColr[2]=  "W+/B"                               && vcolor for unselected trigger
aColr[3]=  "R/W"                                && vcolor for selected option
aColr[4]=  "R/W"                                && vcolor for selected trigger
aColr[5]=  "R/B"                                && vcolor for inactive option
aColr[6]=  "N/W"                                && vcolor for message row

vOpt= 1

pick= 1
DO WHILE pick <> 6
           *  @vOpt,row,colm, aprompt, active, acolr,[aMsg, Mrow, atrg, atpos ]
  pick= MENUV(@vOpt,  2, 10,    aProm, active, aColr, aMsg )
  @ 2, 40 SAY ""
  ?? pick
ENDDO
@ 22,0 SAY ""
SET CURSOR ON

RETURN .T.
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver for MSGBOX()
*------------------------------------------------------------------------------*
FUNCTION D_MSGBOX

TESTSCREEN()

Done= .F.
DO WHILE !Done

  PRIVATE aTxt[3], aProm[3]
  aTxt[1]= "Testing; one, two, three, four"
  aTxt[2]= "Testing; one, two, three, four"
  aTxt[3]= "Testing; one, two, three, four"
  aProm[1]= "OK"
  aProm[2]= "Cancel"
  aProm[3]= "Help"
  MSGBOX( aTxt, "Three Lines", aProm )

  *** 2nd DiaBox ***
  PRIVATE aTxt[2]
  aTxt[1]= "Testing; one, two, three, four"
  aTxt[2]= "Testing; one, two, three, four"
  MSGBOX( aTxt, "Two Lines" )

  *** 3rd DiaBox ***
  Txt= "Testing; one, two, three, four"
  PRIVATE aProm[2]
  aProm[1]= "OK"
  aProm[2]= "Help"

  PRIVATE colors[6]
  colors[1]= "W/R"                        && unsel prom
  colors[2]= "W+/R"                       && unsel trig    | opt line color 
  colors[3]= "R/W"                        && sel prom
  colors[4]= "W+/W"                       && sel trig
  colors[5]= "W+/R"                       && boxtxt color
  colors[6]= "W+/R"                       && title color

  MSGBOX( Txt, "One Line",aProm, colors )

  *** 4th DiaBox: No Title ***
  PRIVATE aTxt[2]
  aTxt[1]= "No title"
  aTxt[2]= "No title at all!"
  MSGBOX( aTxt )

  *** 5th DiaBox: No Title ***
  Txt= "No title at all!"
  MSGBOX( Txt )

  *** 6th DiaBox: No Title ***
  Txt= "Do you wish to Exit to DOS?"
  PRIVATE aProm[4]
  aProm[1]= "OK"
  aProm[2]= "No"
  aProm[3]= "Cancel"
  aProm[4]= "Help"
  Choice= MSGBOX( Txt, "Exit Program",aProm )
  IF Choice = 1
    EXIT
  ENDIF
ENDDO

RETURN .T.
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver for POPMSG()
*------------------------------------------------------------------------------*
FUNCTION D_POPMSG

TESTSCREEN()
       * Syntx( Msg         [, Keys, Row,mCol, TmO,BxT, C1, C2, RS ] )
POPMSG( "12345678900987654321" )
POPMSG( "12345678900987654321", .F., .F., .F., .F.,  1 )
POPMSG( "12345678900987654321", .F., .F., .F., .F.,  2, .F., .F., .F. )

RETURN .T.
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver: SETPOS()
*------------------------------------------------------------------------------*
FUNCTION D_SETPOS

CLEAR SCREEN

@ 2,2 SAY "Come back here & print an X each time: "
sv_pos= SETPOS()

@ 10,10 SAY "at 10,10 now!  Press <Enter> to continue..."
INKEY(0)

SETPOS( sv_pos )
?? "X"

sv_pos= SETPOS( 12,10 )
?? "at 12,10 now!  Press <Enter> to continue..."
INKEY(0)

SETPOS( sv_pos )
?? "X"

ANYKEYPANEL()

RETURN .T.
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver: SETSCRSTAT()
*------------------------------------------------------------------------------*
FUNCTION D_SETSCRSTAT

CLEAR SCREEN
? ROW()
? COL()
? ISCURSOR()
? SETCOLOR()
? "save it now!"
sv_st= SETSCRSTAT()

SET CURSOR OFF
SET COLOR TO W+/B
@ 13,20 SAY "Press <Enter> to continue..."
mrow= ROW()
mcol= COL()
? mrow
? mcol
? ISCURSOR()
? SETCOLOR()
? 
INKEY(0)

SETSCRSTAT( sv_st )
mrow= ROW()
mcol= COL()
?? "restore it now!"
? mrow
? mcol
? ISCURSOR()
? SETCOLOR()

RETURN .T.
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver for.: STR2REC()
*------------------------------------------------------------------------------*
FUNCTION D_STR2REC

CLEAR SCREEN
TEXT
*     expC expN expC expD  L expN      expM
*     ÚÄÄÄ¿ÚÄÄ¿ÚÄÄÄÄ¿ÚÄÄÄÄ¿ÂÚÄÄÄÄÄÄÄÄ¿ÚÄÄÄÄ¿
str= "ABCDE1234123456901002T1234567890hello!"

DBF= "IMP"
OPENDBF( DBF )

PRIVATE amemolen[1]
amemolen[1]= 6

* syntx: str 
STR2REC( str, amemolen )

DBEDIT()
ENDTEXT

RETURN .T.
*------------------------------------------------------------------------------*

*------------------------------------------------------------------------------*
* Driver: SAYATT()
*------------------------------------------------------------------------------*
FUNCTION D_SAYATT

CLEAR SCREEN
SAYATT( 'SAYATT( "hi", "W+/R" )', "W+/R" )
@ ROW(), COL() SAY "X"
INKEY(2)

SAYATT( 'SAYATT( "hi", "W+/R", 04,10 )', "W+/R", 04,10 )
@ ROW(), COL() SAY "X"
INKEY(2)

@ 06,10 SAY SAYATT( '@ 06,10 SAY SAYATT( "hi", "W+/R" )', "W+/R" )
@ ROW(), COL() SAY "X"
INKEY(2)

SAYATT( 'SAYATT( "hi", "W+/R",08 )', "W+/R",14 )
@ ROW(), COL() SAY "X"
INKEY(2)

@ ROW()+2, COL() SAY "X"
INKEY(2)
@ 18,00 SAY ""

RETURN .T.
*------------------------------------------------------------------------------*
*<eof>