home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Black Box 4
/
BlackBox.cdr
/
progpas
/
gsdb25.arj
/
ADDENDUM.001
next >
Wrap
Text File
|
1991-08-03
|
66KB
|
2,018 lines
Addendum
════════
CHANGES and ADDITIONS to GS_DBASE
1. GS_DATE:
The GS_Date unit was added to properly handle the treatment of dates in
calculations. The value used to store a date is a longint which will contain
the Julian Date. This value contains the number of days between the date and
March 1, 0000. This type of storage simplifies using math with dates and
conversion between date formats. Also, dBase uses this format to work with
dates, and even stores this value in index files using a date as the index.
Acknowledgements:
An astronomers' Julian day number is a calendar system which is useful
over a very large span of time. (January 1, 1988 A.D. is 2,447,162 in
this system.) The mathematics of these procedures originally restricted
the valid range to March 1, 0000 through February 28, 4000. The update
by Carley Phillips changes the valid end date to December 31, 65535.
The basic algorithms are based on those contained in the COLLECTED
ALGORITHMS from Communications of the ACM, algorithm number 199,
originally submitted by Robert G. Tantzen in the August, 1963 issue
(Volume 6, Number 8). Note that these algorithms do not take into
account that years divisible by 4000 are NOT leap years. Therefore the
calculations are only valid until 02-28-4000. These procedures were
modified by Carley Phillips (76630,3312) to provide a mathematically
valid range of 03-01-0000 through 12-31-65535.
The main part of Tantzen's original algorithm depends on treating
January and February as the last months of the preceding year. Then,
one can look at a series of four years (for example, 3-1-84 through
2-29-88) in which the last day will be either the 1460th or the 1461st
day depending on whether the 4-year series ended in a leap day.
By assigning a longint julian date, computing differences between
dates, adding days to an existing date, and other mathematical actions
become much easier.
Units used are:
Dos Turbo Pascal unit called to get the
current date.
Types/Constants/Variables used are:
GS_Date_Century Variable boolean holds year format flag.
If true, year will be displayed MM/DD/YYYY,
otherwise as MM/DD/YY.
GS_Date_JulInv Constant value for an invalid date.
GS_Date_StrTyp Type for date string.
-1- GS_Date
Griffin Solutions
═════════════════
GS_Date_ValTyp Type for longint date.
Procedures/Functions used are:
GS_Date_Curr Function returns the current date as a
longint value.
GS_Date_DBStor Function converts longint to YYYYMMDD.
GS_Date_Jul2MDY Procedure converts longint Julian Date
to month, day, year word values.
GS_Date_Juln Function converts string date to longint.
GS_Date_MDY2Jul Function converts numeric month, day, and
year to longint Julian Date.
GS_Date Interface:
uses
Dos;
const
GS_Date_JulInv = -1; {constant for invalid Julian day}
type
GS_Date_StrTyp = string[10];
GS_Date_ValTyp = longint;
var
GS_Date_Century : boolean;
function GS_Date_Curr : GS_Date_ValTyp;
function GS_Date_DBStor(nv : GS_Date_ValTyp) : GS_Date_StrTyp;
function GS_Date_View(nv : GS_Date_ValTyp) : GS_Date_StrTyp;
function GS_Date_Juln(sdate : GS_Date_StrTyp) : GS_Date_ValTyp;
function GS_Date_MDY2Jul(month, day, year : word) : GS_Date_ValTyp;
procedure GS_Date_Jul2MDY(jul : GS_Date_ValTyp;
var month,day,year : word);
Sample program:
The sample program, DB_Xpl15.PAS, demonstrates the features of this unit.
Try the program both with GS_Date_Century true and false to see how the
format of the date field changes. GS_Date_Century defaults to false.
The program begins by loading the current date into CurDateVal
(CurDateVal := GS_Date_Curr). It then displays the date (Write('Current
date is: ',GS_Date_View(CurDateVal))). The numeric value is also written
for comparison.
A loop is processed that will continue until the date the user types is
the current date. Note the date comparison is numeric, so the format
GS_Date -2-
Addendum
════════
used to enter the date may be different. Try using YYYYMMDD as well as
MM/DD/YY (or MM/DD/YYYY) to enter a date.
In the loop, the date is read and validated in Date_Read:
jul := GS_Date_Juln(t);
if jul <> GS_Date_JulInv then OkDate := true else OkDate := false;
The date is then displayed in dBase format and "view" format:
Writeln('Date in dBase storage format is: ',
GS_Date_DBStor(RecDateVal));
Writeln('Date shown in "view" format is: ',
GS_Date_View(RecDateVal));
Next, the use of math with dates is demonstrated:
Writeln('Days between today and record date = ',
CurDateVal-RecDateVal:6);
Writeln('90 days after record date is: ',
GS_Date_View(RecDateVal+90));
Finally, access to and manipulation of month, day, and year is
demonstrated:
GS_Date_Jul2MDY(RecDateVal,mm,dd,yy);
WrkDateVal := GS_Date_MDY2Jul(1,1,yy);
Writeln('Days since Jan 1 are: ',RecDateVal-WrkDateVal);
This demonstration shows how to easily work with date fields. Try your
own ideas to change this program to test how much easier it is to treat
a date field as a numeric value for ease of comparison and adjustment.
-3- GS_Date
Griffin Solutions
═════════════════
GS_Date -4-
Addendum
════════
2. GS_STRNG:
The GS_Strng routines provide string handling routines that simplify life for
the programmer. Most of these provide a function that may be included as part
of another argument (such as writeln(AllCaps(locasestring))).
Units used are:
Crt Turbo Pascal unit called to get the
Delay command.
Dos Turbo Pascal unit called to get the
current date.
GS_Date Griffin Solutions unit called for date
conversion procedures.
Procedures/Functions used are:
AllCaps Function returns a string with lower-
case characters converted to uppercase.
CnvAscToStr Procedure to convert a ZASCII string (a
string terminated by a null 0) to a Turbo
Pascal string in which the first byte
contains the length.
CnvStrToAsc Procedure to convert a Turbo Pascal string
in which the first byte contains the string
length to a ZASCII string (a string which
is terminated by a null 0).
Strip_Flip Function will remove tailing spaces and
move any part of the string that is pre-
ceeded by a '~' to the end of the string.
StrDate Function will return a string value for
the numeric Julian Date value passed to
the routine.
StrLogic Function will return a string value for
the logical value passed to it. The value
returned will be 'T' or 'F'.
StrNumber Function will return a string value for
the numeric real value passed to it.
SubStr Function will return a substring of the
string value passed to it.
TrimL Function will return a string with all of
the leading blank positions removed.
TrimR Function will return a string with all of
-5- GS_Strng
Griffin Solutions
═════════════════
the trailing blank positions removed.
Unique_Field Function will return a string composed of
eight unique characters. Used to make a
unique data key.
ValDate Function will return a numeric Julian Date
value based on the string date passed to
the routine.
ValLogic Function will return a boolean value based
on the string value passed to the routine.
ValNumber Function will return a real number based
on the string value passed to the routine.
GS_String Interface:
uses
Crt,
Dos,
GS_Date;
function AllCaps(var t : string) : string;
procedure CnvAscToStr(var asc, st; lth : integer);
procedure CnvStrToAsc(var st, asc; lth : integer);
function Strip_Flip(st : string) : string;
function StrDate(jul : longint) : string;
function StrLogic(tf : boolean) : string;
function StrNumber(num : real; lth,dec : integer) : string;
function SubStr(s : string; b,l : integer) : string;
function TrimL(strn : string):string;
function TrimR(strn : string):string;
function Unique_Field : string;
function ValDate(strn : string) : longint;
function ValLogic(strn : string) : boolean;
function ValNumber(strn : string) : real;
Sample program:
The sample program, DB_Xpl16.PAS, demonstrates the features of this unit.
Try the program to see how different string handling routines may be
implemented.
GS_Strng -6-
Addendum
════════
3. GS_WINFC:
The GS_Winfc unit forms an interface to the programmer's window unit. It is
a front end to GS_Windw, but may be modified to call routines in another
window handler easily. All Griffin Solutions calls to windows go through
GS_Winfc, and so this forms a 'hook' where the programmer may redirect
these windows calls if he so chooses.
Units used are:
GS_Windw Griffin Solutions window routines. You
may replace this unit with another and
modify the procedures to call the new
routines instead.
Types/Constants/Variables used are:
GS_Wind_Objt Object that processes window requests
Win_Obj Object that links to GS_Windw.GS_Wind_Objt
to process window requests
x1, y1, x2, y2 Variables to hold window size
fg, bg, tx, bgh, txh Variables to hold window colors.
Procedures/Functions/Methods used are:
GS_Wind_Objt.InitWin Method to initialize a window. Arguments
passed are window size, colors for text,
background, foreground, and inverted text
and background, boolean flag to determine
whether to draw a box around the window, a
name for the window, and a boolean flag to
preserve and restore screen areas that are
overwritten by the window.
GS_Wind_Objt.NamWin Method to rename a window
GS_Wind_Objt.RelWin Method to remove a window from the screen
GS_Wind_Objt.SetWin Method to put a window on the screen
GS_Wind_GetColors Procedure to get current window colors
GS_Wind_GetWinSize Procedure to get current window size
GS_Wind_SetColors Procedure to set new colors for the
current window.
GS_Wind_SetNmMode Procedure to set normal mode colors
-7- GS_Winfc
Griffin Solutions
═════════════════
(normal text and background colors).
GS_Wind_SetFgMode Procedure to set Emphasized mode colors
(normal foreground and background colors).
GS_Wind_SetIvMode Procedure to set Inverted mode colors
(inverted fore and background colors).
GS_Winfc Interface:
uses
GS_Windw;
type
GS_Wind_Objt = Object
Win_Obj : GS_Windw.GS_Wind_Objt;
x1,
y1,
x2,
y2 : integer; {Window size}
fg, {Foreground color}
bg, {Background color}
tx, {Text color}
bgh, {Inverted background color}
txh : byte; {Inverted text color}
procedure InitWin (x1w,y1w,x2w,y2w : integer;
txw,bgw,fgw,txx,bgx : integer;
dbox : boolean;
bname : GS_Wind_Str80;
cpywin : boolean);
procedure NamWin(bname:string);
procedure RelWin;
procedure SetWin;
end;
Procedure GS_Wind_GetColors(var txw,bgw,fgw,txx,bgx : byte);
Procedure GS_Wind_GetWinSize(var x1,y1,x2,y2 : integer);
Procedure GS_Wind_SetColors(txw,bgw,fgw,txx,bgx : byte);
Procedure GS_Wind_SetNmMode;
Procedure GS_Wind_SetFgMode;
Procedure GS_Wind_SetIvMode;
Sample program:
The sample program, DB_Xpl17.PAS, demonstrates the features of this unit.
Try the program to see how easily windows may be implemented.
GS_Winfc -8-
Addendum
════════
4. STATUSUPDATE:
Several functions in GS_dBase can take some time to complete (e.g., IndexTo
and Pack). For this reason, a virtual method StatusUpdate has been added to
the GS_dBFld unit to allow the user to gain access and track progress. The
StatusUpdate method in GS_dBFld does nothing--it is there as the default if
the user chooses not to take advantage of the capability by adding his or her
own virtual StatusUpdate method.
Sample program:
The sample program, DB_Xpl18.PAS, demonstrates the how this procedure
may be installed in a user's program. Note an Init and StatusUpdate
method are implemented through a child object of GS_dBFld. All calls
to StatusUpdate anywhere in the object's heirarchy will come through
this 'hook'.
Constants passed as arguments are contained in the GS_dBFld unit, they
are:
StatusStart = -1; Passed to indicate a routine will be passing
status update information.
StatusStop = 0; Signals termination by a routine, cancelling
status update processing.
StatusIndexTo = 1; Token for identifying IndexTo as the routine
passing status information.
StatusPack = 2; Token for identifying Paack as the routine
passing status information.
The structure of a StatusUpdate call is:
StatusUpdate(statword1, statword2, statword3);
where the statword* values are type longint and will vary depending on
the contents of statword1. For example:
statword1 = StatusStart
statword2 = the calling routine token (StatusIndexTo or
StatusPack.
statword3 = the number of records to be processed.
statword1 = StatusStop
statword2 = 0
statword3 = 0
statword1 = StatusIndexTo or StatusPack
statword2 = current record number being processed
statword3 = 0
Refer to the sample program to see one way StatusUpdate may be used.
-9- StatusUpdate
Griffin Solutions
═════════════════
__________________________________________________
GS_Date_Century Boolean Unit: GS_Date
Flag used to set the format for showing the year. When true, the GS_Date_View
function will return MM/DD/YYYY. When false, only the last two digits of the
year will be returned (MM/DD/YY). The default is false.
__________________________________________________
GS_Date_JulInv Constant Unit: GS_Date
Constant value (-1) returned during conversion of string dates to a Julian
Date longint value. If the date is a valid one (03/01/0000 to 12/31/65335),
the numeric value is returned. If the date is invalid, GS_Date_JulInv value
is returned.
__________________________________________________
GS_Date_StrTyp Type Unit: GS_Date
Variable type of string[10] used to contain the string date values. This will
hold an eight-character value in dBase format (YYYYMMDD), or either an eight
or ten-character value in view format (MM/DD/YY or MM/DD/YYYY). The length is
dependent on the status in GS_Date_Century, which dictates whether the year is
representer with two or four characters.
__________________________________________________
GS_Date_ValTyp Type Unit: GS_Date
Variable type of LongInt used to contain the Julian Date. This may be used to
easily add/subtract/compare dates.
Data Items -10-
Addendum
════════
__________________________________________________
AllCaps Function Unit: GS_Strng
Function to convert a string to uppercase.
Call:
NewStr := AllCaps(OldStr)
Where:
OldStr is the string to be converted.
NewStr is the string to hold the converted value.
Result:
A string converted to all uppercase values is returned.
__________________________________________________
CnvAscToStr Procedure Unit: GS_Strng
Procedure to convert a ZASCII string (a string terminated by a null 0) to a
Turbo Pascal string in which the first byte contains the length.
Call:
CnvAscToStr(AscString, TPString, size)
Where:
AscString is the string to be converted (terminated by a zero).
TPString is the Turbo Pascal string to hold the converted value.
size is the maximum length of the string to move. This should
normally be sizeof(TPString)-1, to ensure there is no overrun
of the Turbo Pascal string size. Sizeof gets the size of the
string, including the length byte. Therefore, one must be
subtracted to adjust for actual positions available.
Result:
A string of characters in memory is moved to a Turbo Pascal string
variable. if there is a null (zero) character within the length of the
moved string, that position is used to set the string length. Otherwise,
the length of the string is set to the size argument.
__________________________________________________
CnvStrToAsc Procedure Unit: GS_Strng
Procedure to convert a Turbo Pascal string in which the first byte contains
the string length to a ZASCII string (a string which is terminated by a null
(zero).
-11- Routines
Griffin Solutions
═════════════════
Call:
CnvStrToAsc(TPString, AscString, size)
Where:
TPString is the Turbo Pascal string to convert.
AscString is the location to store the converted string (terminated by a
zero).
size is the maximum length of the string to move. This should
normally be sizeof(AscString), to ensure there is no overrun
of the ZASCII string size. Sizeof gets the maximum size of the
string. Therefore, the programmer must ensure the actual string
moved is at least one less, to adjust for actual positions
available, and still accomodate a final null byte.
Result:
A Turbo Pascal string is moved to a series of consecutive locations
in memory. A null (zero) character is inserted as the final byte to create
a ZASCII string.
__________________________________________________
DateGet Function Unit: GS_dBFld
Function method that returns the formatted date from a record date field. The
value returned will be a numeric longint value representing the Julian date
value.
Call:
NewVal := ObjectName.DataGet(FldStr)
Where:
ObjectName is the child object name the programmer assigns for
GS_dBFld_Objt.
FldStr is the string containing the field name for the field desired.
NewVal is a longint variable where the converted date field data will be
placed.
Result:
The date in numeric Julian Date value will be returned. If the date in
the dBase field is invalid, less than 3 Mar 0000, or greater than 31 Dec 65536,
a -1 will be returned.
__________________________________________________
DatePut Procedure Unit: GS_dBFld
Routines -12-
Addendum
════════
Procedure method that stores a date value in a record field. The value stored
will be in longint Julian date. It will be converted to the character string
YYYYMMDD to be stored in the dBase record.
Call:
ObjectName.DatePut(FldStr, DatVal)
Where:
ObjectName is the child object name the programmer assigns for
GS_dBFld_Objt.
FldStr is the string containing the field name for the field desired.
DatVal is a longint variable containing the date in Julian Date format to
be converted and stored in the record field.
Result:
The date in YYYYMMDD format will be stored in the current record in the
specified field.
__________________________________________________
GS_Date_Curr Function Unit: GS_Date
Function that returns the current date through a system DOS call. The value
returned will be a numeric longint value representing the Julian date value.
Call:
CurVal := GS_Date_Curr
Where:
CurVal is a longint variable where the Julian Date value for Today's
Date will be placed.
Result:
The date in numeric Julian Date value will be returned. If the date in
the dBase field is invalid, less than 3 Mar 0000, or greater than 31 Dec 65536,
a -1 will be returned.
__________________________________________________
GS_Date_DBStor Function Unit: GS_Date
Function that returns a string value in dBase storage format (YYYYMMDD) based
on the Julian Date provided.
Call:
StrVal := GS_Date_DBStor(JulVal)
-13- Routines
Griffin Solutions
═════════════════
Where:
JulVal is a longint variable containing a Julian Date value.
StrVal will contain the string date in YYYYMMDD.
Result:
Date in YYYYMMDD will be returned in StrVal.
__________________________________________________
GS_Date_Jul2MDY Procedure Unit: GS_Date
Procedure that converts a longint Julian Date value to the component month,
day, and year numeric values.
Call:
GS_Date_Jul2MDY(JulVal, month, day, year)
Where:
JulVal is a longint variable containing a Julian Date value.
month,
day,
year - are word variables that will hold the month, day, and year values
that the Julian Date converts. These variables must be defined
as variables of type word.
Result:
The Julian Date numeric value will be returned as its month, day, and
year component numeric values.
__________________________________________________
GS_Date_Juln Function Unit: GS_Date
Function that returns a Julian date as a longint value. The input value is a
string in MM/DD/YY, MM/DD/YYYY, or YYYYMMDD format.
Call:
JulVal := GS_Date_Juln(StrVal)
Where:
StrVal will contain the string date in MM/DD/YY, MM/DD/YYYY or YYYYMMDD.
JulVal is a longint variable that will contain a Julian Date value.
Result:
Routines -14-
Addendum
════════
The date in numeric Julian Date value will be returned. If the date in
the string field is invalid, less than 3 Mar 0000 or greater than 31 Dec 65536,
a -1 will be returned.
__________________________________________________
GS_Date_MDY2Jul Function Unit: GS_Date
Function that returns a Julian date as a longint value. The input consists of
the numeric month, day, and year.
Call:
JulVal := GS_Date_Juln(month, day, year)
Where:
month,
day,
year - are word variables that will hold the month, day, and year values
for the Julian Date conversion.
JulVal is a longint variable that will contain a Julian Date value.
Result:
The date in numeric Julian Date value will be returned. If the date in
the string field is invalid, less than 3 Mar 0000 or greater than 31 Dec 65536,
a -1 will be returned.
__________________________________________________
GS_Date_View Function Unit: GS_Date
Function that returns a string value in a viewable format (MM/DD/YY or
MM/DD/YYYY) based on the Julian Date provided. The number of characters that
will be in the year position is determined by the status of GS_Date_Century
(False for YY, true for YYYY).
Call:
StrVal := GS_Date_View(JulVal)
Where:
JulVal is a longint variable containing a Julian Date value.
StrVal will contain the string date in MM/DD/YY or MM/DD/YYYY.
Result:
Date in MM/DD/YY or MM/DD/YYYY will be returned in StrVal.
__________________________________________________
GS_Wind_GetColors Procedure Unit: GS_Winfc
-15- Routines
Griffin Solutions
═════════════════
Retrieves the colors used by the current window
Call:
GS_Wind_GetColors(txn, bgn, fgn, txi, bgi)
Where:
txn is an integer variable that will hold the normal text color.
bgn is an integer variable that will hold the normal background
color.
fgn is an integer variable that will hold the normal foreground
color (used for highlighting).
txi is an integer variable that will hold the text color used
during inverted mode.
bgi is an integer variable that will hold the text color used
during inverted mode.
Result:
The current window color values will be stored in txn, bgn, fgn,
txi, and bgi.
__________________________________________________
GS_Wind_GetWinSize Procedure Unit: GS_Winfc
Retrieves the screen window size used by the current window
Call:
GS_Wind_GetWinSize(x1, y1, x2, y2)
Where:
x1 and y1 are coordinates of upper left corner of the window.
x2 and y2 are coordinates of the lower right corner of the window.
Result:
The current window size values will be stored in x1, y1, x2, and y2.
__________________________________________________
GS_Wind_SetColors Procedure Unit: GS_Winfc
Assigns new colors to be used by the current window.
Call:
GS_Wind_SetColors(txn, bgn, fgn, txi, bgi)
Routines -16-
Addendum
════════
Where:
txn is an integer variable holding the normal text color.
bgn is an integer variable holding the normal background color.
fgn is an integer variable holding the normal foreground color
(used for highlighting).
txi is an integer variable holding the text color used during
inverted mode.
bgi is an integer variable holding the text color used during
inverted mode.
Result:
The current window color values will be set to the values in txn,
bgn, fgn, txi, and bgi. They will not become effective until the window is
released and set again or a GS_Wind_Set**Mode command is issued.
__________________________________________________
GS_Wind_SetFgMode Procedure Unit: GS_Winfc
Sets window colors to highlighted mode.
Call:
GS_Wind_SetFgMode
Result:
The current window color values will be set to the values for
highlighted text (using foreground color) and background.
__________________________________________________
GS_Wind_SetIvMode Procedure Unit: GS_Winfc
Sets window colors to inverted mode.
Call:
GS_Wind_SetIvMode
Result:
The current window color values will be set to the values for
inverted text and background.
__________________________________________________
GS_Wind_SetNmMode Procedure Unit: GS_Winfc
Sets window colors to normal mode.
-17- Routines
Griffin Solutions
═════════════════
Call:
GS_Wind_SetNmMode
Result:
The current window color values will be set to the values for
normal text and background.
__________________________________________________
InitWin Procedure Unit: GS_Winfc
Method that initializes a windows object.
Call:
ObjectName.InitWin(xBegin, yBegin, xEnd, yEnd, ClrTx, ClrBg,
ClrFg, ClrIvTx, ClrIvBg, DrawBox, WinName, SaveScreen)
Where:
ObjectName is the child object the programmer assigns for
GS_Wind_Objt.
xBegin is an integer beginning column position on the screen for
the window.
yBegin is an integer beginning row position on the screen for
the window.
xEnd is an integer ending column position on the screen for the
window.
yEnd is an integer ending row position on the screen for the
window.
ClrTx is the color to assign to text in the window.
ClrBg is the background color for the window.
ClrFg is the forground color for the window. This is the color the
box outline and title will have.
ClrIvTx is the color for text in the inverted mode.
ClrIvBg is the background color in inverted mode.
DrawBox is a boolean value indicating if a box should be drawn.
If a box is drawn, the actual window will be inside the box,
and not the window values passed to the method.
WinName is the title to center in the top of the window. This
will only be displayed if a box is drawn.
Routines -18-
Addendum
════════
SaveScreen is a boolean argument to save the screen contents
before a window is displayed, and to restore the screen
when the window is released.
Result:
A window object is initialized and may be set with WinSet and
released with WinRel. It will use the colors that are established in
the initialization process.
__________________________________________________
NamWin Procedure Unit: GS_Winfc
Method that assigns a new name to a window. The name will be displayed
when the window is opened, if the window is boxed.
Call:
ObjectName.NamWin(boxname)
Where:
ObjectName is the child object the programmer assigns for
GS_Wind_Objt.
boxname is a string containing the new name for the window.
Result:
The window associated with the object is assigned the name passed in
the argument boxname. The new name will be displayed when the window
is opened, if a box is drawn around the window.
__________________________________________________
RelWin Procedure Unit: GS_Winfc
Method that releases a window.
Call:
ObjectName.RelWin
Where:
ObjectName is the child object the programmer assigns for
GS_Wind_Objt.
Result:
The window associated with the object is released, the window that
was active before this window was set is activated, and the screen
contents are restored if the option was initialized.
__________________________________________________
-19- Routines
Griffin Solutions
═════════════════
SetWin Procedure Unit: GS_Winfc
Method that opens a window.
Call:
ObjectName.SetWin
Where:
ObjectName is the child object the programmer assigns for
GS_Wind_Objt.
Result:
The window associated with the object is opened. If applicable,
the previous contents of the screen are saved for restoral when the
window is released. The object pointer of the previous window is also
saved so that window can be made active when this window is released.
__________________________________________________
StrDate Function Unit: GS_Strng
Function to convert a longint Julian Date to a formatted date field (MM/DD/YY
or MM/DD/YYYY). The number of characters that will be in the year position is
determined by the status of GS_Date_Century (False for YY, true for YYYY).
Call:
NewDate := StrDate(OldJuln)
Where:
OldJuln is the longint julian date to be converted.
NewDate is the string to hold the converted value.
Result:
Date in MM/DD/YY or MM/DD/YYYY will be returned in StrVal.
__________________________________________________
StrLogic Function Unit: GS_Strng
Function to convert a boolean value to a string containing 'T' or 'F'.
Call:
NewLogic := StrLogic(bool)
Where:
bool is the boolean value to be converted.
Routines -20-
Addendum
════════
NewLogic is the string to hold the converted value.
Result:
A string holding 'T' or 'F' is returned.
__________________________________________________
Strip_Flip Function Unit: GS_Strng
This function will remove trailing spaces and move any part of the string
that is preceeded by a '~' to the end of the string. For Example:
"Smith~John X." will be converted to "John X. Smith" on return.
Call:
NewStr := Strip_Flip(OldStr)
Where:
OldStr is the string to be converted.
NewStr is the string to hold the converted value.
Result:
OldStr will be converted and returned in NewStr. Trailing spaces are
deleted and any part of the string preceeded by a "~" is flipped to the
end of the string.
__________________________________________________
StrNumber Function Unit: GS_Strng
Function to convert a numeric value to a string.
Call:
NewNumber := StrNumber(OldNum, Lgth, Dcml)
Where:
OldNum is the numeric type real value to be converted.
Lgth is the integer length to use for the string.
Dcml is the integer value for number of decimal places.
NewNumber is the string to hold the converted value.
Result:
A string holding the numeric value is returned.
__________________________________________________
-21- Routines
Griffin Solutions
═════════════════
SubStr Function Unit: GS_Strng
Function to return a substring from a string. As a function, this will
allow the user to use the routine directly in other arguments such as
write statements.
Call:
NewStr := SubStr(OldStr, Strt, Lgth)
Where:
OldStr is the string from which the substring is to be extracted.
Strt is the integer number for the starting location within the
string.
Lgth is the integer number of positions to extract.
NewStr is the string to hold the extracted value.
Result:
A string holding the substring value is returned.
__________________________________________________
TrimL Function Unit: GS_Strng
Function to remove leading spaces from a string.
Call:
NewStr := TrimL(OldStr)
Where:
OldStr is the string to be converted.
NewStr is the string to hold the converted value.
Result:
A string with all leading spaces removed is returned.
__________________________________________________
TrimR Function Unit: GS_Strng
Function to remove trailing spaces from a string.
Call:
NewStr := TrimR(OldStr)
Where:
Routines -22-
Addendum
════════
OldStr is the string to be converted.
NewStr is the string to hold the converted value.
Result:
A string with all trailing spaces removed is returned.
__________________________________________________
Unique_Field Function Unit: GS_Strng
Function to return an eight-character unique string. This is useful to make
a one-of-a-kind data name as a unique key. Punctuation symbols will also be
used, so it may not be useful as a unique file name. A primary purpose of
this function is to create a unique linking name between related files where
no other data record is assured of being unique. For example, in a family
tree file, there may be several people with the same name. By adding a unique
key when a new name is entered, you may be assured of "uniqueness" of record
identifiers for related files, such as spouse or parent files.
Call:
NewStr := TrimR(OldStr)
Where:
OldStr is the string to be converted.
NewStr is the string to hold the converted value.
Result:
A string with all trailing spaces removed is returned.
__________________________________________________
ValDate Function Unit: GS_Strng
Function to convert a string date field (MM/DD/YY, MM/DD/YYYY, or YYYYMMDD) to
a longint Julian Date.
Call:
NewJuln := ValDate(OldDate)
Where:
OldDate is the string holding the date in MM/DD/YY, MM/DD/YYYY, or
YYYYMMDD format.
NewJuln is the longint julian date variable to hold the returned value.
Result:
The date in numeric Julian Date value will be returned. If the date in
-23- Routines
Griffin Solutions
═════════════════
the string field is invalid, blank, less than 3 Mar 0000 or greater than 31 Dec
65536, a 0 will be returned. Note the difference between this and the -1
returned by GS_Date_Juln. A zero is returned to maintain consistency with an
all-blank date field in a dBase record.
__________________________________________________
ValLogic Function Unit: GS_Strng
Function to convert string to a boolean value.
Call:
bool := StrLogic(OldLogic)
Where:
OldLogic is the string holding a character to be converted.
bool is the converted boolean value.
Result:
If the OldLogic value is "T","t","Y", or "y", bool is set true, else
bool is set false.
__________________________________________________
ValNumber Function Unit: GS_Strng
Function to convert a string to a numeric value.
Call:
NewNumber := ValNumber(OldNum)
Where:
NewNumber is the converted numeric type real value.
OldNum is the string to convert.
Result:
A numeric value is returned which is the string's value. If the string
is invalid, a zero is returned.
Routines -24-
Addendum
════════
Sample Program to Demonstrate GS_Date
program DB_Xpl15;
uses
CRT,
DOS,
GS_KeyI,
GS_Winfc,
GS_Date;
var
KeyinObj : GS_KeyI_Objt;
CurDateVal,
WrkDateVal,
RecDateVal : GS_Date_ValTyp;
mm,
dd,
yy : word;
function Date_Read(x,y : integer; defdate : longint) : GS_Date_ValTyp;
var
t : string[10];
tl : integer;
okDate : boolean;
jul : longint;
begin
t := GS_Date_View(defdate);
repeat
GS_Wind_SetIVMode;
tl := length(t);
t := KeyInObj.EditString(t, x, y, tl);
GS_Wind_SetNmMode;
gotoxy(x,y); {Go to start of field screen position}
write(t,'':tl-length(t));
{Rewrite the string on screen in the original color}
jul := GS_Date_Juln(t);
if jul <> GS_Date_JulInv then OkDate := true else OkDate := false;
if not okDate then SoundBell(BeepTime,BeepFreq);
until okDate;
Date_Read := jul;
end;
begin
{
GS_Date_Century := true;
}
KeyInObj.Init;
CurDateVal := GS_Date_Curr;
ClrScr;
GoToXY(1,1);
Write('Current date is: ',GS_Date_View(CurDateVal));
GoToXY(40,1);
-25- Examples
Griffin Solutions
═════════════════
Write(CurDateVal);
RecDateVal := 0;
while RecDateVal <> CurDateVal do
begin
ClrScr;
GoToXY(1,1);
Write('Enter a date: ');
RecDateVal := Date_Read(15,1,CurDateVal);
GoToXY(1,2);
Writeln('Date in dBase storage format is: ',GS_Date_DBStor(RecDateVal));
Writeln('Date shown in "view" format is: ',GS_Date_View(RecDateVal));
Writeln('Days between today and record date = ',
CurDateVal-RecDateVal:6);
Writeln('90 days after record date is: ',
GS_Date_View(RecDateVal+90));
GS_Date_Jul2MDY(RecDateVal,mm,dd,yy);
WrkDateVal := GS_Date_MDY2Jul(1,1,yy);
Writeln('Days since Jan 1 are: ',RecDateVal-WrkDateVal);
Writeln;
Writeln('Press any key');
WaitForKey;
end;
end.
Examples -26-
Addendum
════════
Sample Program to Demonstrate GS_Strng
program DB_Xpl16;
{$V-}
uses
CRT,
DOS,
GS_Date,
GS_Strng;
var
RealValue : real;
LogicValue : boolean;
DateValue : longint;
LogicString,
RealString,
Str1String,
Str2String,
UniqString,
DateString : string[20];
ZASCII : array[0..20] of char;
i : integer;
begin
ClrScr;
Str1String := ' Smith~John ';
writeln('Original input -->':30,Str1String,'<--');
writeln('UpperCase -->':30,AllCaps(Str1String),'<--');
CnvStrToAsc(Str1String, ZASCII, sizeof(ZASCII));
write('ZASCII String -->':30);
i := 0;
while ZASCII[i] <> #0 do
begin
write(ZASCII[i]);
inc(i);
end;
writeln('<--');
CnvAscToStr(ZASCII, Str2String, sizeof(Str2String)-1);
writeln('Pascal String from ZASCII -->':30,Str2String,'<--');
Str1String := TrimL(Str1String);
writeln('Trim Leading Spaces -->':30,Str1String,'<--');
Str1String := TrimR(Str1String);
writeln('Trim Trailing Spaces -->':30,Str1String,'<--');
writeln('Substring Chars 3-8 -->':30,SubStr(Str1String,3,6),'<--');
writeln('Flip String at ~ -->':30,Strip_Flip(Str1String),'<--');
writeln('Get Unique Field -->':30,Unique_Field,'<--');
DateString := '02/28/1991';
DateValue := ValDate(DateString);
writeln('Julian Date for 02/28/1991 -->':30,DateValue,'<--');
GS_Date_Century := false;
writeln('Date+90 Days (Century Off) -->':30,StrDate(DateValue+90),'<--');
GS_Date_Century := true;
writeln('Date+90 Days (Century On) -->':30,StrDate(DateValue+90),'<--');
-27- Examples
Griffin Solutions
═════════════════
RealValue := 123.456;
writeln('Value 123.456 w/ $ edit -->':30,'$',StrNumber(RealValue,6,2),'<--');
RealString := StrNumber(RealValue + 78.9,9,4);
writeln('String of 123.456 + 78.9 -->':30,RealString,'<--');
writeln('Real of String/2 -->':30,ValNumber(RealString)/2,'<--');
writeln('Formatted String/2 -->':30,ValNumber(RealString)/2:7:4,'<--');
LogicValue := true;
LogicString := StrLogic(LogicValue);
writeln('Logic string for true -->':30,LogicString,'<--');
writeln('Logic boolean for true -->':30,ValLogic(LogicString),'<--');
end.
Examples -28-
Addendum
════════
Sample Program to Demonstrate GS_Winfc
program DB_Xpl17;
uses
CRT,
GS_KeyI,
GS_Winfc;
const
ColorChart : array[0..15] of string[12]
= ('Black','Blue','Green','Cyan','Red','Magenta',
'Brown','LightGray','DarkGray','LightBlue','LightGreen',
'LightCyan','LightRed','LightMagenta','Yellow','White');
var
AskWin,
StatusWin,
WorkWin : GS_Wind_Objt;
textnrml,
foregrnd,
backnrml,
texthilt,
backhilt : byte;
x1,y1,x2,y1 : integer;
procedure ShowColors;
begin
GS_Wind_GetColors(textnrml,backnrml,foregrnd,texthilt,backhilt);
GS_Wind_SetFgMode;
writeln('ForeGround Color is ',ColorChart[foregrnd]);
GS_Wind_SetIvMode;
writeln('Highlighted Text Color is ',ColorChart[texthilt]);
writeln('Highlighted BackGround Color is ',ColorChart[backhilt]);
GS_Wind_SetNmMode;
writeln('Normal Text Color is ',ColorChart[textnrml]);
writeln('Normal BackGround Color is ',ColorChart[backnrml]);
end;
begin
ClrScr;
WorkWin.InitWin(1,1,80,19,Red,Black,Yellow,Blue,LightGray,True,
'[ COLOR INFORMATION ]',true);
AskWin.InitWin(20,8,60,12,Yellow,Blue,Yellow,Black,LightGray,true,
'',true);
StatusWin.InitWin(1,20,80,25,Yellow,Red,Yellow,Red,LightGray,true,'',true);
WorkWin.SetWin;
GS_Wind_GetWinSize(x1,y1,x2,y2);
GotoXY(1,1);
writeln('Window size parameters are ',x1,',',y1,',',x2,',',y2);
writeln;
ShowColors;
GS_Wind_SetColors(Magenta,Cyan,Blue,Yellow,Green);
GS_Wind_SetNmMode;
writeln;
-29- Examples
Griffin Solutions
═════════════════
writeln(' Colors are now different');
writeln;
ShowColors;
StatusWin.NamWin('[ Labeling the Status Box ]');
StatusWin.SetWin;
AskWin.SetWin;
GoToXY(5,2);
write('Press any key to continue');
WaitForKey;
AskWin.RelWin;
GoToXY(5,2);
write('Press any key to exit');
WaitForKey;
StatusWin.RelWin;
WorkWin.RelWin;
end.
Examples -30-
Addendum
════════
Sample Program to Demonstrate GS_dBFld_Objt.StatusUpdate
program DB_Xpl18;
uses
CRT,
DOS,
GS_Winfc,
GS_dBFld,
GS_dBase;
type
Talk_Obj = object(GS_dBFld_Objt)
constructor Init(FName : string);
procedure StatusUpdate(statword1,statword2,
statword3 : longint); virtual;
end;
var
Health : Talk_Obj;
TalkWin : GS_Wind_Objt;
constructor Talk_Obj.Init(FName : string);
begin
GS_dBFld_Objt.Init(FName);
TalkWin.InitWin(10,10,70,15,Blue,LightGray,Yellow,LightGray,Black,true,
'',true);
end;
procedure Talk_Obj.StatusUpdate(statword1,statword2,statword3 : longint);
begin
case statword1 of
StatusStart : begin
case statword2 of
StatusPack : TalkWin.NamWin('[ Pack Progress ]');
StatusIndexTo : TalkWin.NamWin
('[ Index Progress ]');
end;
TalkWin.SetWin;
GotoXY(26,3);
write('Total Records to Process = ',statword3);
end;
StatusStop : begin
TalkWin.RelWin;
end;
StatusPack,
StatusIndexTo : begin
GoToXy(2,3);
write('Record Number ',statword2,' ');
end;
end;
end;
-31- Examples
Griffin Solutions
═════════════════
begin
ClrScr;
Health.Init('HEALTH');
Health.Open;
Health.IndexTo('FOODCODE','FOOD_CODE');
{Create an index. Use field FOOD_CODE}
{and create a .NDX file named FOODCODE}
Health.Index('FOODCODE'); {Use Index FOODCODE.NDX}
Health.GetRec(Top_Record);
while not Health.File_EOF do
begin
writeln(Health.FieldGet('FOOD'),' ',
Health.FieldGet('CALS'),' (',
Health.FieldGet('FOOD_CODE'),')');
Health.GetRec(Next_Record);
end;
Health.Close;
end.
Examples -32-
