home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS 1992 September
/
Simtel20_Sept92.cdr
/
msdos
/
clipper
/
code_1.arc
/
TEM_UDFS.PRG
< prev
Wrap
Text File
|
1989-01-02
|
51KB
|
1,023 lines
* SYS_UDF.PRG
* User Defined Functions by Gary L. Cota
* created: 11/25/88
* last update: 01/01/89
*
***************************************************************************
* To Whom It May Concern: *
* --------------------------------------------------------------------- *
* The program code contained herein is a combination of User Defined *
* Functions (UDFs) created by myself and functions collected from *
* other various sources. These sources include DATA BASED ADVISOR *
* magazine, "PROGRAMMING IN CLIPPER" (first and second editions by *
* Stephen Straley, D.O.S.S (Desk Of Stephen Straley newsletter, the *
* REFERENCE(CLIPPER) newsletter to name but a few. I make no claim *
* to ownership of these functions. They are available your use but *
* with no guarantee, warranty, or royalty involved from myself. *
* *
* NOTE: These functions were created for use with CLIPPER SUMMER '87 *
* Version only. It is possible that some may work with the *
* AUTUMN '86 Version but none have been tested with that ver- *
* sion. *
* *
* NOTE: The function names are prefixed with a "c_" to (hopefully) *
* make them unique to current and future versions of CLIPPER *
* and third party UDF libraries. *
* *
* All local variables are prefixed with a "_" (underscore) as *
* in "_in_string". Temporary work variables are prefixed and *
* suffixed with an underscore as in _ma_, _mb_, _mc_, etc. to *
* hopefully prevent any duplicate program memory variable *
* names or CLIPPER reserved words. *
* *
* Gary L. Cota 11/25/88 *
***************************************************************************
*
*
*
FUNCTION c_ALLTRIM
************************************************************************
* PASS: <expC1> *
* *
* RETURNS: The character string minus trimmed leading and trailing *
* spaces. *
* *
* PURPOSE: Uses less memory space than it's CLIPPER counterpart. *
* *
* EXAMPLE: mfirst = FIRST_NAME *
* mlast = LAST_NAME *
* ? c_ALLTRIM(mfirst)+" "+c_ALLTRIM(mlast) *
************************************************************************
*
PARAMETERS _in_string
*
RETURN(LTRIM(TRIM(_in_string)))
*
*
*
FUNCTION c_BLANK
************************************************************************
* PASS: <expC1>, <expC2> (optional) *
* *
* RETURNS: The empty or blank value of a .DBF field. *
* *
* PURPOSE: Initialize blank or empty memory variables from .DBF *
* fields. *
* *
* NOTES: If second paramater is passed, logical fields will be *
* initialized to .F. (false). If a second parameter is not *
* passed, logical fields will be initialized to a character *
* string of SPACE(1). *
* *
* This function may be used in conjunction with the *
* c_DATAGONE() and c_MEMEMPTY() UDFs. *
* *
* EXAMPLE: mCUSTOMER = c_BLANK(CUSTOMER) *
* (where mCUSTOMER is a memory variable and CUSTOMER is a *
* .DBF field name. *
* *
* MBILLABLE = c_BLANK(BILLABLE) *
* (memory variable is initialized to " ") *
* *
* MBILLABLE = c_BLANK(BILLABLE,x) *
* (memory variable is initialized to .F.) *
************************************************************************
*
PARAMETERS _in_string, _my_
*
DO CASE
CASE TYPE("_in_string")="C"
* Character
RETURN(SPACE(LEN(_in_string)))
*
CASE TYPE("_in_string")="D"
* Date
RETURN(CTOD(" / / "))
*
CASE TYPE("_in_string")="L"
* Logical
IF PCOUNT() = 2
*****************************************************
* Second parameter passed. Logical memory variable *
* will be initialized to .F.. *
*****************************************************
RETURN(.F.)
ELSE
*****************************************************
* If one parameter passed, convert logical field to *
* character memory variable of SPACE(1). *
*****************************************************
RETURN(SPACE(1))
ENDIF
*
CASE TYPE("_in_string")="M"
* Memo
RETURN(SPACE(512))
*
CASE TYPE("_in_string")="N"
* Numeric
RETURN(0.00)
*
OTHERWISE
RETURN(.F.)
ENDCASE
RETURN(0)
*
*
*
FUNCTION c_BOXIT
************************************************************************
* PASS: <expN1>, <expN2>, <expN3>, <expN4>, <expN5>, <expC1> *
* *
* where: <expN1> = top row *
* <expN2> = top column *
* <expN3> = bottom row *
* <expN4> = bottom column *
* <expN5> = box type 1-4 (1 is single line box, 2 *
* is double line box, 3 is double line *
* top and bottom and single line sides, *
* and 4 is single line top and bottom *
* and double line sides). *
* <expC1> = optional box color parameter *
* *
* RETURNS: Nothing *
* *
* PURPOSE: Clears area and displays a box or window. *
* *
* EXAMPLE: mboxtype = 1 && single line box *
* mboxcolor = "+BG/N" && color variable *
* * *
* c_BOXIT(16,15,22,63,mtype,sys_box) *
* *
************************************************************************
PARAMETERS _mtr_, _mtc_, _mbr_, _mbc_, _mw_, _my_
*
_mx_ = SETCOLOR()
IF PCOUNT()=6
* color parameter
SETCOLOR(_my_)
ENDIF
*
@ _mtr_,_mtc_ CLEAR TO _mbr_,_mbc_
*
DO CASE
CASE _mw_ = 1
* Single line border box
_mz_ = CHR(218)+CHR(196)+CHR(191)+CHR(179)+CHR(217)+CHR(196)+CHR(192)+CHR(179)
*
CASE _mw_ = 2
* Double line border box
_mz_ = CHR(201)+CHR(205)+CHR(187)+CHR(186)+CHR(188)+CHR(205)+CHR(200)+CHR(186)
*
CASE _mw_ = 3
* Double line top and bottom and single line sides
_mz_ = CHR(213)+CHR(205)+CHR(184)+CHR(179)+CHR(190)+CHR(205)+CHR(212)+CHR(179)
*
CASE _mw_ = 4
* Single line top and bottom and double line sides
_mz_ = CHR(214)+CHR(196)+CHR(183)+CHR(186)+CHR(189)+CHR(196)+CHR(211)+CHR(186)
*
ENDCASE
*
****************
* Draw the box *
****************
@ _mtr_,_mtc_,_mbr_,_mbc_ BOX _mz_
*
SETCOLOR(_mx_)
RETURN(.F.)
*
*
*
FUNCTION c_CENTER
************************************************************************
* PASS: <expC1>, <expN1> *
* *
* RETURNS: Numeric string *
* *
* PURPOSE: Center messages, character strings, etc. for display or *
* print purposes. If the length parameter is not passed, *
* function assumes a width of 80. *
* *
* EXAMPLE: @ 01,c_CENTER("CUSTOMER REPORT",80) SAY "CUSTOMER REPORT" *
************************************************************************
*
PARAMETERS _in_string,_in_number
*
IF TYPE("_in_number")="U"
* If length undefined, assume width of 80
_in_number=80
ENDIF
RETURN(_in_number / 2 - LEN(_in_string) / 2)
*
*
*
FUNCTION c_CENTRMSG
************************************************************************
* PASS: <expC1> *
* *
* RETURNS: Character string *
* *
* PURPOSE: Works in conjunction with the SET MESSAGE TO and PROMPT *
* commands. This function will center the character string *
* found in the MESSAGE string for each PROMPT command by *
* padding the front of the expression with blank spaces. *
* *
* EXAMPLE: SET MESSAGE TO 2 *
* @ 01,23 PROMPT "File Maintenance";+ *
* MESSAGE(c_CNTR_MSG(c_FILL_OUT("Add, Delete, Edit System; *
* Records")) *
************************************************************************
*
PARAMETERS _in_string,_in_number
*
IF TYPE("_in_number")="U"
* If length undefined, assume width of 80
_in_number=80
ENDIF
RETURN(_in_number / 2 - LEN(_in_string) / 2)
*
*
*
FUNCTION c_DATAGONE
************************************************************************
* PASS: Nothing *
* *
* RETURNS: Null *
* *
* PURPOSE: Removes/empties data from current record. NOTE this *
* function is designed to be used with the c_BLANK() *
* function. Overall concept is to blank out data from all *
* fields in a record then reuse the record rather than *
* performing DELETEs and APPEND BLANKs. *
* *
* EXAMPLE: c_DATAGONE() *
************************************************************************
*
PRIVATE _ma_ && Field counter, memvar logic flag
*
IF LEN(ALIAS()) <> 0
* A file is open
FOR _ma_ = 1 TO FCOUNT()
_mb_ = FIELDNAME(_ma_)
IF TYPE("&_mb_.") = "L"
REPLACE &_mb_. WITH .F.
ELSE
REPLACE &_mb_. WITH c_BLANK(&_mb_.)
ENDIF
NEXT
ELSE
* No file is open or selected
BREAK
ENDIF
RETURN(.T.)
*
*
*
FUNCTION c_DECRYPT
************************************************************************
* PASS: <expC1>, <expC2> (optional) *
* *
* RETURNS: Character string *
* *
* PURPOSE: Use to decrypt a Character string that was encrypted *
* using the c_ENCRYPT() function. *
* ------------------------------------------------------------------ *
* NOTE: If customization is required, change the value being sub- *
* tracted in the CHR() statement of the FOR...NEXT loop below. *
* But beware this value must match that being added in the *
* c_ENCRYPT() function. *
* *
* NOTE: This function requires the c_ALLTRIM() and c_FILL_OUT func- *
* tions to be present during the compile and link cycles. *
************************************************************************
PARAMETERS _in_string, _in_key
*
****************************************
* If second parameter has been passed, *
* add key value to password value *
****************************************
IF PCOUNT()=2
_ma_ = LEN(_in_key)
_mc_ = 0
_mx_ = 0
FOR _mc_ = 1 TO (_ma_ + 1)
_mx_ = _mx_ + ASC(SUBSTR(_in_key,_mc_,1)) * _mc_ + _mc_
NEXT
ELSE
_mx_ = 155 && Arbitrary value - may be from 0 to 255 (ASCII)
ENDIF
*
********************************
* Decrypt <expC1> *
********************************
_ma_ = LEN(_in_string)
_mb_ = ""
_mc_ = 0
_in_string = c_ALLTRIM(_in_string)
*
FOR _mc_ = LEN(_in_string) TO 1 STEP -1
_mb_ = _mb_ + CHR(ASC(SUBSTR(_in_string,_mc_,1)) - _mx_ )
NEXT
*
RETURN(c_FILL_OUT(_mb_,_ma_))
*
*
*
FUNCTION c_ENCRYPT
************************************************************************
* PASS: <expC1>, <expC2> (optional) *
* *
* RETURNS: Character string *
* *
* PURPOSE: Used to encrypt a Character string that was encrypted *
* using the c_DECRYPT() function. *
* ------------------------------------------------------------------ *
* NOTE: If customization is required, change the value being added *
* in the CHR() statement of the FOR...NEXT loop below. But *
* beware this value must match that being subtracted in the *
* c_DECRYPT() function. *
* *
* NOTE: The second character string parameter has been added for *
* even more protection. If passed, this second parameter is *
* as a "key" value. The ASCII value of this "key" is added to *
* the CHR() value. If this parameter is used, the value com- *
* puted must match that of the parameter passed in the *
* c_DECRYPT() function. *
* *
* NOTE: This function requires the c_ALLTRIM() and c_FILL_OUT() *
* functions to be present during the compile and link cycles. *
************************************************************************
PARAMETERS _in_string, _in_key
*
****************************************
* If second parameter has been passed, *
* add key value to password value *
****************************************
IF PCOUNT()=2
_ma_ = LEN(_in_key)
_mc_ = 0
_mx_ = 0
FOR _mc_ = 1 TO (_ma_ + 1)
_mx_ = _mx_ + ASC(SUBSTR(_in_key,_mc_,1)) * _mc_ + _mc_
NEXT
ELSE
_mx_ = 155 && Arbitrary value - may be from 0 to 255 (ASCII)
ENDIF
*
********************************
* Encrypt <expC1> *
********************************
_ma_ = LEN(_in_string)
_mb_ = ""
_mc_ = 0
_in_string = c_ALLTRIM(_in_string)
*
FOR _mc_ = LEN(_in_string) TO 1 STEP -1
_mb_ = _mb_ + CHR(ASC(SUBSTR(_in_string,_mc_,1)) + _mx_ )
NEXT
*
RETURN(c_FILL_OUT(_mb_,_ma_))
*
*
*
FUNCTION c_FILL_OUT
************************************************************************
* PASS: <expC1>, <expN1> *
* *
* RETURNS: Character string *
* *
* PURPOSE: Pads Character string with spaces defaulting to a width *
* of 79 if no numeric string is passed. *
* *
* EXAMPLE: @ 01,23 PROMPT "File Maintenance" MESSAGE(c_CNTR_MSG(; *
* c_FILL_OUT("Add, Delete, Edit System Records")) *
* ------------------------------------------------------------------ *
* NOTE: The UDF c_CNTR_MSG must be present for this function to *
* in the above example. *
************************************************************************
PARAMETERS _mx_,_my_
*
IF TYPE("_my_")="U"
* Length is undefined, default to 79
_my_=79
ENDIF
_mz_=_my_ - LEN(_mx_)
RETURN(_mx_ + SPACE(_mz_))
*
*
*
FUNCTION c_FILLAREA
************************************************************************
* PASS: <expN1>, <expN2>, <expN3>, <expN4>, <expN5> *
* *
* where: <expN1> = top row *
* <expN2> = top column *
* <expN3> = bottom row *
* <expN4> = bottom column *
* <expN5> = decimal value of desired character *
* *
* RETURNS: Nothing *
* *
* PURPOSE: Used to fill an area on the screen with an ASCII char- *
* acter. *
* *
* EXAMPLE: c_FILLAREA(10,15,20,25,65) *
************************************************************************
PARAMETERS _mtr_, _mtc_, _mbr_, _mbc_, _ma_
*
@ _mtr_,_mtc_,_mbr_,_mbc_ BOX REPLICATE(CHR(_ma_),9)
*
RETURN("")
*
*
*
FUNCTION c_FILLSCRN
************************************************************************
* PASS: <expC1> *
* *
* RETURNS: Null string *
* *
* PURPOSE: Fills entire screen with the character string <expC1> *
* passed. *
* *
* EXAMPLE: c_FILLSCRN(65) *
************************************************************************
PARAMETERS _ma_
*
@ 00,00,24,79 BOX REPLICATE(CHR(_ma_),9)
*
RETURN("")
*
*
*
FUNCTION c_FIRSTCAP
************************************************************************
* PASS: <expC1> *
* *
* RETURNS: Character string *
* *
* PURPOSE: The first character in the string is capitalized; all *
* remaining characters are in lowercase. *
* *
* EXAMPLE: mTITLE=TITLE && Field contains "MR." *
* mFIRST=FIRST_NAME && Field contains "FRED" *
* mLAST=LAST_NAME && Field contains "JONES" *
* *
* ? c_FIRSTCAP(c_ALLTRIM(mTITLE))+" "+; *
* c_FIRSTCAP(c_ALLTRIM(mFIRST))+" "+; *
* c_FIRSTCAP(c_ALLTRIM(mLAST)) *
* *
* * Output would be "Mr. Fred Jones" *
************************************************************************
PARAMETERS _in_string
*
_ma_ = SUBSTR(_in_string,1,1)
_mb_ = SUBSTR(_in_string,2)
*
RETURN(UPPER(_ma_) + LOWER(_mb_))
*
*
*
FUNCTION c_GATHER
************************************************************************
* PASS: Nothing *
* *
* RETURNS: Null *
* *
* PURPOSE: Replaces field contents with memory variable values. This *
* function is designed to be used with the c_SCATTER func- *
* tion. *
* *
* NOTES: Memory variable names can be a maximum of 10 characters *
* in length. This function ASSUMES DATABASE FILE (.DBF) *
* FIELD NAMES TO BE 9 CHARACTERS OR LESS IN LENGTH. *
* *
* If the field is logical in type and the memory variable *
* is character, the function will convert the character *
* string to a logical equivalent. *
* *
* This function designed to be used in conjunction with *
* the c_SCATTER() UDF. *
* *
* EXAMPLE: c_GATHER() *
************************************************************************
*
PRIVATE _ma_, _mb_, _mc_ && Counter, field, variable name
*
IF LEN(ALIAS()) <> 0
* A file is open
FOR _ma_ = 1 TO FCOUNT()
_mb_ = FIELDNAME(_ma_)
_mc_ = "M" + _mb_
*
IF TYPE("&_mb_.") = "L" .AND. TYPE("&_mc_.") = "C"
*************************************************************
* If the field type is logical and the memory variable type *
* is character, convert the character variable to logical *
* before updating the field. *
*************************************************************
&_mc_. = IF(&_mc_.="Y",.T.,.F.)
ENDIF
*
REPLACE &_mb_. WITH &_mc_.
NEXT
ELSE
* No file is open or selected
BREAK
ENDIF
RETURN(.T.)
*
*
*
FUNCTION c_ISESCAPE
************************************************************************
* PASS: Nothing *
* *
* RETURNS: .T. or .F. *
* *
* PURPOSE: Determines if the ESCape key was pressed during a *
* process and cancels. Will work on a CLIPPER batch *
* statement as well. *
* *
* EXAMPLE: DO WHILE .NOT. EOF() *
* ? NAME, ADDRESS, CITY, STATE, ZIP *
* SKIP *
* IF .NOT. c_ESCAPE *
* EXIT *
* ENDIF *
* ENDDO *
* or *
* LIST ALL NAME,ADDRESS,CITY,STATE,ZIP WHILE c_ISESCAPE() *
************************************************************************
*
_ma_ = INKEY()
*
IF _ma_ = 27
RETURN(.F.)
ENDIF
RETURN(.T.)
*
*
*
FUNCTION c_MEMEMPTY
************************************************************************
* PASS: <expC1> (optional) *
* *
* RETURNS: Empty or blank field values. *
* *
* PURPOSE: Initializes empty or blank memory variables from record's *
* field values. This function is designed to be used with *
* the c_BLANK(), c_GATHER(), and c_SCATTER() functions. *
* *
* NOTES: Memory variable names can be a maximum of 10 characters *
* in length. This function ASSUMES DATABASE FILE (.DBF) *
* FIELD NAMES TO BE 9 CHARACTERS OR LESS IN LENGTH. *
* *
* If a parameter is passed, logical field types will be *
* converted to logical memory variables. The default *
* assumes no parameter; logical fields are converted to *
* character YES/NO memory variables. This is done because *
* most user-interface entry screens prompt for Y/N input *
* rather than a .T./.F.. *
* *
* This function designed to be used with the c_BLANK() UDF. *
* *
* EXAMPLE: c_MEMEMPTY() && Convert logic field to character *
* && memory variable: SPACE(1) *
* or *
* *
* c_MEMEMPTY(x) && Logic field to logic memory variable *
************************************************************************
*
PARAMETER _mx_
*
PRIVATE _ma_, _mb_, _mc_, _my_ && Counter, field, variable name, logic field flag
*
_my_ = IF(PCOUNT()=0,.T.,.F.)
*
IF LEN(ALIAS()) <> 0
* A file is open
FOR _ma_ = 1 TO FCOUNT()
_mb_ = FIELDNAME(_ma_)
_mc_ = "M" + _mb_
*
&_mc_. = c_BLANK(&_mb_.)
NEXT
ELSE
* No file is open or selected
BREAK
ENDIF
RETURN(.T.)
*
*
*
FUNCTION c_MTC_MENU
************************************************************************
* PASS: Row, Column *
* *
* RETURNS: MENU TO amount 1-9 *
* *
* PURPOSE: Displays lightbar menu for use with file maintenance *
* programs. *
* *
* EXAMPLE: DO WHILE .T. *
* c_MTC_MENU(row, column) *
* DO CASE *
* CASE menu_opt=0 *
* EXIT *
* * *
* CASE menu_opt=1 *
* DO ADD_PRG *
* ... *
* ... *
* ... *
* ENDCASE *
* ENDDO *
* *
* NOTE: Remember to initialize the memory variable "menu_opt" with- *
* in the maintenance program. *
************************************************************************
*
PARAMETERS _ma_,_mb_
*
SET CURSOR OFF
@ _ma_,_mb_ PROMPT "Add" MESSAGE "Add a record"
@ _ma_,COL()+2 PROMPT "Delete" MESSAGE "Delete displayed record"
@ _ma_,COL()+2 PROMPT "Edit" MESSAGE "Edit displayed record"
@ _ma_,COL()+2 PROMPT "First" MESSAGE "Go to first record and display"
@ _ma_,COL()+2 PROMPT "Goto" MESSAGE "Locate and display a specified record"
@ _ma_,COL()+2 PROMPT "Hardcopy" MESSAGE "Print displayed record"
@ _ma_,COL()+2 PROMPT "Last" MESSAGE "Go to last record and display"
@ _ma_,COL()+2 PROMPT "Next" MESSAGE "Go to next record and display"
@ _ma_,COL()+2 PROMPT "Prev" MESSAGE "Go to previous record and display"
MENU TO menu_opt
*
RETURN(menu_opt)
*
*
*
FUNCTION c_OCCUR
************************************************************************
* PASS: <expC1>, <expC2> *
* *
* RETURNS: Numeric string *
* *
* PURPOSE: Returns the number of occurences the first character *
* string appears in the second character string. *
************************************************************************
PARAMETERS _ma_,_mb_
*
_mc_ = 0
DO WHILE .NOT. EMPTY(AT(_ma_,_mb_))
_mc_ = _mc_ + 1
_mb_ = SUBSTR(_mb_, AT(_ma_,_mb_)+1)
ENDDO
RETURN(_mc_)
*
*
*
FUNCTION c_PASSWORD
************************************************************************
* PASS: <expC1>, <expC2> (optional) *
* *
* RETURNS: Numeric string *
* *
* PURPOSE: Generates a numeric value for any string based on the *
* ASCII value of each character multiplied by its relative *
* position in the character string. *
* *
* EXAMPLE: In the following code, a second parameter has been *
* (mpw_key). *
* *
* mpw_key = "@!$xYz&*+" *
* USE PASSWORD.DBF *
* mpassword= SPACE(10) *
* @ 1,5 SAY "ENTER PASSWORD " GET mpassword *
* READ *
* IF mpassword=SPACE(10) *
* QUIT *
* ELSE *
* LOCATE FOR c_PASSWORD(mpassword,mpw_key)=PW *
* IF EOF() *
* ?? CHR(7) *
* @ 5,5 SAY "INVALID PASSWORD" *
* ELSE *
* ..... *
* other commands *
* ..... *
* ENDIF *
* ENDIF *
* *
* ------------------------------------------------------------------ *
* NOTE: As a added precaution, if the second parameter has been *
* passed it is added into the overall value that is returned. *
* This "key" value can be hardcoded in the main module or *
* placed in a type of data (.MEM, .DBF) file prior to branch- *
* ing to the password verification routine. *
* *
************************************************************************
PARAMETERS _in_string, _in_key
*
_ma_ = LEN(TRIM(_in_string))
_mb_ = 0
*
**************************
* Compute password value *
**************************
FOR _mc_ = 1 TO (_ma_ + 1)
_mb_ = _mb_ + ASC(SUBSTR(_in_string,_mc_,1)) * _mc_
NEXT
*
****************************************
* If second parameter has been passed, *
* add key value to password value *
****************************************
IF PCOUNT()=2
_ma_ = LEN(TRIM(_in_key))
FOR _mc_ = 1 TO (_ma_ + 1)
_mb_ = _mb_ + ASC(SUBSTR(_in_string,_mc_,1)) * _mc_
NEXT
ENDIF
*
RETURN(_mb_)
*
*
*
FUNCTION c_PERCENT
************************************************************************
* PASS: <expN1>, <expN2> *
* *
* RETURNS: Character string *
* *
* PURPOSE: Returns a Character string in the format of a percentage. *
* The calculation is based on the first expression divided *
* by the second expression. *
* *
* EXAMPLE: *
* *
************************************************************************
PARAMETERS _ma_,_mb_
*
IF PCOUNT()=0 .OR. _mb_=0
RETURN("")
ENDIF
*
RETURN(TRANSFORM(_ma_ / _mb_ , "###.##%"))
*
*
*
FUNCTION c_RANDOM
************************************************************************
* PASS: <expN1> *
* *
* RETURNS: Numeric string *
* *
* PURPOSE: Returns a random number based on the number passed to it. *
* *
* EXAMPLE: *
* *
************************************************************************
PARAMETERS _ma_
*
_mb_ = (_ma_ < 0)
*
IF _ma_ = 0
RETURN(0)
ENDIF
*
_ma_ = ABS(_ma_)
_mc_ = SECONDS()/100
_md_ = (_mc_ - INT(_mc_)) * 100
_me_ = LOG(SQRT(SECONDS()/100))
_mf_ = (_me_ - INT(_me_)) * 100
_mg_ = (_md_ * _mf_)
_mh_ = _mg_ - INT(_mg_)
_mi_ = _ma_ * _mh_
_mj_ = ROUND(_mi_,2)
_mk_ = INT(_mj_)+IF(INT(_mj_)+1 < _ma_ + 1,1,0)
*
RETURN(_mk_ * IF(_mb_, -1, 1))
*
*
*
FUNCTION c_RJUST
************************************************************************
* PASS: <expC1>, <expN1> *
* *
* RETURNS: Numeric string *
* *
* PURPOSE: Modifies the Character string and returns a column pos- *
* ition that, if used, would right-justify the string to *
* the numeric expressions of the Nth column position. If *
* not used, the default value for the numeric expression *
* will be 79. *
* *
* EXAMPLE: @ 01,00 CLEAR *
* @ 01,c_RJUST("Customer") SAY "Customer" *
*************************************************************************
PARAMETERS _in_string,_in_number
*
IF PCOUNT()=1
_in_number=79
ENDIF
*
RETURN(IF(LEN(_in_string) > _in_number, _in_string, _in_number - LEN(_in_string)))
*
*
*
FUNCTION c_RJUSTSTR
************************************************************************
* PASS: <expC1> *
* *
* RETURNS: Right Justified Character string *
* *
* PURPOSE: Modifies the character string and returns the character *
* string in a right justified state. Note this differs *
* from the c_RJUST() function in that the character string *
* is permanently altered. *
* *
* EXAMPLE: mcustno=SPACE(6) *
* @ 12,10 SAY "Enter Customer Number " *
* @ 12,COL()+1 GET mcustno PICTURE "999999" *
* READ *
* *
* && if "12" was entered, mcustno would appear as *
* && 12---- *
* && where "-" indicates trailing spaces *
* *
* mcustno = c_RJUSTSTR(mcustno) *
* *
* && mcustno now contains *
* && ----12 *
* && where "-" indicates leading spaces *
************************************************************************
*
PARAMETERS _ma_
*
IF TYPE("_ma_")="C"
_mb_ = LEN(_ma_)
_ma_ = LTRIM(TRIM(_ma_))
*
IF LEN(_ma_) < _mb_
FOR _mx_ = LEN(_ma_) TO (_mb_ -1)
_ma_ = " "+_ma_
NEXT
ENDIF
ENDIF
RETURN(_ma_)
*
*
*
FUNCTION c_ROUND
************************************************************************
* PASS: <expN1> *
* *
* RETURNS: Numeric string *
* *
* PURPOSE: Rounds 2 Numeric string to 2 decimal positions. Its *
* reliable than the CLIPPER counterpart. *
* *
* EXAMPLE: x = 456.78 / 789.01 *
* ? c_ROUND(x) *
************************************************************************
PARAMETERS _in_number
*
_in_number = INT(_in_number * 100 + .5) / 100.00
*
RETURN(_in_number)
*
*
*
FUNCTION c_SAYIT
************************************************************************
* PASS: <expN1>, <expN2>, <expC1>, <expC2> (optional) *
* *
* where: <expN1> = row *
* <expN2> = column *
* <expC1> = message, heading, etc. *
* <expC2> = optional message color parameter *
* *
* RETURNS: Nothing *
* *
* PURPOSE: Displays screen message in specified color. *
* *
* EXAMPLE: mmsg = "Enter Name " && message *
* msaycolor = "+BG/N" && color variable *
* * *
* c_SAYIT(05,10,mmsg,msaycolor) *
* *
************************************************************************
PARAMETERS _ma_, _mb_, _mc_, _md_
*
_mx_ = SETCOLOR()
IF PCOUNT()=4
* color parameter
SETCOLOR(_md_)
ENDIF
*
@ _ma_,_mb_ SAY _mc_
*
SETCOLOR(_mx_)
RETURN(.F.)
*
*
*
FUNCTION c_SCATTER
************************************************************************
* PASS: <expC1> (optional) *
* *
* RETURNS: Null *
* *
* PURPOSE: Initializes memory variables from record's field values. *
* *
* NOTES: Memory variable names are prefixed with an uppercase "M" *
* due to CLIPPER requirements of input_var names in system *
* HELP programs. *
* *
* Memory variable names can be a maximum of 10 characters *
* in length. This function ASSUMES DATABASE FILE (.DBF) *
* FIELD NAMES TO BE 9 CHARACTERS OR LESS IN LENGTH. *
* *
* If a parameter is passed, logical field types will be *
* converted to logical memory variables. The default *
* assumes no parameter; logical fields are converted to *
* character YES/NO memory variables. This is done because *
* most user-interface entry screens prompt for Y/N input *
* rather than a .T. / .F.. *
* *
* EXAMPLE: c_SCATTER() && Convert logic field to character *
* && memory variable *
* or *
* *
* c_SCATTER(x) && Logic field to logic memory variable *
************************************************************************
*
PARAMETER _mx_
*
PRIVATE _ma_, _mb_, _mc_, _my_ && Counter, field, variable name, logic flag
*
_my_ = IF(PCOUNT()=0,.T.,.F.)
*
IF LEN(ALIAS()) <> 0
* A file is open
FOR _ma_ = 1 TO FCOUNT()
_mb_ = FIELDNAME(_ma_)
_mc_ = "M" + _mb_
*
IF TYPE("&_mb_.") = "L" .AND. _my_
****************************************************
* Convert logic field to character memory variable *
****************************************************
&_mc_. = IF(&_mb_.,"Y","N")
ELSE
&_mc_. = &_mb_.
ENDIF
NEXT
ELSE
* No file is open or selected
BREAK
ENDIF
RETURN(.T.)
*
*
*
FUNCTION c_SHADOW
************************************************************************
* PASS: <expN1>, <expN2>, <expN3>, <expN4> *
* *
* where: <expN1> = top row *
* <expN2> = top column *
* <expN3> = bottom row *
* <expN4> = bottom column *
* *
* RETURNS: Nothing *
* *
* PURPOSE: Used to display a shadow around a box or menu area drawn *
* by either the BOX command or the @... SAY... DOUBLE *
* command. *
* *
* EXAMPLE: @ 15,15 CLEAR TO 20,45 *
* @ 15,15 TO 20,45 DOUBLE *
* c_SHADOW(15,15,20,45) *
************************************************************************
PARAMETERS _mtr_, _mtc_, _mbr_, _mbc_
*
_in_color = SETCOLOR()
SETCOLOR(STRTRAN(_in_color, "+", "" ))
*
FOR _mx_ = _mtr_ + 1 TO _mbr_ + 1
@ _mx_, _mbc_ + 1 SAY CHR(177)
NEXT
*
@ _mx_ -1, _mtc_ + 1 SAY REPLICATE(CHR(177), _mbc_ - _mtc_ )
*
SETCOLOR(_in_color)
RETURN(.F.)
*
*
*
