Programmer 7500

home *** CD-ROM | disk | FTP | other *** search

/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / GSDB25.ZIP / ADDENDUM.001 next >

Wrap

Text File | 1991-08-03 | 64.1 KB | 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-