$! ------------------ CUT HERE -----------------------
$ v='f$verify(f$trnlnm("SHARE_VERIFY"))'
$!
$! This archive created by VMS_SHARE Version 7.2-011  26-Jun-1992
$!   On  3-AUG-1992 10:53:23.74   By user GOATHUNTER (@WKUVX1.BITNET)
$!
$! This VMS_SHARE Written by:
$!    Andy Harper, Kings College London UK
$!
$! Acknowledgements to:
$!    James Gray       - Original VMS_SHARE
$!    Michael Bednarek - Original Concept and implementation
$!
$! TO UNPACK THIS SHARE FILE, CONCATENATE ALL PARTS IN ORDER
$! AND EXECUTE AS A COMMAND PROCEDURE  (  @name  )
$!
$! THE FOLLOWING FILE(S) WILL BE CREATED AFTER UNPACKING:
$!       1. DECFRM.VAX;1
$!
$set="set"
$set symbol/scope=(nolocal,noglobal)
$f=f$parse("SHARE_TEMP","SYS$SCRATCH:.TMP_"+f$getjpi("","PID"))
$e="write sys$error  ""%UNPACK"", "
$w="write sys$output ""%UNPACK"", "
$ if f$trnlnm("SHARE_LOG") then $ w = "!"
$ ve=f$getsyi("version")
$ if ve-f$extract(0,1,ve) .ges. "4.4" then $ goto START
$ e "-E-OLDVER, Must run at least VMS 4.4"
$ v=f$verify(v)
$ exit 44
$UNPACK: SUBROUTINE ! P1=filename, P2=checksum
$ x = P1 - f$parse(P1,,,"version")
$ y = f$search(x)
$ if y .eqs. "" then $ goto file_absent
$ x = f$integer(f$parse(P1,,,"version")-";")
$ y = f$integer(f$parse(y,,,"version")-";")
$ if x .gt. y then $ goto file_absent
$ if f$mode() .eqs. "INTERACTIVE" then $ goto file_interactive
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists. Skipped."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists. Skipped."
$file_delete:
$ delete 'f'*
$ exit
$file_interactive:
$ if x .eq. y then e "-W-EXISTS, File ''P1' exists."
$ if x .ne. y then e "-W-NEWERVERSION, of File ''P1' exists."
$ read/error=file_delete/end=file_delete-
  /prompt="Create new version [y/n]: " -
  sys$command x
