TestDrive Windows 1993 Fall/TestDrive Windows 1993 Fall.iso/dbase/form.gen

Text File | 1993-03-09 | 29.0 KB | 766 lines

Format (.fmt) File Template with POPUP field validation
-------------------------------------------------------
Copyright (c) 1987, 1990, 1991, 1992 Borland International, Inc.


This template will support POPUPs for VALID clause field validations and
context sensitive help for each field.

Example: In "ACCEPT value when" under "Edit options" enter,
        "POPUP" = "vendor->vendor_id ORDER vendor_id REQ SHADOW"
        --------------------------------------------------------
        this will activate a popup if the data entered is invalid for
        that field and will also make the field REQUIRED.

Explanation of the POPUP string follows:

POPUP              Indicates that a popup will be used for this field.
vendor->vendor_id  Indicates the .DBF to open and FIELD to use as validation.
ORDER vendor_id    Indicates which INDEX TAG to SEEK in.
REQ                Indicates the FIELD requires data (can't be empty).
                   Leave REQ out if the field is NOT required.      OPTIONAL!
SHADOW             Use shadowing effect on popups                   OPTIONAL!
NOTE: The POPUP string must be entered with the quotes as in the example.

--------------------------------------------------------------------------------

Explanation of the Context Sensitive Help file follows:

If you want to create your own help file, here is the structure that is required.

Structure for Help Database (.dbf):
<first 6 chars. of the format file name>_H.dbf

Field   Field Name  Type        Width  Dec   Tag
-------------------------------------------------
    1   FLD_NAME    Character     10         Yes  Field name to lookup on F1
    2   FLD_HEADNG  Character     25          No  Heading to show user on window
    3   FLD_HELP    Memo          10          No  Help text to show user
-------------------------------------------------
        Total                     46
ε¡¢(x▐»╛∩.¼:
88

;<.▐:
86

(=


8m
8n

;.°:
8m
8n

;.,:
6'
8;

8<
8?


>
;<.g:


>

5e80

8n




.=<<.Ü:


8<
8=


8<
8>

;<.╢:
/»
.┤;<.#    :
    dbtmp8g

/▌    dbtmp8g

.τ    tmp8g

8T



/    

86


8<
    
\1    
    
\
>
;<.[    :

8;

8T



86


2V        
0
.Y    
;<.Å    :8w

8v


8<


8x

;<        dtl_debug8g

/╧    8y

    Pick the debug level you want8z

8â
    1
    
,
8é


8\

0
    ;╡1V
    :Can't use FORM.GEN on non-form objects.  Press any key ...8N

.å    
80

    %$
    
"(
8<
88

8>

(
8<
88

8>


    U_
9ús'8k

0+..9Ö?/å9Φ49É9W9⌠929ñ40s/x9óG    .fmo8{

;.S:


*-- Format file initialization code --------------------------------------------

*-- Some of these PRIVATE variables are created based on CodeGen and may not
*-- be used by your particular .fmt file
PRIVATE ll_talk, ll_cursor, lc_display, lc_status, ll_carry, lc_proc

IF SET("TALK") = "ON"
  SET TALK OFF
  ll_talk = .T.
ELSE
  ll_talk = .F.
ENDIF
ll_cursor = SET("CURSOR") = "ON"
SET CURSOR ON
lc_display = SET("DISPLAY")
9mr
lc_status = SET("STATUS")
*-- SET STATUS was /╤
ON when you went into the Forms Designer.
IF lc_status = "OFF"
   SET STATUS ON
.$
OFF when you went into the Forms Designer.
IF lc_status = "ON"
   SET STATUS OFF

ENDIF
j8F



8I

0≈X

/\
,@

80

    
M2∩¬

/∩6∩,    wndow    
,
9╤A


*-- Window for memo field =

9k
?
.
DEFINE WINDOW 
9=
?
,.98B

/┤

ll_carry = SET("CARRY") = "ON"
SET CARRY ON
*-- Fields to carry forward during APPEND.
SET CARRY TO)8S

?
&& Clear previous SET CARRY TO list
SET CARRY TO 9ä>?


9A/

ON KEY LABEL F2 ?? chr(7)

9█h
DO S_?)8S

?
&& Open up Lookup Files

9qA/Q0(9█h
ON KEY LABEL F1 DO Help WITH VARREAD()
<<.≡:

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

*--  Format Page: 
?

Φ8F

8I

0ε½
W
9┐9&9╤A
/:
READ

*-- Format Page: ?




=1Z

j2?

2á
*-- Calculated field: =
9k
?
 - L
?

?
2╪
*-- Memory variable: =
9k
?


@ ß
9₧
?
,]
9₧
?
 

>2 
@ 9ä=
?

.├
SAY _
8-

 6¡_
86


2v
CHR(_
8-

?
) .⌐
REPLICATE(CHR(_
8-

?
), _
86

?
) .≈_


8<
    
"2╪    
[    
]>_
?
     
">9┐<?.▀á
í
9b<?9┐<?.▀W
0┌
SAY ?

2yM8F
8I

0rM?,.S
 .▓?
2ô    .£    m->>=
9k
?
 9ß8
/╓
PICTURE "9┌

" .¿
GET ?
2    $0<
$>.    m->>=
9k
?
 @
80

    
M2ç¬
/ç6[,>¬

2r
OPEN 
WINDOW wndow?
 9ß8
/⌐
PICTURE 92

 O
0┐P
/

;
   RANGE W
!/≡
REQUIRED O
?P
/
,P
?
 S
/Ω

;
    POPUPS
87

8=

8.
    
227
    7Picklist coordinates exceed column 79 - move field left9&9/7
   VALID W
!0╔S
9÷D
/╘
REQUIRED =
9╨D
?
( =
9k
?
 )     .AND.S
8=

8.


43S

8<
?
 .ì    POPUPS
87

8=

8.
    
21ì
   VALID W
!/é
REQUIRED S
?
 T
/Ω
;
   ERROR     IIFT
8=

8.
0┬
"T
?    IIFT
8=

8.
0τ
"
 R
/

;
   WHEN R
?
 Q
/A

;
   DEFAULT Q
?
 c
/¿

;
   MESSAGE     IIFc
8=

8.
0Ç
"c
?    IIFc
8=

8.
0Ñ
"
 9┐<?.▀.µ.▀7=+>j".╗

,,.Θ<<..:
*-- Format file exit code -----------------------------------------------------

*-- SET STATUS was /
ON when you went into the Forms Designer.
IF lc_status = "OFF"  && Entered form with status off
   SET STATUS OFF     && Turn STATUS "OFF" on the way out
.¥
OFF when you went into the Forms Designer.
IF lc_status = "ON"  && Entered form with status on
   SET STATUS ON     && Turn STATUS "ON" on the way out

ENDIF
/╓
IF .NOT. ll_carry
  SET CARRY OFF
ENDIF

IF .NOT. ll_cursor
  SET CURSOR OFF
ENDIF

IF SET( "DISPLAY" ) <> lc_display
  SET DISPLAY TO &lc_display.      && Reset Screen size if changed
ENDIF

/º
RELEASE WINDOWS 
86


<
?



RELEASE /─
ll_carry,
lc_fields,lc_status
/⌠

ON KEY LABEL F1
0/¡
ON KEY LABEL F2
/L
DO C_?)8S

?
&& Close up Lookup Files

SET PROCEDURE TO (lc_proc))8S

?
&& Re-Establish any open procedure file
RELEASE lc_proc

IF TYPE( "ll_echo" ) = "L"
  IF ll_echo
    SET ECHO ON
  ENDIF
ENDIF
IF ll_talk
  SET TALK ON
ENDIF
*-- EOP: 83

?
FMT
<<.╓:    
"Jü
8.
0[    
'Jü
8.
/g    
[    
]?Kü
/ƒ
@Kü
?    
SKü
8.
/£╖ü
?
     
MKü
8.
/╛┤ü
?.╞Jü
??    
"<<..:Kü
/
@Kü
?    
SKü
8.
/╖ü
?
     
MKü
8.
0,Jü
?<<.á4:/₧49`@0L;96?
PROCEDURE S_?

*--------------------------------------------------------------------------------
* DESCRIPTION
*   Open data (.dbf) files for Lookup operations & faster processing
*--------------------------------------------------------------------------------
  PRIVATE lc_alias, ll_esc
  ll_esc = SET( "ESCAPE" ) = "ON"
  SET ESCAPE OFF
  lc_alias = ALIAS())8S

?
&& Capture current alias

j8F

8I

0E$    POPUPS
87

8=

8.
    
22.
.3##/=$S
9ôB
9k




8<
8-

/4É:6É    
A
.ô
S
9≥B
    S
9╗C

8=

<
2╥
.╫    
,
%8.
0=$%    
,
%
  IF TYPE("g_
8>

?
") = "U"
    PUBLIC g_
8>

?


    IF SELECT("
?
") = 0
      IF FILE( "
?
.DBF" )
        SELECT SELECT()
        USE 
?
 NOLOG ALIAS ?

        g_
8>

?
 = 1)8S

?
&& File was opened for the first time
        IF TAGNO( "    ?
" ) = 0
          DO _Err_Box WITH [    ORDER TAG not found:?
 ] + [    ?
]
          USE
          RELEASE g_
8>

?

          RELEASE gl_
?

          PUBLIC gl_
?

        ENDIF
        IF TYPE( "?
->?
" ) = "U"
          DO _Err_Box WITH [    Variable not found:?
 ] + [?
->?
]
          USE
          RELEASE g_
8>

?

          RELEASE gl_
?

          PUBLIC gl_
?

        ENDIF
      ELSE
        DO _Err_Box WITH "
?
.DBF " + [
not found!?
]
        RELEASE g_
8>

?

        RELEASE gl_
?

        PUBLIC gl_
?

      ENDIF
    ELSE
      g_
8>

?
 = 2)8S

?
&& File was opened outside of this program
    ENDIF

  ELSE
    *-- File was already opened by a program generated from Form.gen
    g_
8>

?
 = g_
8>

?
 + 1
  ENDIF

,.⌡
  SELECT ( lc_alias )
  IF ll_esc
    SET ESCAPE ON
  ENDIF
RETURN
*-- EOP: S_?



PROCEDURE C_?

*--------------------------------------------------------------------------------
* DESCRIPTION
*   Close Lookup files on exit of the .fmt, if they are not used
*   by other calling .fmt files
*--------------------------------------------------------------------------------
  PRIVATE ll_esc
  ll_esc = SET( "ESCAPE" ) = "ON"
  SET ESCAPE OFF
    %j8F

8I

0²'    POPUPS
87

8=

8.
    
22S&
.X&##/⌡'S
9ôB




8<
8-

/4»&:6»&    
A
.▓&
    
,
%8.
0⌡'%    
,
%
  DO CASE
    CASE TYPE("g_
8>

?
") = "U"
      *-- Exiting out of the form!  Lookup file was not opened up properly
      RELEASE gl_
?

    CASE g_
8>

?
 = 1
      USE IN ?

      RELEASE g_
8>

?

    OTHERWISE
      g_
8>

?
 = g_
8>

?
 - 1
  ENDCASE
,.&

  IF ll_esc
    SET ESCAPE ON
  ENDIF
RETURN
*-- EOP: C_?



j8F

8I

0é4    POPUPS
87

8=

8.
    
22Ü(
.ƒ(#9╤A
#/z4ß
9₧
!]
9₧
"S
9ôB




8<
8-

/4"):6")    
A
.%)
S
9≥B
    S
9╗C
½
W
9┐9&    9&9/z4
FUNCTION =
9╨D
?

PARAMETER fld_name
*    
-E8V
?

  PRIVATE ALL LIKE l?_*
  PRIVATE esckey, fld_name, rtn_fld
  ll_esc = SET( "ESCAPE" ) = "ON"
  SET ESCAPE OFF
  ll_return = .F.
  IF TYPE( "gl_
?
" ) = "L")8S

?
&& Was lookup file opened?
    IF ll_esc)8S

?
&& It wasn't, so return back to the form
      SET ESCAPE ON
    ENDIF
    RETURN(.T.))8S

?
&& With no data validation
  ENDIF
S
9÷D
0π+
  IF ISBLANK(fld_name))8S

?
&& Not a required field
    IF ll_esc
      SET ESCAPE ON
    ENDIF
    RETURN (.T.))8S

?
&& Return since it's a blank field
  ENDIF


  EscKey = 27)8S

?
&& 27 represents the ESC key

  lc_alias = ALIAS())8S

?
&& Grab current workarea
  SELECT ?)8S

?
&& Select the lookup file
  lc_order = ORDER())8S

?
&& Save any existing order
  SET ORDER TO     ?)8S

?
&& Set the order to the lookup key

  ll_exact = SET("EXACT") = "ON")8S

?
&& Store value of EXACT
  SET EXACT ON

@
80

    
C2╜-
  fld_name = IIF( ISBLANK( TRIM( fld_name)), fld_name, TRIM( fld_name))

  SEEK fld_name

  IF .NOT. ll_exact)8S

?
&& Restore SET EXACT to org. value
    SET EXACT OFF
  ENDIF

  IF .NOT. FOUND()

    DEFINE POPUP S
9 D
?
 FROM !6┴.!
?
,"?
 ;
        TO 
?
,J
86

"
?
 ;
./!?
,"?
 ;
        TO !
?
,J
86

"
?
 ;

        PROMPT FIELD ?
 ;
        MESSAGE     8[Press the Enter key to select or the Esc key to cancel]?


    ON SELECTION POPUP S
9 D
?
 DEACTIVATE POPUP

@
80

    
C2σ/
    KEYBOARD TRIM(fld_name)

    SAVE SCREEN TO temp
S
9UE
/ä0
    5Shadow coordinates exceed column 79 - move field left9&9/ä0
    DO shadowg WITH J
9KD




    ACTIVATE POPUP S
9 D
?


    rtn_fld = PROMPT())8S

?
&& Get user choice from pick list
    ln_bar = BAR())8S

?
&& Capture bar number to check for esc

    RELEASE POPUP S
9 D
?


    RESTORE SCREEN FROM temp

    IF ln_bar <> 0
      @ !?
,"?
 GET rtn_fld 9ß8
/╫1
PICTURE 92

 9┐<?

      CLEAR GETS

      REPLACE <
9k
?
->=
9k
?
 WITH @
80

    
C2C2
rtn_fld
.R2
VAL(rtn_fld)


      ll_return = .T.
    ELSE
      ll_return = .F.
S
9÷D
03
      IF ISBLANK(fld_name))8S

?
&& Not a required field, so return
        ll_return = .T.
      ENDIF


    ENDIF

  ELSE
    ll_return = .T.
  ENDIF

  IF .NOT. ISBLANK( lc_order ))8S

?
&& If there was a order on lookup file
    SET ORDER TO ( lc_order ))8S

?
&& Set it back to its original setting
  ENDIF

  SELECT (lc_alias))8S

?
&& Go back to the edit file

  IF ll_esc
    SET ESCAPE ON
  ENDIF
RETURN (ll_return)
*-- EOP: =
9╨D
?


,.a(    
-N8V
    
*8B



<<.Σ4:/╧40╩49`@0┼4;969╝X0▌4/Γ49║E<<.6:83

86




8<
    
.2<5


<
    .FMT.I5    .FMT
*    
-E8V
?

* Name.......: ?

* Date.......: 8M

8<
87

?

* Version....: dBASE IV, Format     2.0?

* Notes......: Format files use "" as delimiters!
*    
-E8V
?

<.▌8:83

86




8<
    
.2e6


<
    .FMT.r6    .FMT
*    
-E8V
?

* Name....: U_(
8<
88

?
.PRG
* Date....: 8M

8<
87

?

* Version.: dBASE IV, Procedure for Format     2.0?

* Notes...: Procedure file for VALID POPUPs and/or Context Sensitive Help
*           for ?

$/╜7
*           The Master file for the form is assumed to be $?
.

*    
-E8V
?

8P

?
PRIVATE ll_oldtalk
IF SET( "TALK" ) = "ON"
  SET TALK OFF
  ll_oldtalk = .T.
ELSE
  ll_oldtalk = .F.
ENDIF

*--     Can't run a procedure file!?

DO _Err_Box WITH "    Can't run a procedure file!?
"

IF ll_oldtalk
  SET TALK ON
ENDIF
8P

?
RETURN


<."9:Jü
/@ü
80

    
D1@ü
80

    
M1
;;<.╗9:]ü
9₧
Jü
86

P4┤9/«990
8o

=ü
    Error on Field: =9░9░    Press any key ...8N

;
;<.^<:    Ç
!
!

!0∙9

!/·9p
!
!
!
!0T</J:>1√:1√:
.╝:    
n.≈:    
b.≈:    
g.≈:    bg.≈:    
r.≈:    rb.≈:    gr.≈:    
w.≈:7i:
s:}:ç:Æ:£:º:▓:.;    
w>/;    
i>/);    
u>/<;    
+>/O;    
*>    
/1*<1*<.δ;    
n.&<    
b.&<    
g.&<    bg.&<    
r.&<    rb.&<    gr.&<    
w.&<7x;
å;ö;ó;▒;┐;╬;▌;.6<    
n>/T</T<    
,>8T

;<.╗<:

.₧<    
 
.╢<     DOUBLE 
.╢<     CHR(    ) 
.╢<7l<
v<ç<
;<.=:
    
&86

4=/÷<    
;8U


>
    COLOR &    
 
>
;<.Ç=:
    wndow     FROM 
9ä=

áü
íü
9b<

½ü
Wü
9┐9&9┐<


;<.Ç>:úü
9₧
ßü
9₧
óü
9₧
Ÿ
/⌠=1⌠=

    
,

     TO 
Ñü
=
4Z>
    
,ñü
=


;<.ò?:
    j8F



8I

0ä?X

/|?=

    
,86

=

    
,86

            Φ4?    SET CARRY TO 8B

    >K4D?    
;      8B

>=

9k
0o?8B


.{?    
,8B

>
,.¿>         ADDITIVE8B

<<.\@:8l

*(8Y

0σ?0╘?(.Σ?    
:(>    .fmt8C

0U@82

    .fmt    - can't be opened - possible read only file.      Press any key ...8N

;
;<.A:
*    u_(
8<
88



    .prg8C

0≤@
    .prg    - can't be opened - possible read only file.      Press any key ...8N

;
    .DBO8{



;<.mA:
j8F



8I

0hA    POPUPS

87

8=

8.
    
22`A
.hA
,.$A;<.═A:82


8<
*    _H      .dbf8W

/╚A     .dbt8W

/╚A
>;<.)B:ßü
9₧


4"B



;;<.ÅB:
8=

8.


2XB
    ;


<

86


86

8<
;<.εB:    ->
    
=
9-B8/


8.
<
9k
;<.╖C:    ORDER 


9-B    
 8.
2OC
86


<
.½C    
"8.
1æC6æC

<
.½C

<
>9k
;<.D:    ->


9-B    
 8.
2°C.D

<
9k
;<.GD:
9╗C

8<
    u_8>

;<.╠D:!6ôD!
?
,"?
,
?
,
86

"
?

.╩D!?
,"?
,!
?
,
86

"
?

<<.≥D:

8<
    u_9k
;<.QE:     REQ 
8=

8.
/E
.E0ME     REQ"
8=

8.
/DE
.IE/NE;<.╢E:     SHADOW 
8=

8.
/|E
.üE0▓E     SHADOW"
8=

8.
/⌐E
.«E/│E;<.₧G:
PROCEDURE Shadowg
*    
-E8V
?

* DESCRIPTION
*   Displays shadow that grows.  Specify the same coord and the
*   window or popup to shadow.
*    
-E8V
?

  PARAMETER x1,y1,x2,y2
  PRIVATE   x1,y1,x2,y2

  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<y1+2,y1+2,y0)
  ENDDO

RETURN
*-- EOP: shadowg

<<.╕X:
PROCEDURE _Err_Box
PARAMETERS pc_msg
*----------------------------------------------------------------------------
* NAME
*   _Err_Box - Display an error box
*
* SYNOPSIS
*   DO _Err_Box WITH <pc_msg>
*
* DESCRIPTION
*   _Err_Box will display the <pc_msg> string in a box and prompt the
*   user to press any key to continue processing.  _Err_Box will display
*   the message based on the length of <pc_msg>.
*
* PARAMETERS
*   pc_msg - the error message to display in the box.  If the length is
*            greater than 76, the trailing part is chopped off.
*
* EXAMPLE
*   DO _Err_Box WITH "Incorrect window size"
*   Displays the message in a window as follows at row 9 on the screen:
*                      +------------------------------+
*                      |                              |
*                      |    Incorrect window size     |
*                      |                              |
*                      | Press any key to continue... |
*                      |                              |
*                      +------------------------------+
*   Note that the width of the window will increase to accommodate a longer
*   message string.
*
* LIMITATIONS
*   Truncates the message after 76 characters.  Assumes an 80 character
*   wide screen.  Looks best with SET CURSOR OFF.
*
*----------------------------------------------------------------------------

  PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,;
          ll_escape

  lc_anykey = [Press any key to continue...]
  ln_press  = LEN( lc_anykey )
  lc_win = WINDOW()                     && Currently activated window if any
  lc_msg = LTRIM( RTRIM( pc_msg ) )     && Trimmed message
  ln_msglen = LEN( lc_msg )             && Trimmed length of message
  ln_width = 0                          && Width of display area in window.
  ll_escape = SET("ESCAPE") = "ON"
  IF TYPE( "FXL_DEV" ) = "L" .AND. FXL_DEV
    SET ESCAPE ON
  ELSE
    SET ESCAPE OFF
  ENDIF

  *-- Determine the width needed for the window:
  IF ln_msglen <= ln_press
    ln_width = ln_press
  ELSE
    *-- Make sure the message fits in the window:
    IF ln_msglen > 76
      lc_msg = LEFT( lc_msg, 76 )
      ln_msglen = 76
    ENDIF
    ln_width = ln_msglen
  ENDIF
  DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ;
                TO 15, (ln_width + 83) / 2 DOUBLE
  ln_width = ( ln_width + 2 )

  *-- Display the message and prompt to the window and wait for a key press
  ACTIVATE WINDOW _err_box
  @ 1, ( ln_width - ln_msglen ) / 2 SAY lc_msg
  @ 3, ( ln_width - ln_press ) / 2 SAY lc_anykey
  SET CONSOLE OFF                       && For mouse click recognition
  WAIT
  SET CONSOLE ON

  *-- Clean up the window display and reactivate the previous window
  RELEASE WINDOW _err_box
  IF ISBLANK( lc_win )
    ACTIVATE SCREEN
  ENDIF

  IF ll_escape
    SET ESCAPE ON
  ELSE
    SET ESCAPE OFF
  ENDIF

RETURN
*-- EOP: _Err_Box WITH pc_msg


FUNCTION _Rat
PARAMETERS pc_source, pc_target
*--------------------------------------------------------------------
* NAME
*   _RAT - Version of AT() that starts from right.
*
* SYNOPSIS
*   _RAT( <expC>, <expC> )
*
* DESCRIPTION
*   _RAT() takes two arguments, a source string and a target
*   string.  It searches for the first occurrence of the source
*   within the target beginning on the right end of the string,
*   and returns an integer representing the first character
*   position of the matching occurrence.
*
*   If the source string is not contained within the target
*   string, if the source string is longer than the target
*   string, or if the source string is null, 0 is returned.
*
* PARAMETER(S)
*   The first parameter is the string to find.  The second
*   parameter is the string to search in.  In theory, any
*   character expression should be legal.
*
* EXAMPLE(S)
*
*   ? _RAT("A","ABABA")                      && Returns 5
*   lc_var = _RAT("A test","A test A test")  && Returns 8
*   ? _RAT("Long string","short")            && Returns 0
*
*--------------------------------------------------------------------

   PRIVATE lc_len

   m->lc_len = LEN( m->pc_target )

   DO WHILE m->lc_len > 0
     IF m->pc_source $ SUBSTR(m->pc_target, m->lc_len)
       EXIT
     ELSE
       m->lc_len = (m->lc_len - 1)
     ENDIF
   ENDDO

   RETURN m->lc_len

*-- EOF: _Rat( pc_source, pc_target )

<<.╫h:
PROCEDURE Help
PARAMETER lc_var
*    
-E8V
?

* DESCRIPTION
*   Activates the HELP window
*    
-E8V
?

8P

?
PRIVATE ALL LIKE ??_*
ON KEY LABEL F1)8S

?
&& Dsiable the F1 key during help
IF .NOT. FILE(" 82

?
.dbf")
  *-- Help file has been deleted or can't be found
  DO _Err_Box WITH "    Help file no longer exists: ?
" + " 82

?
.dbf"
  RETURN
ENDIF
ll_cat = SET( "CATALOG" ) = "ON"
SET CATALOG OFF

SET CURSOR OFF

*-- Select workarea and open Help dbf
lc_area = ALIAS()

*-- Open the HELP dbf file for the form
SELECT SELECT()
USE  82

?
 ORDER fld_name NOUPDATE NOLOG

ll_exact = SET("EXACT") = "ON"
SET EXACT ON
SEEK lc_var)8S

?
&& Search for the field name in help
IF .NOT. ll_exact
  SET EXACT OFF
ENDIF
IF FOUND()
  *-- Define the coord for the help window
  ln_t = 5
  ln_l = 6
  ln_b = 15
  ln_r = 74
  ON KEY LABEL F3 DO Toggle
  DEFINE WINDOW z_help FROM ln_t+1, ln_l+2 TO ln_b-1, ln_r-2 NONE
  ON ERROR lc_error=error()
  SAVE SCREEN TO zz_help

  *-- Make Help Box
  DO shadowg WITH ln_t, ln_l, ln_b, ln_r
  @ ln_t+1, ln_l+1 CLEAR TO ln_b-1, ln_r-1
  @ ln_t, ln_l TO ln_b, ln_r DOUBLE

  ln_memline = SET("MEMO")
  SET MEMOWIDTH TO 65
  IF MEMLINES(fld_help) > 9
    @ ln_t+1,ln_r SAY CHR(24)
    @ ln_b-1,ln_r SAY CHR(25)
  ENDIF
  lc_string = CHR(185)+ [ Help for ] + TRIM(fld_headng) +[ ] + CHR(204)
  lc_message = IIF(MEMLINES(fld_help) > 9, ;
                  "    NScroll thru Help: Ctrl-Home   Exit Viewing Help: Esc   See Original Screen: F3?
", ;
                  "    See Original Screen: F3?
" ;
                  )

  @ ln_t,CENTER(lc_string,80) SAY lc_string
  @ 0,0 GET fld_help OPEN WINDOW z_help MESSAGE lc_message
  READ
  SET MEMOWIDTH TO ln_memline
  ON ERROR
  ON KEY LABEL F3
  RELEASE WINDOW z_help
  RESTORE SCREEN FROM zz_help
  RELEASE SCREEN zz_help
ELSE
  DO _Err_Box WITH [    (There is no help defined for this field:?
 ] + lc_var
ENDIF
SET MESSAGE TO
IF ll_cat
  SET CATALOG ON
ENDIF
SET CURSOR ON
USE)8S

?
&& Close help file
SELECT (lc_area))8S

?
&& Back to edit work area
ON KEY LABEL F1 DO Help WITH VARREAD()
8P

?
RETURN
*-- EOP: HELP


PROCEDURE Toggle
*    
-E8V
?

* DESCRIPTION
*   Toggles the Help message back to the original screen
*    
-E8V
?

8P

?
PRIVATE ll_cons
SAVE SCREEN to Toggle
RESTORE SCREEN FROM zz_help
SET MESSAGE TO "Press any key..."
ll_cons = SET( "CONSOLE" ) = "ON"
SET CONSOLE OFF
WAIT
IF ll_cons
  SET CONSOLE ON
ENDIF
RESTORE SCREEN FROM Toggle
RELEASE SCREEN Toggle
SET MESSAGE TO "Scroll thru Help: Ctrl-Home   Exit Viewing Help: Ctrl-End   See Org. Screen: F3"
8P

?
RETURN
*-- EOP: Toggle


FUNCTION Center
PARAMETER lc_string, ln_width
*    
-E8V
?

* NAME
*   Center() - Provide column needed to center a string in a width
*
* DESCRIPTION
*   The CENTER() function will return the starting column
*   coordinate to center the <lc_string> string within a width of
*   screen <ln_width>.  The width of the screen would normally be
*   80 colunms, but could just as well be the width of a window.
*   If there is an error condition, the returned result will equal 0.
*   If a numeric value is passed for the <expC> value, it will be
*   converted to a string.
*
* EXAMPLES
*
*   @ 15,center(string,80) say string
*
*   Will center the <string> withing 80 columns
*
*-----------------------------------------------------------------------------
  PRIVATE lc_result, lc_type

  IF .NOT. TYPE("ln_width") $ "FN")8S

?
&& Force value to 0 for bad type
    lc_result = 0
  ELSE

    lc_type = TYPE("lc_string")
    DO CASE
      CASE lc_type = "C"
        lc_width = (ln_width/2)-(LEN(lc_string)/2)
      CASE lc_type $ "NF"
        lc_width = (ln_width/2)-(LEN(ALLTRIM(STR(lc_string)))/2)
      CASE lc_type = "L"
        lc_width = (ln_width/2)-(1.5))8S

?
&& .T. or .F. have fixed len of 3
      OTHERWISE
        lc_width = 0
    ENDCASE
  ENDIF

  IF lc_width < 0)8S

?
&& Force negative values to 0
    lc_width = 0
  ENDIF

RETURN ( lc_width )
*-- EOF: Center( lc_string, ln_width )

<<.½q:
*-- Set procedure to the lookup programs
ll_echo = SET( "ECHO" ) = "ON"
SET ECHO OFF

lc_proc = SET("procedure"))8S

?
&& Store procedure file name
IF FILE("9k
?
.prg") .OR. FILE("9k
?
.dbo")
  SET PROCEDURE TO 9k
?

ELSE
  lc_fullpath = SET("FULLPATH")
  SET FULLPATH ON
  lc_setfmt = SET("FORMAT")

  *-- Pull out the file path from the format file for a prefix
    lc_slash = IIF( LEFT( OS(), 3 ) = "DOS", "\", "/" )

    *-- Look for last slash in the string
    m->lc_len = LEN( lc_setfmt )
    DO WHILE m->lc_len > 0
      IF m->lc_slash $ SUBSTR(m->lc_setfmt, m->lc_len)
        EXIT
      ELSE
        m->lc_len = m->lc_len - 1
      ENDIF
    ENDDO

  lc_fullnam = LEFT( lc_setfmt, m->lc_len ) + "9k
?
"
  IF FILE( lc_fullnam + ".prg" ) .OR. FILE( lc_fullnam + ".dbo" )
    SET PROCEDURE TO ( lc_fullnam )
  ELSE

    *-- Display the error message in a windowed box
    PRIVATE lc_anykey, lc_msg, lc_msglen, lc_win, ln_press, ln_width, ll_trap,;
            ll_escape

    lc_anykey = [Press any key to continue...]
    ln_press  = LEN( lc_anykey )
    lc_msg = "    Procedure library?
 9k
?

not found!?
"
    ln_msglen = LEN( lc_msg )
    ln_width = 0
    ll_escape = SET("ESCAPE") = "ON"
    SET ESCAPE OFF

    *-- Determine the width needed for the window:
    IF ln_msglen <= ln_press
      ln_width = ln_press
    ELSE
      *-- Make sure the message fits in the window:
      IF ln_msglen > 76
        lc_msg = LEFT( lc_msg, 76 )
        ln_msglen = 76
      ENDIF
      ln_width = ln_msglen
    ENDIF
    DEFINE WINDOW _err_box FROM 9, ((76 - ln_width) + .5) / 2 ;
                  TO 15, (ln_width + 83) / 2 DOUBLE
    ln_width = ( ln_width + 2 )

    *-- Display the message and prompt to the window and wait for a key press
    ACTIVATE WINDOW _err_box
    ? lc_msg AT ( ln_width - ln_msglen ) / 2
    ?
    ? lc_anykey AT ( ln_width - ln_press ) / 2
    SET CONSOLE OFF
    WAIT
    SET CONSOLE ON

    *-- Clean up the window display and reactivate the previous window
    RELEASE WINDOW _err_box

    IF ll_escape
      SET ESCAPE ON
    ELSE
      SET ESCAPE OFF
    ENDIF

  ENDIF

  IF lc_fullpath = "OFF"
    SET FULLPATH OFF
  ENDIF

ENDIF)8S

?
&&   UDF's won't run

<<.ir:
.)r    MONO
.dr    COLOR
.dr    EGA25
.dr    MONO43
.dr    EGA43
.dr    VGA25
.dr    VGA43
.dr    VGA50
.dr7╣q
╞q╘qΓq±q qrr
;<.ƒs:╡&/ör
lc_display.ár
gc_display9»q
    50
8.
/╫r
SET DISPLAY TO VGA50
.¥s    43
8.
/¥s
*-- If not already in 43 line mode, set it based on MONO or EGA
IF .NOT. "43" $ ?

  IF "MONO" $ ?

    SET DISPLAY TO MONO43
  ELSE
    SET DISPLAY TO EGA43
  ENDIF
ENDIF
<<.    t:8k

1╫s1╫s2Σs'.t2²s..t><<

<