Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : TN8911.ZIP
Filename : INITFORM.COD

//
// Module Name: InitForm.COD
// Description: This module is for producing dBASE IV .PRG files
// to be used with MForm.COD
//
//
// Procedure (.prg) File Template
// ******************************
// Version 1.0
// Gary Gregory
// Ashton-Tate (c) 1987, 1988, 1989
//
// This file holds the code to generate the supporting routines to the
// MForm.COD file. This file is loaded by MForm.COD at compile time.
// The following dBASE IV procedures are defined here:
//
// PROCEDURE InitVars
// ------------------
// This Procedure will create and assign default values for
// the memory variables used in the format file created by MForm.GEN
// This procedure can be used for adding records.
//
// PROCEDURE Rec2Vars
// ------------------
// This procedure gets the data from the current record and
// transfers it to memory variables. This procedure can be used
// for adding or editing records.
// Rec2Vars will return true if the record was locked and the data
// transferred. Otherwise the return value is false.
//
// PROCEDURE Vars2Rec
// ------------------
// This procedure gets the data from the memory variables and
// transfers it to the current record. This procedure can be used
// for adding or editing records.
// Vars2Rec will return true if the record was locked and the data
// transferred. Otherwise the return value is false.
//
// PROCEDURE MyLocker
// ------------------
// This procedure will attempt to lock the current record.
// The function will loop until the record gets locked or the
// user hits 'q' or 'Q' to abort the lock attempts.
//
{
var public_len, // Cumulative length of public line until 68 characters
public_lent, // Total cumulative length of public line until 1000
public_first, // Flag to test "," output for public fields
replace_len, // Cumulative length of replace line until 52 characters
replace_lent, // Total cumulative length of replace line until 995
replace_first; // Flag to test "," output for replace fields

//-------------------------------
// Create Procedure File
//-------------------------------
default_drv = strset(_defdrive); // grab default drive from dBASE

fmt_name = frame_path + 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);
fileerase(fmt_name+".PRG");
fileerase(fmt_name+".DBO");
if not create(fmt_name+".PRG") then
pause(fileroot(fmt_name) +".PRG" + read_only + any_key);
goto nogen;
endif;

enum DBF_Char = 67,
DBF_Date = 68,
DBF_Float = 70,
DBF_Logical = 76,
DBF_Memo = 77;

//
// Print header information.
//
print(replicate("*",80)+crlf);}
*-- Name....: {filename(fmt_name)}PRG
*-- Date....: {ltrim(SUBSTR(date(),1,8))}
*-- Version.: dBASE IV {Frame_ver}.0
*-- Function: Procedure file for MForm.COD
{print(replicate("*",80)+crlf);}

PROCEDURE InitVars

*-- This procedure will create and assign default values for
*-- the memory variables used in the format file created by MForm.GEN
*-- This procedure can be used for adding records.

PUBLIC \
{
//
// Output a PUBLIC statement for all memory variables that match
// a database field. Break up the line and/or statement if neccessary.
//

//
// Initialize variables
//
public_len = 7;
public_lent = 0;
public_first = 0;
//
// Start the foreach loop and make sure we deal with a database field
// with the if condition.
//
foreach Fld_element flds
if Fld_fieldtype == dbf then
public_len = public_len + len(Fld_fieldname + ",") + 1;
public_lent = public_lent + public_len;

//
// We may need to break up the PUBLIC declaration into
// more than one statement.
//

if public_lent > 1000 then
print(crlf + "PUBLIC ");
public_len = 8;
public_lent = 0;
public_first = 0;
endif;

//
// We test here to break for a new line.
//

if public_len > 68 then
print(";" + crlf + " ");
public_len = 2;
endif;

//
// We test here to see if we are dealing with the first
// variable after the keyword PUBLIC ...
//

if !public_first then
print("m" + Fld_fieldname);
public_first = 1;

//
// ... if not, we need a comma (,) to separate the variables.
//

else
print("," + "m" + Fld_fieldname);
endif;
endif;
next flds;
print(crlf);
//
// End of PUBLIC processing.
//
}
{
//
// Output the assignment statements.
// We chose the following defaults:
// Blanks for character variables;
// Today's date for date variables;
// Zero (0) for numeric variables.
// Zero (0.00) for float variables.
//
foreach Fld_element flds
if Fld_fieldtype == dbf then}
m{Fld_fieldname} =\
{ case Fld_value_type of
DBF_Char :} SPACE({Fld_length})
{ DBF_Date :} DATE() && We choose today, could also be an empty date.
{ DBF_Float :} 0.00
{ DBF_Logical :} .F.
{ DBF_Memo :} SPACE(254)
{ otherwise } 0
{ endcase;
endif;
next flds;
}
RETURN