$ if .not. x then $ e "-W-SKIPPED, File ''P1' skipped."
$ if .not. x then $ goto file_delete
$ P1 = P1 - f$parse(P1,,,"version")
$file_absent:
$ if f$parse(P1) .nes. "" then $ goto dirok
$ dn=f$parse(P1,,,"DIRECTORY")
$ w "-I-CREDIR, Creating directory ''dn'."
$ create/dir 'dn'
$ if $status then $ goto dirok
$ e "-E-CREDIRFAIL, Unable to create ''dn'. File skipped."
$ delete 'f'*
$ exit
$dirok:
$ w "-I-PROCESS, Processing file ''P1'."
$ if .not. f$verify() then $ define/user sys$output nl:
$ EDIT/TPU/NOSEC/NODIS/COM=SYS$INPUT 'f'/OUT='P1'
PROCEDURE Unpacker ON_ERROR ENDON_ERROR;SET(FACILITY_NAME,"UNPACK");SET(
SUCCESS,OFF);SET(INFORMATIONAL,OFF);f:=GET_INFO(COMMAND_LINE,"file_name");b:=
CREATE_BUFFER(f,f);p:=SPAN(" ")@r&LINE_END;POSITION(BEGINNING_OF(b));
LOOP EXITIF SEARCH(p,FORWARD)=0;POSITION(r);ERASE(r);ENDLOOP;POSITION(
BEGINNING_OF(b));g:=0;LOOP EXITIF MARK(NONE)=END_OF(b);x:=ERASE_CHARACTER(1);
IF g=0 THEN IF x="X" THEN MOVE_VERTICAL(1);ENDIF;IF x="V" THEN APPEND_LINE;
MOVE_HORIZONTAL(-CURRENT_OFFSET);MOVE_VERTICAL(1);ENDIF;IF x="+" THEN g:=1;
ERASE_LINE;ENDIF;ELSE IF x="-" THEN IF INDEX(CURRENT_LINE,"+-+-+-+-+-+-+-+")=
1 THEN g:=0;ENDIF;ENDIF;ERASE_LINE;ENDIF;ENDLOOP;t:="0123456789ABCDEF";
POSITION(BEGINNING_OF(b));LOOP r:=SEARCH("`",FORWARD);EXITIF r=0;POSITION(r);
ERASE(r);x1:=INDEX(t,ERASE_CHARACTER(1))-1;x2:=INDEX(t,ERASE_CHARACTER(1))-1;
COPY_TEXT(ASCII(16*x1+x2));ENDLOOP;WRITE_FILE(b,GET_INFO(COMMAND_LINE,
"output_file"));ENDPROCEDURE;Unpacker;QUIT;
$ delete/nolog 'f'*
$ CHECKSUM 'P1'
$ IF CHECKSUM$CHECKSUM .eqs. P2 THEN $ EXIT
$ e "-E-CHKSMFAIL, Checksum of ''P1' failed."
$ ENDSUBROUTINE
$START:
$ create 'f'
X$ set verify
X$!
X$! PROGRAM NAME: BUILD_TEST_F.COM
X$!
X$!
X$! Compile the .BAS program that invokes the form.
X$ BAS TEST_F
X$!
X$! Compile the .BAS program which is called from the form to process HELP.
X$ BAS DF_FIND_HELP
X$!
X$! Translate the form (create binary .FORM file from text .IFDL file).
X$ FORMS TRANSLATE TEST_F_FORM.IFDL
X$!
X$! Create the object code (.OBJ) of the form.
X$ FORMS EXTRACT OBJ TEST_F_FORM
X$!
X$! Link the procedures to create TEST_F.EXE.
X$ LINK TEST_F,TEST_F_FORM,DF_FIND_HELP
X$!
X$! DF_FIND_HELP contains the logical FORM_HELP_DIR, which points to the
X$! directory where the help files reside.
X$ DEFINE FORM_HELP_DIR DUA1:`5BKUBERA.DF`5D
X$!
X$!
X$ set noverify
X$ exit
X
X`0C
X
X1`09SUB DF_LOAD_HELP (LONG status_result, &
X`09`09`09  DF_HELP_REC help_vars)
X!++
X!`09Creation Date: 06-JUN-1991
X!
X!`09Author: Joseph P. Kubera
X!
X!`09Modification History:
X!
X!`09Functional Description:
X!
X!`09    This program is called by DECForms forms to search for and
X!`09    load specific help files.
X!`09    Note that only 18 of the 20 lines in the help_line array are used.
X!
X!`09Implicit Inputs: NONE
X!`09Implicit Outputs: NONE
X!`09Side Effects: NONE
X!
X!-
X
XOPTION TYPE = EXPLICIT
X
XRECORD DF_HELP_REC
X    GROUP help_lines (1 TO 20)
X`09STRING help_line = 80
X    END GROUP help_lines
X    LONG help_scroll
X    LONG help_screen_no
X    STRING help_msg = 50
X    STRING help_filename = 50
XEND RECORD DF_HELP_REC
X
X
XMAP (HELP_VARIABLE_MAP) STRING XREAD = 80
X
XDECLARE`09`09`09`09`09`09`09`09&
X    WORD`09`09`09`09`09`09`09&
X`09read_count,`09! Contains number of pages read`09`09&
X`09line_count,`09! Contains number of lines read`09`09&
X    BYTE`09`09`09`09`09`09`09&
X`09open_error,`09! Error flag for opening files`09`09&
X`09read_error,`09! Error flag for reading files`09`09&
X`09file_end_flag,`09! End of file flag`09`09`09&
X`09period_loc,`09! Value for locating a "." in a string`09&
X    STRING`09`09`09`09`09`09`09&
X`09error_message,`09! Error message`09`09`09`09&
X`09help_file`09! Help file name
X
XDECLARE BYTE CONSTANT`09`09`09`09`09`09&
X`09TRUE = -1,`09`09`09`09`09`09&
X`09FALSE = 0
X
XDECLARE LONG CONSTANT file_chan = 1
X
XMAIN:
X
X! Create a filename from the data provided and attempt to open a help file.
X    GOSUB OPEN_FILES
X! Return if not successful in opening a help file.
X    GOTO 9999 IF open_error
X    help_vars::help_msg = " "
X    read_count = 0
X    file_end_flag = FALSE
X
X! Increment/decrement the screen pointer.
X    GOSUB UPDATE_POINTER
X! Clear the lines array.
X    GOSUB CLEAR_LINES
X
X! Main processing section.
X! Locate the correct page by reading each page, 18 lines at a time.
X
X    UNTIL read_count >= help_vars::help_screen_no OR file_end_flag
X`09read_count = read_count + 1
X`09GOSUB FIRST_LINE_CHECK
X`09!
X`09! Read 18 lines in or till the end of the file
X`09!
X`09UNTIL line_count >= 18 OR FILE_END_FLAG
X`09    line_count = line_count + 1
X`09    xread = " "
X`09    GOSUB LINE_READ
X`09NEXT
X    NEXT
X
X! Set the actual number of pages read.
X
X    help_vars::help_screen_no = read_count
X
X    GOTO 9999
X
X!***************************************************************************
V****
X
XOPEN_FILES:
X
X! If the help filename is blank, use the predefined logical which can be
X! defined to point to any file.
X
X    IF help_vars::help_filename <= " "
X    THEN
X`09help_file = "DF_HELP$FILE"
X    ELSE
X`09!
X`09! Construct the filename.
X`09!
X`09! The fieldname from the form may be part of a DECForms group,
X`09! e.g. EMPLOYEES.POSITION, so search for a period.
X`09!
X`09period_loc = POS(help_vars::help_filename,".",1)
X`09IF (period_loc > 0)
X`09THEN
X`09    help_vars::help_filename =`09`09`09`09`09&
X`09`09RIGHT$(help_vars::help_filename,period_loc+1)
X`09END IF
X    END IF
X
X! FORM_HELP_DIR must be defined as the directory where the help files reside
V.
X! Create the entire file name.
X
X    IF SEG$(help_vars::help_filename,1,6) = "FIELD_"
X    THEN
X`09help_file = 'FORM_HELP_DIR:' + `09`09`09`09`09&
X`09EDIT$(help_vars::help_filename,142) + '.HLP'
X    ELSE
X`09help_file = 'FORM_HELP_DIR:FIELD_' + `09`09`09`09&
X`09EDIT$(help_vars::help_filename,142) + '.HLP'
X    END IF
X
X    WHEN ERROR IN
X`09OPEN help_file FOR INPUT AS FILE file_chan,`09`09`09&
X`09ACCESS READ
X    USE
X`09help_vars::help_filename = " "
X`09help_vars::help_msg = " "
X`09open_error = TRUE
X    END WHEN
X
XRETURN
X
X!
X
XUPDATE_POINTER:
X
X! help_screen_no is checked in the form so it will not fall below 1.
X
X    IF help_vars::help_scroll = 0
X    THEN
X`09help_vars::help_screen_no = help_vars::help_screen_no + 1
X    ELSE
X`09help_vars::help_screen_no = help_vars::help_screen_no - 1
X    END IF
X
XRETURN
X
X!
X
XCLEAR_LINES:
X
X! Clear the values in the lines array.
X    line_count = 1
X    UNTIL line_count > 18
X`09help_vars::help_lines(line_count)::help_line = " "
X`09line_count = line_count + 1
X    NEXT
X
XRETURN
X
X!
X
XFIRST_LINE_CHECK:
X
X    xread = " "
X    line_count = 1
X
X! Since lines 1-18, then 18-35, etc. are displayed, if a screen other than
X! the first is being displayed, just copy the 18th line to the 1st.  Otherwi
Vse
X! perform the first read.
X
X    IF read_count > 1
X    THEN
X`09help_vars::help_lines(1)::help_line =`09`09`09`09&
X`09help_vars::help_lines(18)::help_line
X    ELSE
X`09GOSUB LINE_READ
X    END IF
X
XRETURN
X
X!
X
XLINE_READ:
X
X    WHEN ERROR IN
X`09linput #file_chan, xread
X    USE
X`09SELECT ERR
X`09    CASE = 11
X`09`09file_end_flag = TRUE
X`09    CASE ELSE
X`09`09read_error = TRUE
X`09`09error_message = " ERROR ENCOUNTERED: " + NUM1$(ERR) + `09&
X`09`09    ", " + ERT$(ERR)
X`09END SELECT
X    END WHEN
X
X    IF NOT file_end_flag AND NOT read_error
X    THEN
X`09!
X`09! Some text files may have been created using editors/processors that
X`09! create form feeds, etc. Therefore, remove all <CR>, <LF>, <FF>,
X`09! <DEL>, <ESC>, and <NUL> characters with EDIT$.
X`09!
X`09help_vars::help_lines(line_count)::help_line = EDIT$(xread,4)
X    END IF
X
X! Set certain variables when the end of the help file is reached.
X    IF file_end_flag
X    THEN
X`09help_vars::help_msg = " End of HELP reached..."
X`09!
X`09! The remaining lines that may be populated must be cleared.
X`09!
X`09UNTIL line_count > 18
X`09    help_vars::help_lines(line_count)::help_line = " "
X`09    line_count = line_count + 1
X`09NEXT
X    END IF
X
XRETURN
X
X!
X
X9999 END SUB
X
X`0C
X
XSET VERIFY
X!
X! CDD record definition for DF_HELP_REC, which is used for DECForms Help.
X!
XDEFINE FIELD HELP_LINE
X    DESCRIPTION IS /* Each line of a help file */
X    DATATYPE IS TEXT
X    SIZE IS 80.
X
XDEFINE FIELD HELP_SCROLL
X    DESCRIPTION IS /* Denotes which scrolling direction */
X    DATATYPE IS SIGNED LONGWORD.
X
XDEFINE FIELD HELP_SCREEN_NO
X    DESCRIPTION IS /* Denotes the current page number of the display */
X    DATATYPE IS SIGNED LONGWORD.
X
XDEFINE FIELD HELP_MSG
X    DESCRIPTION IS /* Any returned status messages (e.g. End of file reached
V)*/
X    DATATYPE IS TEXT
X    SIZE IS 50.
X
XDEFINE FIELD HELP_FILENAME
X    DESCRIPTION IS /* The VMS name of the help file */
X    DATATYPE IS TEXT
X    SIZE IS 50.
X
XDEFINE RECORD DF_HELP_REC
XDESCRIPTION IS /* DECForms Help Record Structure */.
X    HELP_LINES STRUCTURE
X`09OCCURS 20 TIMES.
X`09HELP_LINE.
X    END HELP_LINES_STRUCTURE.
X    HELP_SCROLL.
X    HELP_SCREEN_NO.
X    HELP_MSG.
X    HELP_FILENAME.
XEND RECORD.
XSET NOVERIFY
X
X`0C
X
X`09line 1 for client name help file.
X`09`09line 2
X`09`09line 3
X`09`09line 4
X`09`09line 5
X`09`09line 6
X`09`09line 7
X`09`09line 8
X`09`09line 9
X`09`09line 10
X`09`09line 11
X`09`09line 12
X`09`09line 13
X`09`09line 14
X`09`09line 15
X`09`09line 16
X`09`09line 17
X`09`09line 18
X`09Line 19 is the last line of the client name help file.
X
X`0C
X
X1`09PROGRAM TEST_DF_HELP
X!++
X!`09Creation Date: 06-JUN-1991
X!
X!`09Author: Joseph P. Kubera
X!
X!`09Modification History:
X!
X!`09Functional Description:
X!
X!`09    This program invokes the DECForms form TEST_F_FORM.
X!
X!`09Implicit Inputs: NONE
X!`09Implicit Outputs: NONE
X!`09Side Effects: NONE
X!
X!-
X
XOPTION TYPE = EXPLICIT
X
X! Include the DECForms library for BASIC
X%INCLUDE 'SYS$LIBRARY:FORMS$BAS_DEFINITIONS'
X
X! Set up the unique id for the form
XMAP (SESSION) STRING x_session_id = 16%
X
X! Variable that stores return value from the form
XMAP (RETURN_VAR) STRING x_return_var = 3%
X
XDECLARE `09`09`09`09`09`09&
X    INTEGER`09`09`09`09`09`09&
X`09i_forms_status,`09! return status variable`09&
X    LONG`09`09`09`09`09`09&
X`09l_sys_error,`09! system error variable`09`09&
X    BYTE`09`09`09`09`09`09&
X`09b_done`09`09! flag indicating normal exit from form
X
XDECLARE`09`09`09`09`09`09`09&
X    LONG CONSTANT`09`09`09`09`09&
X`09l_record_sent = 1% ! Decforms variable
X
XDECLARE`09`09`09`09`09`09`09&
X    STRING CONSTANT`09`09`09`09`09&
X`09x_form_name = 'TEST_F_FORM', ! form name`09&
X`09x_device_name = 'SYS$INPUT'  ! device name
X
XMAIN:
X
X    b_done = 0
X
X! Enable the form
X
X    i_forms_status = FORMS$ENABLE (FORMS$AR_FORM_TABLE,`09`09`09&
X`09`09`09`09`09x_device_name,`09`09`09&
X`09`09`09`09`09x_session_id,`09`09`09&
X`09`09`09`09`09,`09`09`09`09&
X`09`09`09`09`09x_form_name,,,,,,)
X
X! Display error message if error encountered.
X    CALL LIB$STOP (i_forms_status BY VALUE) IF (i_forms_status AND 1%) = 0
X
X
X! Invoke the form
X    i_forms_status = FORMS$RECEIVE (x_session_id,`09`09`09&
X`09`09`09`09    `09'MAIN_RECORD',`09`09`09&
X`09`09`09`09`09l_record_sent,,,,,,,,`09`09&
X`09`09`09`09`09x_return_var)
X
X! A normal exit from the form will first populate x_return_var with "EXI"
X    b_done = -1 IF x_return_var = "EXI"
X
X! Disable the form
X    i_forms_status = FORMS$DISABLE (x_session_id)
X
X! Display error message if error encountered.
X    CALL LIB$STOP (i_forms_status BY VALUE) IF (i_forms_status AND 1%) = 0
X
XEND
X
X`0C
X
X/* Code that is specific to this form is surrounded by the comment lines
X   as shown directly below in the first "Form Data ... End Data" section,
X   where the end comment contains the word END.
X
X   In this form, a function called F17_HELP, mapped to the F17 key, has been
X   defined to display a general help file called FIELD_GENERAL_HELP.HLP.
X
X   Note that in the function responses SCROLL_NEXT, SCROLL_END, etc.,
X   HELP_LINES is reset.  This takes extra time but is necessary even though
X   the HELP_LINES array is cleared in the routine DF_FIND_HELP because
X   DECForms may have trouble displaying lines with that contain tabs. */
X
XForm TEST_F_FORM
X
X/***************************************/
X/* Variables used for this particular form */
X    Form Data
X`09CLIENT_NAME Character(35)
X`09PHONE_NUMBER Character(10)
X`09RETURN_VAR Character(3)
X    End Data
X/*END***********************************/
X
X/* HELP variables */
X    Form Data
X`09Group HELP_LINES
X`09    Occurs 20
X`09    HELP_LINE Character(80)
X`09End Group
X`09HELP_SCROLL Longword Integer
X`09HELP_SCREEN_NO Longword Integer
X`09HELP_MSG Character(50)
X`09HELP_FILENAME Character(50)
X`09/* Concealed field where cursor is placed on help panel */
X`09HELP_DUMMY Character(1)
X`09/* Help return status variable */
X`09HELP_STATUS Unsigned Longword
X    End Data
X
X    Form Data
X`09/* Current item string, builtin in Decforms */
X`09CURRENTITEM Character(50) Varying Builtin
X`09/* Variable for storing the current field/filename */
X`09SAVE_FILENAME Character(50)
X`09/* Title variables for the help panel */
X`09HELP_TITLE_X Character(45)
X`09HELP_TITLE_EXTRA_X Character(6)
X    End Data
X
X/***************************************/
X/* Records used in this form */
X    Form Record CLIENT_REC
X`09CLIENT_NAME Character(35)
X`09PHONE_NUMBER Character(10)
X    End Record
X
X    Form Record MAIN_RECORD
X`09RETURN_VAR Character(3)
X    End Record
X/*END***********************************/
X
X/* Help Record */
X    Form Record DF_HELP_REC
X`09Group HELP_LINES
X`09    Occurs 20
X`09    HELP_LINE Character(80)
X`09End Group
X`09HELP_SCROLL Longword Integer
X`09HELP_SCREEN_NO Longword Integer
X`09HELP_MSG Character(50)
X`09HELP_FILENAME Character(50)
X    End Record
X
X/***************************************/
X/* Layout spec and main viewport for this form */
X    Layout VT_LAYOUT
X`09Device
X`09    Terminal
X`09`09Type %VT100
X`09End Device
X`09Size 24 Lines by 80 Columns
X
X    Viewport MAIN_VP
X`09Lines 1 Through 22
X`09Columns 1 Through 80
X    End Viewport
X/*END***********************************/
X
X/* Help Viewport */
X    Viewport FIELD_HELP_VP
X`09Lines 3 Through 22
X`09Columns 1 Through 80
X    End Viewport
X
X
X/***************************************/
X/* Functions for this form */
X    Function EXIT_PROGRAM
X`09Is (%PF1 %CAPITAL_E)
X`09   (%PF1 %SMALL_E)
X    End Function
X
X    Function SAVE_RECORD
X`09Is (%PF1 %CAPITAL_S)
X`09   (%PF1 %SMALL_S)
X    End Function
X/*END***********************************/
X
X/* Function to invoke HELP */
X    Function GET_HELP
X`09Is %PF2
X`09   %HELP
X    End Function
X
X/* Example of defining a function key to access a specific help file */
X    Function F17_HELP
X`09Is %F17
X    End Function
X
X/* Other functions used by HELP */
X    Function QUIT
X`09Is %F8
X`09    (%PF1 %CAPITAL_Q)
X`09    (%PF1 %SMALL_Q)
X    End Function
X
X    Function EX_IT
X`09Is %F10
X    End Function
X
X    Function SCROLL_NEXT
X`09Is %NEXT_SCREEN
X    End Function
X
X    Function SCROLL_PREV
X`09Is %PREV_SCREEN
X    End Function
X
X    Function SCROLL_END
X`09Is (%PF1 %NEXT_SCREEN)
X    End Function
X
X    Function SCROLL_BEGINNING
X`09Is (%PF1 %PREV_SCREEN)
X    End Function
X
X/***************************************/
X/* Responses for this form */
X    Enable Response
X`09Remove All
X`09Display
X`09    MAIN_PANEL
X`09Message " "
X    End Response
X
X    Receive Response MAIN_RECORD
X`09Activate
X`09    Panel MAIN_PANEL
X`09Position To Field CLIENT_NAME On MAIN_PANEL
X    End Response
X/*END***********************************/
X
X/* The following function (GET_HELP) is defined at the form level, so it
X   does not require a panel level definition. */
X
X    Function Response GET_HELP
X`09If HELP MESSAGE AVAILABLE Then
X`09    Message Help
X`09Else
X`09    Message
X`09`09"       "
X`09    /* Read forward, from the beginning of the file */
X`09    Let HELP_SCROLL = 0
X`09    Let HELP_SCREEN_NO = 0
X`09    /* CURRENTITEM is used to ensure that after leaving help the
X`09    cursor returns to the same field that it left. SAVE_FILENAME is
X`09    required since some internal DECForms processing may clear the
X`09    CURRENTITEM field */
X`09    If (CURRENTITEM > " ") Then
X`09`09Let SAVE_FILENAME = CURRENTITEM
X`09`09Let HELP_FILENAME = CURRENTITEM
X`09    Else
X`09`09Let HELP_FILENAME = SAVE_FILENAME
X`09    End If
X`09    Call "DF_LOAD_HELP" Using
X`09`09HELP_STATUS
X`09`09DF_HELP_REC
X`09    Message
X`09`09HELP_MSG
X`09    /* If a field level help file was not located, HELP_FILENAME
X`09    will return as blank. */
X`09    If (HELP_FILENAME > " ") Then
X`09`09Let HELP_TITLE_EXTRA_X = "ITEM: "
X`09`09Let HELP_TITLE_X = HELP_FILENAME
X`09`09Activate
X`09`09    Panel FIELD_HELP_PANEL
X`09`09Display
X`09`09    FIELD_HELP_PANEL
X`09`09Position Immediate To Field HELP_DUMMY On FIELD_HELP_PANEL
X`09    Else
X`09`09Message " There is no help available for this field..."
X`09    End If
X`09End If
X    End Response
X
X/* F17_HELP has been defined to access a specific help file. */
X    Function Response F17_HELP
X`09    Message
X`09`09"      "
X`09    /* Read forward, from the beginning of the file */
X`09    Let HELP_SCROLL = 0
X`09    Let HELP_SCREEN_NO = 0
X`09    Let SAVE_FILENAME = "GENERAL_HELP"
X`09    Let HELP_FILENAME = "GENERAL_HELP"
X`09    Call "DF_LOAD_HELP" Using
X`09`09HELP_STATUS
X`09`09DF_HELP_REC
X`09    Message
X`09`09HELP_MSG
X`09    /* If a field level help file was not located, HELP_FILENAME
X`09    will return as blank. */
X`09    If (HELP_FILENAME > " ") Then
X`09`09Let HELP_TITLE_EXTRA_X = " GENER"
X`09`09Let HELP_TITLE_X = "AL INFORMATION"
X`09`09Activate
X`09`09    Panel FIELD_HELP_PANEL
X`09`09Display
X`09`09    FIELD_HELP_PANEL
X`09`09Position Immediate To Field HELP_DUMMY On FIELD_HELP_PANEL
X`09    Else
X`09`09Message " No help file was located..."
X`09    End If
X    End Response
X
X/***************************************/
X/* MAIN_PANEL is the main panel in the form, which will call the HELP
Xprocedure.  This example contains two fields. */
X
X`09Panel MAIN_PANEL
X`09    Viewport MAIN_VP
X
X`09    Function Response EXIT_PROGRAM
X`09`09Remove All
X`09`09Let RETURN_VAR = "EXI"
X`09`09Return Immediate
X`09    End Response
X
X`09    Function Response SAVE_RECORD
X`09`09Message " This function is currently unavailable..."
X`09    End Response
X
X`09    Literal Text
X`09`09Line 6
X`09`09Column 30
X`09`09Value "DECFORMS TEST PROCEDURE"
X`09`09Display
X`09`09    Bold
X`09    End Literal
X
X`09    Field CLIENT_NAME
X`09`09Line 10
X`09`09Column 30
X`09    End Field
X
X`09    Field PHONE_NUMBER
X`09`09Line 12
X`09`09Column 30
X`09`09Output Picture CC'-'CC'-'CCCC
X`09    End Field
X
X`09    Literal Text
X`09`09Line 20
X`09`09Column 22
X`09`09Value " GOLD/S to Save, GOLD/E to Exit"
X`09    End Literal
X
X`09    Literal Text
X`09`09Line 21
X`09`09Column 17
X`09`09Value " PF2 For Field Help, F17 For General Help"
X`09    End Literal
X
X`09    Literal Text
X`09`09Line 10
X`09`09Column 17
X`09`09Value "Client Name:"
X`09`09Display
X`09`09    Bold
X`09    End Literal
X
X`09    Literal Text
X`09`09Line 12
X`09`09Column 16
X`09`09Value "Phone Number:"
X`09`09Display
X`09`09    Bold
X`09    End Literal
X
X`09End Panel
X/*END***********************************/
X
X
X/* This is the HELP panel */
X    Panel FIELD_HELP_PANEL
X`09Viewport FIELD_HELP_VP
X`09/* Clear the help title variables when exiting this panel */
X`09Exit Response
X`09    Let HELP_TITLE_X = " "
X`09    Let HELP_TITLE_EXTRA_X = " "
X`09End Response
X
X`09/* Function to display the next page if it exists */
X`09Function Response SCROLL_NEXT
X`09    Let HELP_SCROLL = 0
X`09    Reset
X`09`09HELP_LINES
X`09    Call "DF_LOAD_HELP" Using
X`09`09HELP_STATUS
X`09`09DF_HELP_REC
X`09    Message
X`09`09HELP_MSG
X`09    Position To Field HELP_DUMMY On FIELD_HELP_PANEL
X`09End Response
X
X`09/* Function to display the previous page if it exists */
X`09Function Response SCROLL_PREV
X`09    Let HELP_SCROLL = 1
X`09    If (HELP_SCREEN_NO = 1) Then
X`09`09Message " Beginning of HELP reached..."
X`09    Else
X`09`09Reset HELP_LINES
X`09`09Call "DF_LOAD_HELP" Using
X`09`09    HELP_STATUS
X`09`09    DF_HELP_REC
X`09`09Message
X`09`09    HELP_MSG
X`09    End If
X`09    Position To Field HELP_DUMMY On FIELD_HELP_PANEL
X`09End Response
X
X`09/* Function to display the first page of the help file */
X`09Function Response SCROLL_BEGINNING
X`09    Message "   "
X`09    Let HELP_SCROLL = 0
X`09    Let HELP_SCREEN_NO = 0
X`09    Reset
X`09`09HELP_LINES
X`09    Call "DF_LOAD_HELP" Using
X`09`09HELP_STATUS
X`09`09DF_HELP_REC
X`09    Message
X`09`09HELP_MSG
X`09    Position To Field HELP_DUMMY On FIELD_HELP_PANEL
X`09End Response
X
X`09/* Function to display the last page of the help file */
X`09Function Response SCROLL_END
X`09    Message " "
X`09    Let HELP_SCROLL = 0
X`09    /* Set the screen number to a value far past the end of the
X`09    help file (hopefully).  The program will stop reading at the
X`09    actual last page. */
X`09    Let HELP_SCREEN_NO = 1000
X`09    Reset
X`09`09HELP_LINES
X`09    Call "DF_LOAD_HELP" Using
X`09`09HELP_STATUS
X`09`09DF_HELP_REC
X`09    Message
X`09`09HELP_MSG
X`09    Position To Field HELP_DUMMY On FIELD_HELP_PANEL
X`09End Response
X
X`09Function Response F17_HELP
X`09    Message " This function is disabled within HELP..."
X`09End Response
X
X`09Function Response GET_HELP
X`09    Message " Use PREV/NEXT for scrolling..."
X`09End Response
X
X`09/* Function to exit HELP */
X`09Function Response TERMINATE HELP
X`09    Message "   "
X`09    Remove
X`09`09FIELD_HELP_VP
X`09    Deactivate
X`09`09Panel FIELD_HELP_PANEL
X`09    Position Immediate To Previous Item
X`09End Response
X
X`09/* Function to exit HELP */
X`09Function Response EX_IT
X`09    Message "   "
X`09    Remove
X`09`09FIELD_HELP_VP
X`09    Deactivate
X`09`09Panel FIELD_HELP_PANEL
X`09    Position Immediate To Previous Item
X`09End Response
X
X`09/* Function to exit HELP */
X`09Function Response QUIT
X`09    Message "   "
X`09    Remove
X`09`09FIELD_HELP_VP
X`09    Deactivate
X`09`09Panel FIELD_HELP_PANEL
X`09    Position Immediate To Previous Item
X`09End Response
X
X`09Literal Text
X`09    Line 1
X`09    Column 28
X`09    Value " Press GOLD-HELP To Exit"
X`09End Literal
X
X`09Literal Text
X`09    /* Title line, which is displayed in reverse */
X`09    Line 2
X`09    Column 1
X`09    Value " "-
X"                                                                        `20
V    "
X`09    Display
X`09`09Reverse
X`09End Literal
X
X`09Literal Text
X`09    Line 2
X`09    Column 69
X`09    Value " Page: "
X`09    Display
X`09`09Reverse
X`09End Literal
X
X`09Field HELP_SCREEN_NO
X`09    /* Displays which page is being displayed */
X`09    Line 2
X`09    Column 76
X`09    /* Conceal it when attempting to locate the first or last
X`09       page, until the actual page number is defined */
X`09    Concealed
X`09`09When ((HELP_SCREEN_NO = 0) OR (HELP_SCREEN_NO = 1000))
X`09    Display
X`09`09Reverse
X`09    Output Picture CCCC
X`09    Protected
X`09End Field
X
X`09Field HELP_DUMMY
X`09    /* Location of the cursor when in HELP */
X`09    Line 1
X`09    Column 80
X`09    Concealed
X`09    Function Response PREVIOUS ITEM
X`09    End Response
X`09    Function Response NEXT ITEM
X`09    End Response
X`09End Field
X
X`09Field HELP_TITLE_EXTRA_X
X`09    /* First segment of help title.  The help title is in segments
X`09    since DECForms does not provide string concatenation */
X`09    Line 2
X`09    Column 10
X`09    Protected
X`09    Display
X`09`09Reverse
X`09End Field
X
X`09Field HELP_TITLE_X
X`09    /* Second segment of the help title. */
X`09    Line 2
X`09    Column 16
X`09    Protected
X`09    Display
X`09`09Reverse
X`09End Field
X
X`09Group HELP_LINES
X`09    /* The actual help lines.  Note that in this version only 18 of the
X`09    20 help lines are used */
X`09    Vertical
X`09`09Displays 18
X`09    Field HELP_LINE
X`09`09Line 3
X`09`09Column 1
X`09`09Protected
X`09    End Field
X`09End Group
X    End Panel
X
X    End Layout
XEnd Form
$ CALL UNPACK DECFRM.VAX;1 1930212330
$ v=f$verify(v)
$ EXIT