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

*:*********************************************************************
*:
*: Program: SYSDEF.PRG
*:
*: System: SYStem DEFinition
*: Author: Bill Ferguson
*: Copyright (c) 1990, None
*: Last modified: 06/18/90 6:45
*:
*: Procs & Fncts: S_SYSDEF
*: : HELP
*: : S_HELP
*: : U_MAKE_M()
*: : C_SYSDEF
*: : C_HELP
*: : EMPTY()
*: : TOGGLE
*: : CENTER()
*: : SHADOW
*: : SHADOWG
*: : EXPLODE
*: : SHRINK
*:
*: Called by: REGISTRY.PRG
*: : ACT05 (procedure in MAINMENU.PRG)
*:
*: Calls: S_SYSDEF (procedure in SYSDEF.PRG)
*: : HELP (procedure in SYSDEF.PRG)
*: : S_HELP (procedure in SYSDEF.PRG)
*: : U_MAKE_M() (function in SYSDEF.PRG)
*: : C_SYSDEF (procedure in SYSDEF.PRG)
*: : C_HELP (procedure in SYSDEF.PRG)
*:
*: Uses: SYSDEF.DBF
*: : &DRIVER.DBF
*:
*: Memory Files: GLOBAL.MEM
*:
*: Other Files: &G_PRIN_PRT
*:
*: Documented 06/18/90 at 07:00 SNAP! version 4.02d
*:*********************************************************************
********************************************************************************
*-- Name.......: SYSDEF.PRG Version 2.0 (6-18-90)
*-- Author.....: Bill Ferguson
*-- BF Computer Solutions
*-- 391 E. 118th Pl.
*-- Northglenn, CO 80233
*-- Date.......: 5-04-90
*-- Version....: dBASE IV
*-- Notes......: Generic program for allowing end-users to configure their own
*-- ...........: particular hardware environment.
********************************************************************************

*===============================================================================
*------ declare global variables -----------------------------------------------
*- This block needs to be copied into main the program, before the program &&
*- DOes the MPDEF routine, as it starts off with an ISCOLOR() statement. &&
*- &&
*- Also, copy the block (lines 86 - 93) to a disk file. Then copy them &&
*- into your main program and the main menu, wherever the SET COLOR OF ____ &&
*- commands are. These are found right after an IF ISCOLOR(). &&
*- &&
*PUBLIC g_norm_clr, g_mess_clr, g_tit_clr, g_box_clr, g_high_clr, g_info_clr &&
*PUBLIC g_fiel_clr, g_prin_prt, g_driver, g_loffset, g_lmargin, g_plength &&
*PUBLIC g_pspacing, g_peject, g_pwait, g_ppitch, g_pquality &&
*DEFINE WINDOW printemp FROM 08,25 TO 17,56 && needed by error procedure &&
*ON ERROR DO prntrtry && procedure generated by Apgen in main program &&
*IF FILE ("global.mem") &&
* RESTORE FROM global ADDITIVE &&
* _pdriver = g_driver &&
* _ploffset = g_loffset &&
* _lmargin = g_lmargin &&
* _plength = g_plength &&
* _pspacing = g_pspacing &&
* _peject = g_peject &&
* _pwait = g_pwait &&
* _ppitch = g_ppitch &&
* _pquality = g_pquality &&
*ELSE &&
* DO sysdef &&
*ENDIF &&
*ON ERROR &&
* &&
* &&
*SET COLOR OF NORMAL TO &g_norm_clr &&
*SET COLOR OF MESSAGE TO &g_mess_clr &&
*SET COLOR OF TITLE TO &g_tit_clr &&
*SET COLOR OF BOX TO &g_box_clr &&
*SET COLOR OF HIGHLIGHT TO &g_high_clr &&
*SET COLOR OF INFORMATION TO &g_info_clr &&
*SET COLOR OF FIELDS TO &g_fiel_clr &&
*SET PRINTER TO &g_prin_prt &&
*-------------------------------------------------------------------------------
*===============================================================================

