awd@dbase.UUCP (Alastair Dallas) (08/09/89)
An earlier poster asked about popping up a picklist in dBASE IV. I thought
the request seemed reasonable, but it's out of my area, so I asked Kirk Nason,
our resident expert. Kirk and Bill Ramos had already developed the code
which follows, and it has been made available on the Ashton-Tate BBS, so
it's releasable here.
Hope it helps.
/alastair/
From Kirk Nason:
We have a template (formpop.cod) that allows you as a designer of a form to
embed popups in the form designer. It uses the template language in dBASE to
determine the row and col to display the modified data. Rather than having
dBASE do the grunt work we generated the proper dBASE code to redisplay the
data.
If you have the Developers edition of dBASE IV you can recompile it with
DTC.EXE, the dBASE IV template language compiler.
Here is the source to the template:
//
// Module Name: FORMPOP.COD
// Description: This module produces dBASE IV .FMT files
// with popups for VALID clauses
// field validation
//
Format (.fmt) File Template with POPUP field validation
-------------------------------------------------------
Version 1.1.3 BETA TEST
Ashton-Tate (c) 1987, 1988, 1989
Written by Kirk J. Nason & Bill Ramos
This template will support POPUPs for VALID clause field validations.
Example: In "ACCEPT value when" under "Editing options" enter,
"POPUP" = "vendor->vendor_id ORDER vendor_id REQ",
-------------------------------------------------
this will activate a popup if the data entered is invalid for
that field and will also make the field REQUIRED.
Explaination 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 to SEEK in.
REQ Indicates the FIELD requires data (can't be empty). Leave
REQ out if the field is NOT required.
NOTE: The POPUP string must be entered with the quotes as in the example.
{
//========================================================================
//$Header: C:/test/user_grp/doc/form.cov 1.4 19 Jul 1989 11:25:40 WWR $
//$Log: C:/test/user_grp/doc/form.cov $
//
// Rev 1.6 27 Jul 1989 11:25:40 KJN
// Fixed the display of fieldname and entered value in the window above
// the picklist
//
// Rev 1.5 25 Jul 1989 11:25:40 KJN
// Fixed search for "POPUP" to by putting UPPER() around selector name
// Put nul2zero() around @ GET for value redisplay
//
// Rev 1.4 19 Jul 1989 11:25:40 WWR
// On a non-required field, if Esc is pressed, and the initial value failed
// the lookup, a false condition is returned, versus true.
//
// Rev 1.3 19 Jul 1989 11:16:28 WWR
// Stripped out the WHEN logic for dBASE 1.0 bug, where a replace statement
// in a WHEN UDF() will not do a REPLACE like a VALID UDF() can.
//
// Rev 1.2 19 Jul 1989 11:06:38 WWR
// Fixed the problem with using numeric key values. The TYPE() function is
// used to determine if it's a numeric field being looked up. If it is
// the VAL() function is used to take the character PROMPT() value and
// convert it.
// Picture functions are now used when displaying data after the POPUP
// selection is made.
//========================================================================
include "form.def"; // Form selectors
include "builtin.def"; // Builtin functions
//
// Enum string constants for international translation
//
enum wrong_class = "Can't use FORM.GEN on non-form objects. ",
form_empty = "Form design was empty. "
;
//
if FRAME_CLASS != form then // We are not processing a form object
pause(wrong_class + any_key)
goto NoGen;
endif
var fmt_name, // Format file name
crlf, // line feed
carry_flg, // Flag to test carry loop
carry_cnt, // Count of the number of fields to carry
carry_len, // Cumulative length of carry line until 75 characters
carry_lent, // Total cumulative length of carry line
carry_first,// Flag to test "," output for carry fields
color_flg, // Flag to if color should stay on am line
line_cnt, // Count for total lines processed (Mulitple page forms)
page_cnt, // Count for total pages processed (Mulitple page forms)
temp, // tempory work variable
cnt, // Foreach loop variable
wnd_cnt, // Window counter
wnd_names, // Window names so I can clear them at the bottom of the file
default_drv,// dBASE default drive
dB_status, // dBASE status before entering designer
scrn_size, // Screen size when generation starts
display, // Type of display screen we are on
is_popup, // POPUP validation requested
pop_cnt, // Counter used to indicate running popup id
color; // Color returned from getcolor function
//-----------------------------------------------
// Assign default values to some of the variables
//-----------------------------------------------
crlf = chr(10)
temp = ""
carry_flg = carry_first = carry_cnt = carry_len = carry_lent =
wnd_cnt = line_cnt = color_flg = cnt = 0
page_cnt = 1
is_popup = 0
screen_size()
//-------------------------------
// Create Format file
//-------------------------------
if !make_Fmt() then goto nogen
header();
}
*-- Format file initialization code --------------------------------------------
IF SET("TALK") = "ON"
SET TALK OFF
lc_talk = "ON"
ELSE
lc_talk = "OFF"
ENDIF
//lc_cursor = SET("CURSOR")
//SET CURSOR ON
*-- This form was created in {display_type()} mode
SET DISPLAY TO {display_type()}
lc_status = SET("STATUS")
*-- SET STATUS was \
{if dB_status then}
ON when you went into the Forms Designer.
IF lc_status = "OFF"
SET STATUS ON
{else}
OFF when you went into the Forms Designer.
IF lc_status = "ON"
SET STATUS OFF
{endif}
ENDIF
//-----------------------------------------------------------------------
// Process fields to build "SET CARRY" and WINDOW commands.
//-----------------------------------------------------------------------
{
foreach FLD_ELEMENT flds
if nul2zero(ROW_POSITN) - line_cnt > scrn_size then
line_cnt = line_cnt + scrn_size + 1
endif
if FLD_CARRY then carry_flg = 1; ++carry_cnt endif
if chr(FLD_VALUE_TYPE) == "M" and FLD_MEM_TYP and wnd_cnt < 20 then
++wnd_cnt
wnd_names = wnd_names + "Wndow" + wnd_cnt + ",";
}
*-- Window for memo field {lower(FLD_FIELDNAME)}.
DEFINE WINDOW { Window_Def(flds)}\
{ endif
next flds
print(crlf);
if carry_flg then
}
lc_carry = SET("CARRY")
*-- Fields to carry forward during APPEND.
SET CARRY TO { Carry_Flds()}
{endif
if check_for_popups() then
}
SET PROCEDURE TO u_{substr(name,1,6)}
DO s_{substr(name,1,6)}
{ endif}
*-- @ SAY GETS Processing. -----------------------------------------------------
*-- Format Page: {page_cnt}
{line_cnt = wnd_cnt = 0
foreach ELEMENT k
color = getcolor(FLD_DISPLAY, FLD_EDITABLE) // get color of element
if nul2zero(ROW_POSITN) - line_cnt > scrn_size then
line_cnt = line_cnt + scrn_size + 1;
++page_cnt;
}
READ
*-- Format Page: {page_cnt}
{ endif
//
if ELEMENT_TYPE == @TEXT_ELEMENT or ELEMENT_TYPE == @FLD_ELEMENT then
if FLD_FIELDTYPE == calc then}
*-- Calculated field: {lower(FLD_FIELDNAME)} - {FLD_DESCRIPT}
{ endif
if FLD_FIELDTYPE == memvar then}
*-- Memory variable: {lower(FLD_FIELDNAME)}
{ endif}
@ {nul2zero(ROW_POSITN) - line_cnt},{nul2zero(COL_POSITN)} \
{ endif
if ELEMENT_TYPE == @BOX_ELEMENT then}
@ {box_coordinates(k)}\
{ endif}
//
{ case ELEMENT_TYPE of
@TEXT_ELEMENT:
// Certain control characters can cause dBASE problems ie, ASCII(13,26,0)
// so the form designer will either send them to us as a string if they are
// all the same character or as individual characters if they differ. We
// handle this by using the chr() function to "SAY" them in dBASE.
}
SAY \
{ if asc(TEXT_ITEM) < 32 then
if len(TEXT_ITEM) == 1 then}
CHR({asc(TEXT_ITEM)}) \
{ else}
REPLICATE(CHR({asc(TEXT_ITEM)}), {len(TEXT_ITEM)}) \
{ endif
else}
"{TEXT_ITEM}" \
{ endif
outcolor()}
{ @Box_element:
outbox(BOX_TYPE, BOX_SPECIAL_CHAR)}
{ outcolor()}
{ @FLD_ELEMENT:
if !FLD_EDITABLE then; // its a SAY}
SAY \
{ if FLD_FIELDTYPE == calc then
// Loop thru expression in case it is longer than 237
foreach FLD_EXPRESSION fcursor in k
FLD_EXPRESSION}
{ next}
// Output a space after the Fld_expression and get ready for picture clause
\
{ else // not a editable field
if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
lower(temp + FLD_FIELDNAME)} \
{ endif
if Ok_Template(k) then}
PICTURE "{ if FLD_PICFUN then}@{FLD_PICFUN}\
{ if AT("S", FLD_PICFUN) then}{FLD_PIC_SCROLL}{endif}\
{//leave this space}\
{ endif
if !AT("S", FLD_PICFUN) and !AT("M", FLD_PICFUN) then
FLD_TEMPLATE}\
{ endif}" \
{ endif
else // it's a get}
GET \
{ if FLD_FIELDTYPE == dbf then temp = "" else temp = "m->" endif
lower(temp + FLD_FIELDNAME)} \
{ if chr(FLD_VALUE_TYPE) == "M" && FLD_MEM_TYP then
if wnd_cnt < 20 then ++wnd_cnt endif
if Fld_mem_typ == 1}OPEN {endif}WINDOW Wndow{wnd_cnt} \
{ endif
if Ok_Template(k) then}
PICTURE "{if FLD_PICFUN then}@{FLD_PICFUN}\
{ if AT("S", FLD_PICFUN) then}{FLD_PIC_SCROLL}{endif}\
{//leave this space}\
{ endif
if AT("M", FLD_PICFUN)}{FLD_PIC_CHOICE}{endif}\
{ if !AT("S", FLD_PICFUN) and !AT("M", FLD_PICFUN) then
FLD_TEMPLATE}\
{ endif}" \
{ endif
if FLD_L_BOUND or FLD_U_BOUND then color_flg = 1;}
;
RANGE {FLD_L_BOUND}{if FLD_U_BOUND then},{FLD_U_BOUND}{endif} \
{ endif
if FLD_OK_COND then color_flg = 1;}
;
{ if AT("POPUP", UPPER(FLD_OK_COND)) then
// A POPUP is desired for showing coded values, redo the
// VALID clause to call a UDF based on "U_" + Fld_fieldname
}
VALID {get_udfname(FLD_FIELDNAME)}( {FLD_FIELDNAME} ) \
{
else
}
VALID {FLD_OK_COND} \
{
endif
if FLD_REJ_MSG then}
;
ERROR \
{ if !AT("IIF", upper(FLD_HLP_MSG))}"{endif}{FLD_REJ_MSG}\
{ if !AT("IIF", upper(FLD_HLP_MSG))}"{endif} \
{ endif
endif // FLD_OK_COND
if FLD_ED_COND then color_flg = 1;}
;
WHEN {FLD_ED_COND} \
{
endif
if FLD_DEF_VAL then color_flg = 1;}
;
DEFAULT {FLD_DEF_VAL} \
{ endif
if FLD_HLP_MSG then color_flg = 1;}
;
MESSAGE \
{ if !AT("IIF", upper(FLD_HLP_MSG))}"{endif}{FLD_HLP_MSG}\
{ if !AT("IIF", upper(FLD_HLP_MSG))}"{endif} \
{ endif
endif // FLD_EDITABLE}
{ outcolor()}
{ color_flg = 0;
otherwise: goto getnext;
endcase
}
//Leave the above blank line, it forces a line feed!
//-----------------
// End of @ SAY GET
//-----------------
{ ++cnt;
getnext:
next k;
}
*-- Format file exit code -----------------------------------------------------
*-- SET STATUS was \
{if dB_status then}
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
{else}
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}
ENDIF
{if carry_flg then}
IF lc_carry = "OFF"
SET CARRY OFF
ENDIF
{endif}
//IF lc_cursor = "OFF"
// SET CURSOR OFF
//ENDIF
{if wnd_names then}
RELEASE WINDOWS {substr(wnd_names, 1, (len(wnd_names) - 1))}
{endif}
IF lc_talk="ON"
SET TALK ON
ENDIF
RELEASE {if carry_flg then}lc_carry,{endif}lc_talk,lc_fields,lc_status
{
if is_popup then
}
DO c_{substr(name,1,6)}
SET PROCEDURE TO
{
endif
}
*-- EOP: {filename(fmt_name)}FMT
{
// Create the Procedure File for POPUP's if required
if is_popup then
if not create(frame_path+"u_"+rtrim(substr(name,1,6))+".PRG") then
pause(frame_path+"u_"+rtrim(substr(name,1,6))+".PRG" +
read_only + any_key);
goto nogen;
endif
}
//
{print("*"+replicate("-",78)+crlf);}
*-- Name....: {frame_path}u_{rtrim(substr(name,1,6))}.PRG
*-- Date....: {ltrim(SUBSTR(date(),1,8))}
*-- Version.: dBASE IV, Procedure for Format {Frame_ver}.0
*-- Notes...: Procedure file for VALID POPUPs with {filename(fmt_name)}FMT
{print("*"+replicate("-",78)+crlf);}
//
PROCEDURE s_{substr(name,1,6)} && Open files and Define POPUPs
{
pop_cnt = 0; // Scan to create opens & defines
foreach Fld_element flds
if AT("POPUP", UPPER(FLD_OK_COND)) then
++pop_cnt;
}
DEFINE WINDOW {get_popname(FLD_OK_COND)} FROM 7,30 TO 9,{31+len(FLD_FIELDNAME)+len(FLD_TEMPLATE)+5}
//{ nmsg("Length of fld_name ") pause(str(len(FLD_FIELDNAME))))
// nmsg("Length of fld_length") pause(str(len(FLD_LENGTH)))}
USE {get_file(FLD_OK_COND)} ORDER {get_key(FLD_OK_COND)} IN {pop_cnt+1} AGAIN
DEFINE POPUP {get_popname(FLD_OK_COND)} FROM 10,40 ;
PROMPT FIELD {get_field(FLD_OK_COND)} ;
MESSAGE "Select from list using ENTER, cancel selection with ESC"
ON SELECTION POPUP {get_popname(FLD_OK_COND)} DEACTIVATE POPUP
{
endif
next flds;
}
SELECT 1
*-- EOP: s_{substr(name,1,6)}
RETURN
{print("*"+replicate("-",78)+crlf);}
PROCEDURE c_{substr(name,1,6)} && Close files and Release POPUPs
{
pop_cnt = 0; // Scan to close files and release
foreach Fld_element flds
if AT("POPUP", UPPER(FLD_OK_COND)) then
++pop_cnt;
}
USE IN {pop_cnt+1}
RELEASE WINDOW {get_popname(FLD_OK_COND)}
RELEASE POPUP {get_popname(FLD_OK_COND)}
{
endif
next flds;
}
SELECT 1
*-- EOP: c_{substr(name,1,6)}
RETURN
{print("*"+replicate("-",78)+crlf);}
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)
{
pop_cnt = 0;
foreach Fld_element flds
if AT("POPUP", UPPER(FLD_OK_COND)) then
++pop_cnt;
}
{print("*"+replicate("-",78)+crlf);}
FUNCTION {get_udfname(Fld_fieldname)}
PARAMETER fld_name
{
if !is_required(FLD_OK_COND) then
}
IF empty(fld_name) && Not a required field, so return
RETURN (.T.) && if null field
ENDIF
{
endif
}
EscKey = 27 && 27 represents the ESC key
SELECT {pop_cnt+1} && Select the lookup file
SEEK fld_name
IF .NOT. FOUND()
ACTIVATE WINDOW {get_popname(FLD_OK_COND)}
?? " {FLD_FIELDNAME} =", {FLD_FILENAME}->{FLD_FIELDNAME} \
{ if Ok_Template(flds) then}
PICTURE "{ if FLD_PICFUN then}@{FLD_PICFUN}\
{ if AT("S", FLD_PICFUN) then}{FLD_PIC_SCROLL}{endif}\
{//leave this space}\
{ endif
if !AT("S", FLD_PICFUN) and !AT("M", FLD_PICFUN) then
FLD_TEMPLATE}\
{ endif}" \
{ endif}
ACTIVATE SCREEN
ACTIVATE POPUP {get_popname(FLD_OK_COND)}
DEACTIVATE WINDOW {get_popname(FLD_OK_COND)}
IF LASTKEY() <> EscKey
rtn_fld = PROMPT()
@ {nul2zero(ROW_POSITN)},{nul2zero(COL_POSITN)} GET rtn_fld \
{ if Ok_Template(flds) then}
PICTURE "{ if FLD_PICFUN then}@{FLD_PICFUN}\
{ if AT("S", FLD_PICFUN) then}{FLD_PIC_SCROLL}{endif}\
{//leave this space}\
{ endif
if !AT("S", FLD_PICFUN) and !AT("M", FLD_PICFUN) then
FLD_TEMPLATE}\
{ endif}" \
{ endif}
CLEAR GETS
DO CASE
CASE TYPE("fld_name") = "C"
REPLACE A->{get_field(FLD_OK_COND)} WITH rtn_fld
CASE TYPE("fld_name") $ "NF"
REPLACE A->{get_field(FLD_OK_COND)} WITH VAL(rtn_fld)
ENDCASE
SELECT 1
RETURN (.T.)
ELSE
SELECT 1
{
if !is_required(FLD_OK_COND) then
}
IF empty(fld_name) && Not a required field, so return
RETURN (.T.) && if null field
ENDIF
{
endif
}
RETURN (.F.)
ENDIF
ELSE
SELECT 1
RETURN (.T.)
ENDIF
SELECT 1 && Go back to the edit file
*-- EOP: {get_udfname(Fld_fieldname)}
RETURN (.F.)
{
endif
next flds;
}
{print("*"+replicate("-",78)+crlf);}
{
fileerase(frame_path+"u_"+rtrim(substr(name,1,6))+".DBO");
endif; // there were POPUP VALID clauses
if cnt == 0 then
pause(form_empty + any_key)
endif
fileerase(fmt_name+".FMO")
nogen:
return 0;
//---------------------------------------
// Template user defined functions follow
//---------------------------------------
define header()
// Print Header in program
print( replicate( "*",80) + crlf);}
*-- Name.......: {filename(fmt_name)}FMT
*-- Date.......: {ltrim( substr( date(),1,8))}
*-- Version....: dBASE IV, Format {FRAME_VER}.1
*-- Notes......: Format files use "" as delimiters!
{ print( replicate( "*",80) + crlf);
enddef
//--------------------------------------------------------------
define ok_template(cur)
var temp; temp = cur.FLD_TEMPLATE
if cur.FLD_TEMPLATE && !(chr(cur.FLD_VALUE_TYPE) == "D" ||
chr(cur.FLD_VALUE_TYPE) == "M") then
return 1;
else
return 0;
endif
enddef
//--------------------------------------------------------------
define screen_size()
// Test screen size if display > 2 screen is 43 lines
display = numset(_flgcolor)
if display > ega25 then scrn_size = 39 else scrn_size = 21 endif
// Test to see if status was off before going into form designer
dB_status = numset(_flgstatus)
if scrn_size == 21 and !db_status then
scrn_size = 24
endif
if scrn_size == 39 and !db_status then // status is off
scrn_size = 42
endif
return;
enddef
//--------------------------------------------------------------
define display_type()
var temp;
case display of
mono: temp = "MONO"
cga: temp = "COLOR"
ega25: temp = "EGA25"
mono43: temp = "MONO43"
ega43: temp = "EGA43"
endcase
return temp;
enddef
//--------------------------------------------------------------
define getcolor(f_display, f_editable)
// Determines the color from f_display and f_editable (GET or SAY)
enum Foreground = 7,
Intensity = 8, // Color
Background = 112,
MIntensity = 256,
Reverse = 512, // Mono
Underline =1024,
Blink =2048,
default =32768; // Screen set to default
var forgrnd, enhanced, backgrnd, blnk, underln, revrse, use_colors, incolor;
incolor=""
use_colors = default & f_display
forgrnd = Foreground & f_display
enhanced = (Intensity & f_display) || (MIntensity & f_display)
backgrnd = Background & f_display
blnk = Blink & f_display
underln = Underline & f_display
revrse = Reverse & f_display
if not use_colors then // Use system colors, no colors set in designer
if backgrnd then backgrnd = backgrnd/16 endif
if (display != mono and display != mono43) then
case forgrnd of
0: incolor = "n"
1: incolor = "b"
2: incolor = "g"
3: incolor = "bg"
4: incolor = "r"
5: incolor = "rb"
6: incolor = "gr"
7: incolor = "w"
endcase
else
incolor = "w"
endif
if revrse then
incolor = incolor + "i"
endif
if underln then
incolor = incolor + "u"
endif
if enhanced then
incolor = incolor + "+"
endif
if blnk then
incolor = incolor + "*"
endif
incolor = incolor + "/"
if (display != mono and display != mono43) then
case backgrnd of
0: incolor = incolor + "n"
1: incolor = incolor + "b"
2: incolor = incolor + "g"
3: incolor = incolor + "bg"
4: incolor = incolor + "r"
5: incolor = incolor + "rb"
6: incolor = incolor + "gr"
7: incolor = incolor + "w"
endcase
else
incolor = incolor + "n"
endif
if f_editable and incolor then
incolor = incolor + "," + incolor
endif
endif // use no colors
return alltrim(incolor);
enddef
//--------------------------------------------------------------
define outbox(mbox, mchar)
var result;
// Output the of Box border and charater if any
case mbox of
0: result = " " // single
1: result = " DOUBLE "
2: result = " CHR("+mchar+") "
endcase
return result;
enddef
//--------------------------------------------------------------
define outcolor()
// Output the of color of the @ SAY GET or Box
var result;
result = "";
if len(color) > 0 then
if color_flg then
// If flag is set output a dBASE continuation ";"
result = ";"+crlf+space(3)
endif
result = result + "COLOR " + color + " "
endif
return result;
enddef
//--------------------------------------------------------------
define Window_Def(cur)
var result;
result = "Wndow" + wnd_cnt + " FROM " + Box_Coordinates(cur)
result = result + outbox(cur.BOX_TYPE, cur.BOX_SPECIAL_CHAR)
color = getcolor(cur.FLD_DISPLAY, cur.FLD_EDITABLE)
result = result + outcolor()
return result;
enddef
//--------------------------------------------------------------
define Box_Coordinates(cur)
var result;
result = nul2zero(cur.BOX_TOP) - line_cnt+","
result = result + nul2zero(cur.BOX_LEFT)+" TO "
temp = nul2zero(cur.BOX_TOP) + cur.BOX_HEIGHT - line_cnt - 1
if temp > scrn_size then temp = scrn_size endif
result = result + temp + "," + (nul2zero(cur.BOX_LEFT) + cur.BOX_WIDTH - 1)
return result;
enddef
//--------------------------------------------------------------
define Carry_Flds()
carry_len = carry_lent = 13
carry_first = 0
foreach FLD_ELEMENT flds
if FLD_CARRY then
carry_len = carry_len + len(FLD_FIELDNAME + ",")
carry_lent = carry_lent + len(FLD_FIELDNAME + ",")
if carry_lent > 1000 then
print(crlf + "SET CARRY TO ")
carry_len = carry_lent = 13
endif
if carry_len > 75 then print(";" + crlf + " ") carry_len = 2 endif
temp = lower(FLD_FIELDNAME)
if !carry_first then
print(temp)
carry_first = 1
else
print("," + temp)
endif
endif
next flds
print(" ADDITIVE");
return
enddef
//--------------------------------------------------------------
define make_fmt()
// Attempt to create program.
default_drv = strset(_defdrive) // grab default drive from dBASE
fmt_name = FRAME_PATH + NAME // Put path on to object name
if not fileok(fmt_name) then
if !default_drv then
fmt_name = NAME
else
fmt_name = default_drv + ":" + NAME
endif
endif
fmt_name = upper(fmt_name)
if not create(fmt_name+".FMT") then
pause(fileroot(fmt_name) +".FMT" + read_only + any_key)
return 0;
endif
return 1;
enddef
//--------------------------------------------------------------
define nul2zero(numbr)
// if number is nul and we are expecting a zero - convert the nul to 0
if !numbr then numbr=0 endif
return numbr;
enddef
//--------------------------------------------------------------
define check_for_popups()
foreach Fld_element flds
if AT("POPUP", UPPER(FLD_OK_COND)) then
is_popup = 1
exit
endif
next flds
return is_popup;
enddef
//--------------------------------------------------------------
define parse_line( before, // Out: chars before the look_for string
input, // In: line being parsed
look_for // In: string searched for
) // Rtn: chars after the look_for string
// If the look_for sting is not found, the before sting will equal the
// input string, and the returned value will be NUL
var
location;
location = AT(look_for, UPPER(input))
if location == 0 then
before = input
return ( "" );
endif
before = substr( input, 1, location-1)
return ( substr( input,
location+len(look_for),
len(input)
)
);
// end: parse_line()
enddef
//--------------------------------------------------------------
// Parsing routines for pulling objects out of the VALID string
// "POPUP" = "file->fld_name ORDER key_fld REQ"
// 1234567890123456789012345678901234567890123
// 1 2 3 4
define get_file(valid_str)
var s_arrow, // String "->"
test,
s_equal, // String "="
next_alpha,
at_alias,
s_before, // String before the searched for item
r_target, // Remainder of the target string after item
use_name; // Return for file
s_arrow = "->"
s_equal = "="
r_target = parse_line( s_before, valid_str, s_equal ) // ' "file->...'
next_alpha = atalpha(r_target) // 3
at_alias = AT(s_arrow, r_target) // 7
use_name = substr(r_target,next_alpha,at_alias-next_alpha) // 'file'
return use_name;
enddef
//--------------------------------------------------------------
define get_key(valid_str)
var s_order, // String "ORDER "
at_space,
s_before, // String before the searched for item
r_target, // Remainder of the target string after item
order_tag; // Search TAG to ORDER BY
s_order = "ORDER "
r_target = parse_line( s_before, valid_str, s_order ) // 'key_fld REQ'
at_space = AT(" ",r_target)
if at_space == 0 then
order_tag = substr(r_target, 1, len(r_target)-1) // 'key_fld"'
else
order_tag = substr(r_target, 1, at_space-1)
endif
return order_tag;
enddef
//--------------------------------------------------------------
define get_field(valid_str)
var s_arrow, // String "->"
at_space,
s_before, // String before the searched for item
r_target, // Remainder of the target string after item
fld_name; // Field name to lookup in target file
s_arrow = "->"
r_target = parse_line( s_before,
valid_str, s_arrow ) // 'fld_name ORDER...'
at_space = AT(" ",r_target)
if at_space == 0 then
fld_name = r_target
else
fld_name = substr(r_target, 1, at_space-1)
endif
return fld_name;
enddef
//--------------------------------------------------------------
define get_popname(valid_str)
var pop_name;
pop_name = "u_" + substr(get_field(valid_str),1,6);
return pop_name;
enddef
//--------------------------------------------------------------
define get_udfname(fld_str)
var udf_name;
udf_name = "u_" + substr(fld_str,1,6);
return udf_name;
enddef
//--------------------------------------------------------------
define is_required(valid_str)
var req_flag;
if AT("REQ",valid_str) then
req_flag = 1
else
req_flag = 0
endif
return req_flag;
enddef
}
// EOP FORM.COD
------------------------------------------------------------------------------