Programmer 7500

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

/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / CLIPPER / CODE_1.ARC / TEM_UDFS.PRG < prev

Wrap

Text File | 1989-01-02 | 49.5 KB | 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.) * * *