SET TALK OFF
SET STATUS OFF
SELECT I
USE sysdef

PRIVATE lc_cat, lc_dbf, lc_order, t, l, B, R
t = 5
l = 6
B = 15
R = 74

*------ find current settings to display in fields -----------------------------
loffset = _PLOFFSET
lmargin = _LMARGIN
pspacing = _PSPACING
peject = _PEJECT
pwait = _PWAIT
ppitch = _PPITCH
pquality = _PQUALITY
curr_drvr = driver
ON KEY LABEL f2 ?? CHR(7) && disable the standard edit function key
DO s_sysdef
ON KEY LABEL f1 DO HELP WITH VARREAD()
DO s_help

*-- @ SAY GETS Processing. -----------------------------------------------------

@ 1,27 SAY "SYSTEM & PRINTER DEFINITIONS"
* @ 2,27 SAY " (Screen #1)"
@ 3,8 SAY "Printer Make & Model:"
@ 3,31 GET make_model PICTURE "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!" ;
VALID u_make_m( make_model )
@ 4,8 SAY "Printer Port in use :"
@ 4,31 GET print_port PICTURE "@M LPT1,COM1"
@ 6,4 SAY "Page Settings"
@ 7,1 TO 7,19 DOUBLE
@ 8,1 SAY "Page offset :"
@ 8,18 GET loffset PICTURE "99" DEFAULT 0
@ 9,1 SAY "Left margin :"
@ 9,18 GET lmargin PICTURE "99" DEFAULT 0
@ 10,1 SAY "Page length :"
@ 10,18 GET plength PICTURE "99" RANGE 1,99
@ 11,1 SAY "Line spacing :"
@ 11,19 GET pspacing PICTURE "9" RANGE 1,3

@ 6,44 SAY "Print Settings"
@ 7,25 TO 7,77 DOUBLE
@ 8,25 SAY "Eject paper :"
@ 8,46 GET peject PICTURE "@M BEFORE,AFTER,BOTH,NONE"
@ 8,54 SAY "spacebar toggles options"
@ 9,25 SAY "Wait between pages:"
@ 9,46 GET pwait PICTURE "L"
@ 10,25 SAY "Pitch :"
@ 10,46 GET ppitch PICTURE "@M DEFAULT,PICA,ELITE,CONDENSED"
@ 10,57 SAY "space toggles options"
@ 11,25 SAY "Print quality :"
@ 11,46 GET pquality PICTURE "L"
READ