*-- EOP: InitVars

PROCEDURE Rec2Vars
PARAMETER Ok

*-- This procedure gets the data from the current record and
*-- transfers it to memory variables. This procedure can be used
*-- for adding or editing.
*-- Rec2Vars will return true if the record was locked and the data
*-- transfered. Otherwise the return value is false.

Ok = .F.
DO MyLocker WITH Ok
IF Ok = .F.
RETURN
ENDIF

{foreach Fld_element flds
if Fld_fieldtype == dbf then}
m{Fld_fieldname} = {Fld_fieldname}
{ endif;
next flds;
}

UNLOCK
RETURN

*-- EOP: Rec2Vars

PROCEDURE Vars2Rec
PARAMETER Ok

*-- This procedure gets the data from the memory variables and
*-- transfers it to the current record. This procedure can be used
*-- for adding or editing.
*-- Vars2Rec will return true if the record was locked and the data
*-- transfered. Otherwise the return value is false.

Ok = .F.
DO MyLocker WITH Ok
IF Ok = .F.
RETURN
ENDIF

REPLACE \
{
//
// Output a REPLACE statement for all memory variables that match
// a database field. Break up the line and/or statement if necessary.
//

//
// Initialize variables
//
replace_len = 8;
replace_lent = 0;
replace_first = 0;
foreach Fld_element flds
//
// Start the foreach loop and make sure we deal with a database field
// with the if condition.
//
if Fld_fieldtype == dbf then
replace_len = replace_len + ( 2 * len(Fld_fieldname)) + 2 + 6;
replace_lent = replace_lent + replace_len;

//
// We may need to break up the REPLACE declaration into
// more than one statement.
//

if replace_lent > 995 then
print(crlf + "REPLACE ");
replace_len = 9;
replace_lent = 0;
replace_first = 0;
endif;

//
// We test here to break for a new line
//

if replace_len > 52 then
print(";" + crlf + " ");
replace_len = 2;
endif;

//
// We test here to see if we are dealing with the first
// variable after the keyword REPLACE ...
//

if !replace_first then
print(Fld_fieldname + " WITH " + "m" + Fld_fieldname);
replace_first = 1;

//
// ... if not, we need a comma (,) to separate each clause.
//

else
print("," + Fld_fieldname + " WITH " + "m" + Fld_fieldname);
endif;
endif;
next flds;
print(crlf);
//
// End of REPLACE processing.
//
}

UNLOCK
RETURN
* EoP: Vars2Rec

PROCEDURE MyLocker
PARAMETER Ok

*-- This procedure will attempt to lock the current record.
*-- The function will loop until the record gets locked or the
*-- user hits 'q' or 'Q' to abort the lock attempts.

Timer = 1
Ok = .T.
ON ERROR SET MESSAGE TO
DO WHILE .NOT. RLOCK()
SET MESSAGE TO " Record Lock Failed On Attempt " + LTRIM(STR(Timer)) ;
+ " Hit 'Q' to Stop Waiting"
Timer = Timer + 1
in = INKEY()
IF (in = 81) .OR. (in = 113)
Ok = .F.
SET MESSAGE TO " Record Locking Aborted "
EXIT
ENDIF
ENDDO
ON ERROR
RELEASE in, Timer
IF Ok = .T.
SET MESSAGE TO " The Record Was Locked "
ENDIF
RETURN
* EoP: MyLocker
* EoF: {filename(fmt_name)}PRG