CLEAR
SET COLOR OF NORMAL TO N/N
@ 2,0 SAY "N/N "
SET COLOR OF NORMAL TO N/B
@ 2,8 SAY "N/B "
SET COLOR OF NORMAL TO N/G
@ 2,16 SAY "N/G "
SET COLOR OF NORMAL TO N/BG
@ 2,24 SAY "N/BG "
SET COLOR OF NORMAL TO N/N+
@ 2,32 SAY "N/N+ "
SET COLOR OF NORMAL TO N/R
@ 2,40 SAY "N/R "
SET COLOR OF NORMAL TO N/RB
@ 2,48 SAY "N/RB "
SET COLOR OF NORMAL TO N/GR
@ 2,56 SAY "N/GR "
SET COLOR OF NORMAL TO N/GR+
@ 2,64 SAY "N/GR+ "
SET COLOR OF NORMAL TO N/W
@ 2,72 SAY "N/W "
SET COLOR OF NORMAL TO B/N
@ 3,0 SAY "B/N "
SET COLOR OF NORMAL TO B/B
@ 3,8 SAY "B/B "
SET COLOR OF NORMAL TO B/G
@ 3,16 SAY "B/G "
SET COLOR OF NORMAL TO B/BG
@ 3,24 SAY "B/BG "
SET COLOR OF NORMAL TO B/N+
@ 3,32 SAY "B/N+ "
SET COLOR OF NORMAL TO B/R
@ 3,40 SAY "B/R "
SET COLOR OF NORMAL TO B/RB
@ 3,48 SAY "B/RB "
SET COLOR OF NORMAL TO B/GR
@ 3,56 SAY "B/GR "
SET COLOR OF NORMAL TO B/GR+
@ 3,64 SAY "B/GR+ "
SET COLOR OF NORMAL TO B/W
@ 3,72 SAY "B/W "
SET COLOR OF NORMAL TO G/N
@ 4,0 SAY "G/N "
SET COLOR OF NORMAL TO G/B
@ 4,8 SAY "G/B "
SET COLOR OF NORMAL TO G/G
@ 4,16 SAY "G/G "
SET COLOR OF NORMAL TO G/BG
@ 4,24 SAY "G/BG "
SET COLOR OF NORMAL TO G/N+
@ 4,32 SAY "G/N+ "
SET COLOR OF NORMAL TO G/R
@ 4,40 SAY "G/R "
SET COLOR OF NORMAL TO G/RB
@ 4,48 SAY "G/RB "
SET COLOR OF NORMAL TO G/GR
@ 4,56 SAY "G/GR "
SET COLOR OF NORMAL TO G/GR+
@ 4,64 SAY "G/GR+ "
SET COLOR OF NORMAL TO G/W
@ 4,72 SAY "G/W "
SET COLOR OF NORMAL TO BG/N
@ 5,0 SAY "BG/N "
SET COLOR OF NORMAL TO BG/B
@ 5,8 SAY "BG/B "
SET COLOR OF NORMAL TO BG/G
@ 5,16 SAY "BG/G "
SET COLOR OF NORMAL TO BG/BG
@ 5,24 SAY "BG/BG "
SET COLOR OF NORMAL TO BG/N+
@ 5,32 SAY "BG/N+ "
SET COLOR OF NORMAL TO BG/R
@ 5,40 SAY "BG/R "
SET COLOR OF NORMAL TO BG/RB
@ 5,48 SAY "BG/RB "
SET COLOR OF NORMAL TO BG/GR
@ 5,56 SAY "BG/GR "
SET COLOR OF NORMAL TO BG/GR+
@ 5,64 SAY "BG/GR+ "
SET COLOR OF NORMAL TO BG/W
@ 5,72 SAY "BG/W "
SET COLOR OF NORMAL TO N+/N
@ 6,0 SAY "N+/N "
SET COLOR OF NORMAL TO N+/B
@ 6,8 SAY "N+/B "
SET COLOR OF NORMAL TO N+/G
@ 6,16 SAY "N+/G "
SET COLOR OF NORMAL TO N+/BG
@ 6,24 SAY "N+/BG "
SET COLOR OF NORMAL TO N+/N+
@ 6,32 SAY "N+/N+ "
SET COLOR OF NORMAL TO N+/R
@ 6,40 SAY "N+/R "
SET COLOR OF NORMAL TO N+/RB
@ 6,48 SAY "N+/RB "
SET COLOR OF NORMAL TO N+/GR
@ 6,56 SAY "N+/GR "
SET COLOR OF NORMAL TO N+/GR+
@ 6,64 SAY "N+/GR+ "
SET COLOR OF NORMAL TO N+/W
@ 6,72 SAY "N+/W "
SET COLOR OF NORMAL TO R/N
@ 7,0 SAY "R/N "
SET COLOR OF NORMAL TO R/B
@ 7,8 SAY "R/B "
SET COLOR OF NORMAL TO R/G
@ 7,16 SAY "R/G "
SET COLOR OF NORMAL TO R/BG
@ 7,24 SAY "R/BG "
SET COLOR OF NORMAL TO R/N+
@ 7,32 SAY "R/N+ "
SET COLOR OF NORMAL TO R/R
@ 7,40 SAY "R/R "
SET COLOR OF NORMAL TO R/RB
@ 7,48 SAY "R/RB "
SET COLOR OF NORMAL TO R/GR
@ 7,56 SAY "R/GR "
SET COLOR OF NORMAL TO R/GR+
@ 7,64 SAY "R/GR+ "
SET COLOR OF NORMAL TO R/W
@ 7,72 SAY "R/W "
SET COLOR OF NORMAL TO RB/N
@ 8,0 SAY "RB/N "
SET COLOR OF NORMAL TO RB/B
@ 8,8 SAY "RB/B "
SET COLOR OF NORMAL TO RB/G
@ 8,16 SAY "RB/G "
SET COLOR OF NORMAL TO RB/BG
@ 8,24 SAY "RB/BG "
SET COLOR OF NORMAL TO RB/N+
@ 8,32 SAY "RB/N+ "
SET COLOR OF NORMAL TO RB/R
@ 8,40 SAY "RB/R "
SET COLOR OF NORMAL TO RB/RB
@ 8,48 SAY "RB/RB "
SET COLOR OF NORMAL TO RB/GR
@ 8,56 SAY "RB/GR "
SET COLOR OF NORMAL TO RB/GR+
@ 8,64 SAY "RB/GR+ "
SET COLOR OF NORMAL TO RB/W
@ 8,72 SAY "RB/W "
SET COLOR OF NORMAL TO GR/N
@ 9,0 SAY "GR/N "
SET COLOR OF NORMAL TO GR/B
@ 9,8 SAY "GR/B "
SET COLOR OF NORMAL TO GR/G
@ 9,16 SAY "GR/G "
SET COLOR OF NORMAL TO GR/BG
@ 9,24 SAY "GR/BG "
SET COLOR OF NORMAL TO GR/N+
@ 9,32 SAY "GR/N+ "
SET COLOR OF NORMAL TO GR/R
@ 9,40 SAY "GR/R "
SET COLOR OF NORMAL TO GR/RB
@ 9,48 SAY "GR/RB "
SET COLOR OF NORMAL TO GR/GR
@ 9,56 SAY "GR/GR "
SET COLOR OF NORMAL TO GR/GR+
@ 9,64 SAY "GR/GR+ "
SET COLOR OF NORMAL TO GR/W
@ 9,72 SAY "GR/W "
SET COLOR OF NORMAL TO GR+/N
@ 10,0 SAY "GR+/N "
SET COLOR OF NORMAL TO GR+/B
@ 10,8 SAY "GR+/B "
SET COLOR OF NORMAL TO GR+/G
@ 10,16 SAY "GR+/G "
SET COLOR OF NORMAL TO GR+/BG
@ 10,24 SAY "GR+/BG "
SET COLOR OF NORMAL TO GR+/N+
@ 10,32 SAY "GR+/N+ "
SET COLOR OF NORMAL TO GR+/R
@ 10,40 SAY "GR+/R "
SET COLOR OF NORMAL TO GR+/RB
@ 10,48 SAY "GR+/RB "
SET COLOR OF NORMAL TO GR+/GR
@ 10,56 SAY "GR+/GR "
SET COLOR OF NORMAL TO GR+/GR+
@ 10,64 SAY "GR+/GR+ "
SET COLOR OF NORMAL TO GR+/W
@ 10,72 SAY "GR+/W "
SET COLOR OF NORMAL TO W/N
@ 11,0 SAY "W/N "
SET COLOR OF NORMAL TO W/B
@ 11,8 SAY "W/B "
SET COLOR OF NORMAL TO W/G
@ 11,16 SAY "W/G "
SET COLOR OF NORMAL TO W/BG
@ 11,24 SAY "W/BG "
SET COLOR OF NORMAL TO W/N+
@ 11,32 SAY "W/N+ "
SET COLOR OF NORMAL TO W/R
@ 11,40 SAY "W/R "
SET COLOR OF NORMAL TO W/RB
@ 11,48 SAY "W/RB "
SET COLOR OF NORMAL TO W/GR
@ 11,56 SAY "W/GR "
SET COLOR OF NORMAL TO W/GR+
@ 11,64 SAY "W/GR+ "
SET COLOR OF NORMAL TO W/W
@ 11,72 SAY "W/W "
SET COLOR OF NORMAL TO W/N


@ 13,29 SAY "Screen & Color Settings"
@ 14,1 TO 14,78 DOUBLE
@ 15,3 SAY "Normal color :"
@ 15,21 GET norm_color PICTURE "!!!!!!!"
@ 16,3 SAY "Titles color :"
@ 16,21 GET tit_color PICTURE "!!!!!!!"
@ 17,3 SAY "Highlight color:"
@ 17,21 GET high_color PICTURE "!!!!!!!"
@ 15,45 SAY "Message color:"
@ 15,61 GET mess_color PICTURE "!!!!!!!"
@ 16,45 SAY "Box color :"
@ 16,61 GET box_color PICTURE "!!!!!!!"
@ 17,45 SAY "Field color :"
@ 17,61 GET fiel_color PICTURE "!!!!!!!"
@ 18,21 SAY "Information color:"
@ 18,41 GET info_color PICTURE "!!!!!!!"
@ 20,12 SAY "Monochrome Systems can substitute either U (underline),"
@ 21,13 SAY "or I (inverse video) as a color. First color can also"
@ 22,08 SAY "have a + after the color, except the following: N, N+, GR,GR+."

READ
STORE make_model TO KEY
SELECT J
FIND &key
REPLACE i->driver WITH j->driver
SELECT I
*------------------------------------------------------------------------------
* Code here can/should be changed. Maybe require user to load all available
* printer drivers with application as this code is made under the assumption
* that all printer drivers are supplied on one disk.
IF curr_drvr # driver
CLEAR
@ 13,10 SAY "Insert the printer driver disk in the 'A' drive and press ENTER"
@ 17,00 SAY ''
WAIT
COPY FILE A:&driver
ENDIF (curr_drvr # driver)
*------- Now store the above information to system variables -----------------
_PDRIVER = driver
_PLOFFSET = loffset
_LMARGIN = lmargin
_PLENGTH = plength
_PSPACING = pspacing
_PEJECT = peject
_PWAIT = pwait
_PPITCH = ppitch
_PQUALITY = pquality
*------- Now for global variables
g_norm_clr = i->norm_color
g_mess_clr = i->mess_color
g_tit_clr = i->tit_color
g_box_clr = i->box_color
g_high_clr = i->high_color
g_info_clr = i->info_color
g_fiel_clr = i->fiel_color
g_prin_prt = i->print_port
g_driver = i->driver
g_loffset = i->loffset
g_lmargin = i->lmargin
g_plength = i->plength
g_pspacing = i->pspacing
g_peject = i->peject
g_pwait = i->pwait
g_ppitch = i->ppitch
g_pquality = i->pquality

*------- Now set colors as specified ------------------------------------------
SET COLOR OF NORMAL TO &g_norm_clr
SET COLOR OF MESSAGE TO &g_mess_clr
SET COLOR OF TITLE TO &g_tit_clr
SET COLOR OF BOX TO &g_box_clr
SET COLOR OF HIGHLIGHT TO &g_high_clr
SET COLOR OF INFORMATION TO &g_info_clr
SET COLOR OF FIELDS TO &g_fiel_clr
SET PRINTER TO &g_prin_prt

*-- file exit code --------------------------------------------------------------
SAVE ALL LIKE g_* TO global
DO c_sysdef
DO c_help
ON KEY LABEL f1
ON KEY LABEL f2
SET PROCEDURE TO


*------------------------------------------------------------------------------
*-- Notes...: Procedures for VALID POPUPs and/or Context Sensitive Help
*-- ........: for SYSDEF.FMT
*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Procedure: S_SYSDEF
*!
*! Called by: SYSDEF.PRG
*!
*! Uses: PRINTERS.DBF
*!
*! MDX files: PRINTERS.MDX
*!
*!*********************************************************************
PROCEDURE s_sysdef && Open files and Define POPUPs
USE printers ORDER make_model IN J again

DEFINE POPUP u_make_m FROM 3,31 TO 21,74 PROMPT FIELD make_model ;
MESSAGE "Select from list using ENTER, cancel selection with ESC"

ON SELECTION POPUP u_make_m DEACTIVATE POPUP

SELECT I

*-- EOP: s_SYSDEF
RETURN

*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Procedure: C_SYSDEF
*!
*! Called by: SYSDEF.PRG
*!
*! Uses: IN.DBF
*!
*!*********************************************************************
PROCEDURE c_sysdef && Close files and Release POPUPs
USE IN J

RELEASE POPUP u_make_m

SELECT I

*-- EOP: c_SYSDEF
RETURN

*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Function: EMPTY()
*!
*!*********************************************************************
FUNCTION EMPTY && Determine if the passed argument is NULL
PARAMETER X
mtype = TYPE("x")
DO CASE
CASE mtype = "C"
retval = (LEN(TRIM(X))=0)
CASE mtype$"NF"
retval = (X=0)
CASE mtype = "D"
retval = (" "$DTOC(X))
ENDCASE
*-- EOP: empty
RETURN (retval)

*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Function: U_MAKE_M()
*!
*! Called by: SYSDEF.PRG
*!
*! Calls: SHADOWG (procedure in SYSDEF.PRG)
*!
*!*********************************************************************
FUNCTION u_make_m
PARAMETER fld_name

esckey = 27 && 27 represents the ESC key

SELECT J && Select the lookup file

SEEK TRIM(fld_name)
IF .NOT. FOUND()

SAVE SCREEN TO systemp && a UDF (UnDocumented Feature) uses 4K
DO shadowg WITH 3,31,21,74
ACTIVATE POPUP u_make_m
RESTORE SCREEN FROM systemp
RELEASE SCREEN systemp && have to free up the 4K save screen uses

IF LASTKEY() <> esckey
rtn_fld = PROMPT()
@ 3,31 GET rtn_fld PICTURE "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!"
CLEAR GETS

REPLACE i->make_model WITH rtn_fld
SELECT I
RETURN (.T.)
ELSE
SELECT I
RETURN (.F.)
ENDIF (LASTKEY() <> EscKey)

ELSE
SELECT I
RETURN (.T.)
ENDIF (.NOT. FOUND())

SELECT I && Go back to the edit file

*-- EOP: U_make_m
RETURN (.F.)

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

*!*********************************************************************
*!
*! Procedure: S_HELP
*!
*! Called by: SYSDEF.PRG
*!
*! Calls: TOGGLE (procedure in SYSDEF.PRG)
*!
*! Uses: SYSDEF_H.DBF
*!
*! MDX files: SYSDEF_H.MDX
*!
*!*********************************************************************
PROCEDURE s_help
*-- Opens the HELP .dbf file
PRIVATE lc_cat, lc_dbf, lc_order, t, l, B, R
t = 5
l = 6
B = 15
R = 74
DEFINE WINDOW z_help FROM t+1,l+1 TO B-1,R-1 NONE
ON KEY LABEL f3 DO toggle
ON ERROR mvar=ERROR()
SELECT H
lc_cat = SET("CATALOG")
lc_dbf = DBF() && Grab dbf if any
lc_order = ORDER() && Same for ORDER
USE sysdef_h ORDER fld_name noupdate && Open HELP .dbf
SELECT I
RETURN
*-- EOP: s_Help

*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Procedure: C_HELP
*!
*! Called by: SYSDEF.PRG
*!
*! Uses: IN.DBF
*! : (LC_DBF).DBF
*!
*!*********************************************************************
PROCEDURE c_help
*-- Closes the HELP .dbf file
USE IN H
IF lc_cat = "ON"
SET CATALOG TO (lc_dbf)
ELSE
SELECT H
IF "" <> lc_dbf && If there was a dbf reopen it
USE (lc_dbf)
ENDIF ("" <> lc_dbf && If there was a dbf reopen it)
IF "" <> lc_order
SET ORDER TAG &lc_order. && Same for index.
ENDIF ("" <> lc_order)
ENDIF (lc_cat = "ON")
ON KEY LABEL f3
RELEASE WINDOW z_help
ON ERROR
RELEASE lc_cat, lc_dbf, lc_order, t, l, B, R
SELECT I
RETURN
*-- EOP: c_Help

*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Procedure: HELP
*!
*! Called by: SYSDEF.PRG
*!
*! Calls: SHADOWG (procedure in SYSDEF.PRG)
*! : EXPLODE (procedure in SYSDEF.PRG)
*! : SHRINK (procedure in SYSDEF.PRG)
*!
*!*********************************************************************
PROCEDURE HELP
*-- Activates the HELP window
PARAMETER lc_var && value returned by VARREAD()
SELECT H
SEEK lc_var
IF FOUND() && If found, show Help
SAVE SCREEN TO zz_help && a UDF (UnDocumented Feature) uses 4K
DO shadowg WITH t,l,B,R
DO explode WITH t,l,B,R

@ t,l TO B,R DOUBLE
ln_memline = SET("MEMO")
SET MEMOWIDTH TO 65
IF MEMLINES(fld_help) > 9
@ t+1,R SAY CHR(24)
@ B-1,R SAY CHR(25)
ENDIF (MEMLINES(fld_help) > 9)
lc_string = [¹ Help for ] + TRIM(fld_headng) +[ Ì]
@ t,CENTER(lc_string,80) SAY lc_string
@ 0,0 GET fld_help OPEN WINDOW z_help ;
MESSAGE "Scroll thru Help: Ctrl-Home Exit Viewing Help: Ctrl-End See Org. Screen: F3"
READ
SET MEMOWIDTH TO ln_memline
DO shrink WITH t,l,B,R
RESTORE SCREEN FROM zz_help
RELEASE SCREEN zz_help
ENDIF (FOUND() && If found, show Help)
SET MESSAGE TO
SELECT I && Back to edit work area
RETURN
*-- EOP: HELP

*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Procedure: TOGGLE
*!
*! Called by: S_HELP (procedure in SYSDEF.PRG)
*!
*!*********************************************************************
PROCEDURE toggle
*-- Toggles the Help message back to the original screen
SAVE SCREEN TO toggle && a UDF (UnDocumented Feature) uses 4K
RESTORE SCREEN FROM zz_help
SET MESSAGE TO "Press any key..."
mwait = INKEY(15)
RESTORE SCREEN FROM toggle
RELEASE SCREEN toggle
SET MESSAGE TO "Scroll thru Help: Ctrl-Home Exit Viewing Help: Ctrl-End See Org. Screen: F3"
RETURN
*-- EOP: Toggle

*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Function: CENTER()
*!
*!*********************************************************************
FUNCTION CENTER
*-- UDF to center a string.
*-- lc_string = String to center
*-- ln_width = Width of screen to center in
*--
*-- Ex. @ 15,center(string,80) say string
*-- Will center the within 80 columns
PARAMETER lc_string, ln_width
RETURN ((ln_width/2)-(LEN(lc_string)/2))
*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Procedure: SHADOW
*!
*!*********************************************************************
PROCEDURE SHADOW && displays shadow
PARAMETER x1,y1,x2,y2,dfill

IF dfill && use fill command not window

@ x1+1,y1+2 FILL TO x2+1,y2+2 COLOR N+/N

ELSE && define shadow window

DEFINE WINDOW shadow_win FROM x1+1,y1+2 TO x2+1,y2+2 NONE COLOR N+/N
ACTIVATE WINDOW shadow_win

ENDIF (dfill && use fill command not window)

RETURN
*-- EOP: shadow

*------------------------------------------------------------------------------
*!*********************************************************************
*!
*! Procedure: SHADOWG
*!
*! Called by: HELP (procedure in SYSDEF.PRG)
*! : U_MAKE_M() (function in SYSDEF.PRG)
*!
*!*********************************************************************
PROCEDURE shadowg && displays shadow that grows
PARAMETER x1,y1,x2,y2
* x1 = Top Right Corner
* y1 = Top Left Corner
* x2 = Bottom Right Corner
* x3 = Bottom Left Corner


x0 = x2+1
y0 = y2+2
dx = 1
dy = (y2-y1) / (x2-x1)
DO WHILE x0 <> x1 .OR. y0 <> y1+2

@ x0,y0 FILL TO x2+1,y2+2 COLOR N+/N
x0 = IIF(x0<>x1,x0 - dx,x0)
y0 = IIF(y0<>y1+2,y0 - dy,y0)
y0 = IIF(y0 ENDDO (x0 <> x1 .OR. y0 <> y1+2)

RETURN
*-- EOP: shadowg
* Program...: EXPLODIN.PRG
* Author....: Steve Silverwood
* Date......: 11/17/1989
* Versions..: dBASE IV 1.0
* Notes.....: Illustrates making windows appear to "explode" from a
* position on the screen to the desired dimensions.
* MODIFIED 8 MAY 90 BY CARL R. PERKINS, NJ5J DATASMITH INC.

*!*********************************************************************
*!
*! Procedure: EXPLODE
*!
*! Called by: HELP (procedure in SYSDEF.PRG)
*!
*!*********************************************************************
PROCEDURE explode
ON ERROR RETURN
* ? "Exploding a window..."

PRIVATE tl_v, tl_h, br_v, br_h, counter

* tl_v = 11 && Top left vertical start/end position.
* tl_h = 39 && Top left horizontal start/end position.
* br_v = 13 && Bottom right vertical start/end position.
* br_h = 41 && Bottom right horizontal start/end position.

DO WHILE (tl_v >= 3) .AND. (tl_h >= 23) .AND. (br_v <= 21) .AND. (br_h <= 57)
DEFINE WINDOW boom FROM tl_v,tl_h TO br_v,br_h
ACTIVATE WINDOW boom
tl_v = tl_v - 1
tl_h = tl_h - 2
br_v = br_v + 1
br_h = br_h + 2
ENDDO ((tl_v >= 3) .AND. (tl_h >= 23) .AND. (br_v <= 21) .AND. (br_h <= 57))
DEACTIVATE WINDOW boom
RELEASE WINDOW boom
RETURN
*-- EOP: EXPLODE

*!*********************************************************************
*!
*! Procedure: SHRINK
*!
*! Called by: HELP (procedure in SYSDEF.PRG)
*!
*!*********************************************************************
PROCEDURE shrink
* Program...: EXPLODIN.PRG && This came out of the original program
* Author....: Steve Silverwood
* Date......: 11/17/1989
* Versions..: dBASE IV 1.0
* Notes.....: Illustrates making windows appear to "explode" from a
* position on the screen to the desired dimensions.
* MODIFIED 8 MAY 90 BY CARL R. PERKINS, NJ5J DATASMITH INC.
* Added parameter statement to pass varibles to window coordinates
* on 22 May '90 , Bill Ferguson, ("fergie" on ATBBS)
PARAMETERS tl_v, tl_h, br_v, br_h

ON ERROR RETURN

PRIVATE tl_v, tl_h, br_v, br_h

tl_v = 11 && Top left vertical start/end position.
tl_h = 39 && Top left horizontal start/end position.
br_v = 13 && Bottom right vertical start/end position.
br_h = 41 && Bottom right horizontal start/end position.


DO WHILE (tl_v <= 11) .AND. (tl_h <= 39) .AND. (br_v >= 13) .AND. (br_h >= 41)
DEFINE WINDOW boom FROM tl_v,tl_h TO br_v,br_h
ACTIVATE WINDOW boom
tl_v = tl_v + 1
tl_h = tl_h + 2
br_v = br_v - 1
br_h = br_h - 2
ENDDO ((tl_v <= 11) .AND. (tl_h <= 39) .AND. (br_v >= 13) .AND. (br_h >= 41))

DEACTIVATE WINDOW boom
RELEASE WINDOW boom
RETURN
*-- EOP: SHRINK

*-- EOP: SYSDEF.PRG

*: EOF: SYSDEF.PRG