home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 6.ddi / SAMPLE.LIF / EXAMPLEP.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  7.5 KB  |  274 lines
  1. /***
  2. *   examplep.prg
  3. *
  4. *   Sample Clipper User Defined Functions
  5. */
  6.  
  7.  
  8. /***
  9. *  AMPM( <cTime> ) --> cTime
  10. *
  11. *  Convert a time string to 12-hour format
  12. */
  13.  
  14. FUNCTION AMPM( cTime )
  15.  
  16.    IF VAL(cTime) = 0
  17.       cTime := "12" + SUBSTR(cTime, 3) + " am"
  18.  
  19.    ELSEIF VAL(cTime) < 12
  20.       cTime += " am"
  21.  
  22.    ELSEIF VAL(cTime) = 12
  23.       cTime += " pm"
  24.  
  25.    ELSE
  26.       cTime := STR(VAL(cTime) - 12, 2) + SUBSTR(cTime, 3) + " pm"
  27.  
  28.    ENDIF
  29.  
  30.    RETURN cTime
  31.  
  32.  
  33. /***
  34. *   StrZero( <nNumber>, <nLength>, <nDecimals> ) --> cNumber
  35. *
  36. *   Convert a numeric to a string padded with leading zeros
  37. */
  38.  
  39. FUNCTION StrZero( n, nLength, nDecimals )
  40.  
  41.    LOCAL cNumber
  42.  
  43.    IF PCOUNT() = 3
  44.       cNumber = STR(n, nLength, nDecimals)
  45.    ELSEIF PCOUNT() = 2
  46.       cNumber = STR(n, nLength)
  47.    ELSE
  48.       cNumber = STR(n)
  49.    ENDIF
  50.  
  51.    IF "-" $ cNumber
  52.       // Negative number, move the minus sign in front of zeros
  53.       RETURN "-" + REPLICATE("0", LEN(cNumber) - LEN(LTRIM(cNumber))) +;
  54.             SUBSTR(cNumber, AT("-", cNumber) + 1)
  55.    ENDIF
  56.  
  57.    // Positive number
  58.    RETURN REPLICATE("0", LEN(cNumber) - LEN(LTRIM(cNumber))) + LTRIM(cNumber)
  59.  
  60.  
  61. /***
  62. *    DAYS( <nSeconds> )
  63. *
  64. *    Return integer number of days from numeric seconds
  65. *
  66. *    Note: The remainder under 24 hours is returned by the TSTRING() function.
  67. */
  68.  
  69. FUNCTION DAYS(cl_secs)
  70.     RETURN INT( cl_secs / 86400 )
  71.  
  72.  
  73. /***
  74. *    DBF()
  75. *
  76. *    Return the alias of the currently selected database.
  77. *
  78. *    Note: Supposed to return the name of the currently selected database file.
  79. */
  80.  
  81. FUNCTION DBF
  82.     RETURN ALIAS()
  83.  
  84.  
  85. /***
  86. *    ELAPTIME( <nStartTime>, <nEndTime> )
  87. *
  88. *    Return a time string showing the difference between start and end times
  89. *
  90. *    Note: If start time is greater than end time, this algorithm assumes
  91. *         that the day changed at midnight.  Only for timings under 24 hours.
  92. *         86400 is the number of seconds in 24 hours.
  93. */
  94.  
  95. FUNCTION ELAPTIME(cl_start, cl_end)
  96.  
  97.     RETURN TSTRING( IF( cl_end < cl_start, 86400, 0) + ;
  98.                     SECS(cl_end) - SECS(cl_start) )
  99.  
  100.  
  101. /***
  102. *    FKLABEL( <nFunKey> )
  103. *
  104. *    Return the name of the <expN>th programmable function key
  105. */
  106.  
  107. FUNCTION FKLABEL(cl_1)
  108.  
  109.     RETURN IF( cl_1 <= 40 .AND. cl_1 > 0, "F"+LTRIM(STR(cl_1)), "")
  110.  
  111.  
  112. /***
  113. *    FKMAX()
  114. *    Return the maximum number of programmable function keys on the computer
  115. *
  116. *    Note: specific to IBM PC/XT/AT and clones.
  117. */
  118.  
  119. FUNCTION FKMAX()
  120.     RETURN (40)     // IBM specific
  121.  
  122.  
  123. /***
  124. *    LENNUM( <nNum> )
  125. *    Return the string length of <nNum>
  126. */
  127.  
  128. FUNCTION LENNUM(cl_number)
  129.     RETURN LEN(LTRIM(STR(cl_number)))
  130.  
  131.  
  132. /***
  133. *    MOD( <expN1>, <expN2> )
  134. *
  135. *    Return remainder of <expN1> divided by <expN2>
  136. *
  137. *    Note: Difference between the dBASE modulus function and the Clipper
  138. *         modulus operator is indicated by an arrow <-->:
  139. *
  140. *         Clipper operator:        dBASE function:
  141. *         -----------------        -----------------
  142. *          3 %  3 ::=  0.00        MOD( 3, 3) ::=  0      
  143. *          3 %  2 ::=  1.00        MOD( 3, 2) ::=  1      
  144. *          3 %  1 ::=  0.00        MOD( 3, 1) ::=  0      
  145. *          3 %  0 ::=  0.00  <-->  MOD( 3, 0) ::=  3      
  146. *          3 % -1 ::=  0.00        MOD( 3,-1) ::=  0      
  147. *          3 % -2 ::=  1.00  <-->  MOD( 3,-2) ::= -1      
  148. *          3 % -3 ::=  0.00        MOD( 3,-3) ::=  0      
  149. *                                                            
  150. *         -3 %  3 ::=  0.00        MOD(-3, 3) ::=  0      
  151. *         -3 %  2 ::= -1.00  <-->  MOD(-3, 2) ::=  1      
  152. *         -3 %  1 ::=  0.00        MOD(-3, 1) ::=  0      
  153. *         -3 %  0 ::=  0.00  <-->  MOD(-3, 0) ::= -3      
  154. *         -3 % -1 ::=  0.00        MOD(-3,-1) ::=  0      
  155. *         -3 % -2 ::= -1.00        MOD(-3,-2) ::= -1      
  156. *         -3 % -3 ::=  0.00        MOD(-3,-3) ::=  0      
  157. *                                                            
  158. *          3 %  3 ::=  0.00        MOD( 3, 3) ::=  0      
  159. *          2 %  3 ::=  2.00        MOD( 2, 3) ::=  2      
  160. *          1 %  3 ::=  1.00        MOD( 1, 3) ::=  1      
  161. *          0 %  3 ::=  0.00        MOD( 0, 3) ::=  0      
  162. *         -1 %  3 ::= -1.00  <-->  MOD(-1, 3) ::=  2      
  163. *         -2 %  3 ::= -2.00  <-->  MOD(-2, 3) ::=  1      
  164. *         -3 %  3 ::=  0.00        MOD(-3, 3) ::=  0      
  165. *                                                            
  166. *          3 % -3 ::=  0.00        MOD( 3,-3) ::=  0      
  167. *          2 % -3 ::=  2.00  <-->  MOD( 2,-3) ::= -1      
  168. *          1 % -3 ::=  1.00  <-->  MOD( 1,-3) ::= -2      
  169. *          0 % -3 ::=  0.00        MOD( 0,-3) ::=  0      
  170. *         -1 % -3 ::= -1.00        MOD(-1,-3) ::= -1      
  171. *         -2 % -3 ::= -2.00        MOD(-2,-3) ::= -2      
  172. *         -3 % -3 ::=  0.00        MOD(-3,-3) ::=  0      
  173. */
  174.  
  175. FUNCTION MOD(cl_num, cl_base)
  176. LOCAL cl_result
  177.  
  178.     cl_result = cl_num % cl_base
  179.  
  180.     RETURN IF( cl_base = 0, ;
  181.                cl_num,;
  182.                IF(cl_result * cl_base < 0, cl_result + cl_base, cl_result) )
  183.  
  184.  
  185. /***
  186. *    READKEY()
  187. *
  188. *    Return a number representing the key pressed to exit from full-screen mode
  189. *
  190. *    Note: Differences between dBASE's READKEY() and Clipper's LASTKEY():
  191. *
  192. *         Exit Key:      dBASE:      Clipper:
  193. *         ---------      ------      --------
  194. *         Backspace         0        no exit
  195. *         ^D, ^L            1        no exit
  196. *         Lt arrow          2        no exit
  197. *         Rt arrow          3        no exit
  198. *         Up arrow          4        no exit
  199. *         Dn arrow          5        no exit
  200. *         PgUp              6          18
  201. *         PgDn              7           3
  202. *         Esc, ^Q          12          27 (Esc only)
  203. *         ^End, ^W         14          23 (^W only)
  204. *         type past end    15        ascii of last char typed
  205. *         Enter            15          13
  206. *         ^Home            33        no exit
  207. *         ^PgUp            34        no exit
  208. *         ^PgDn            35        no exit
  209. *         F1               36        no exit
  210. *
  211. *         dBASE III adds 256 to the exit code if the user changed anything.
  212. *         Clipper uses its UPDATED() function to determine if anything changed.
  213. */
  214.  
  215. FUNCTION READKEY()
  216.  
  217.     DO CASE
  218.         CASE LASTKEY() = 18                           // PgUp
  219.            RETURN  6 + IF(UPDATED(), 256, 0)
  220.         CASE LASTKEY() =  3                           // PgDn
  221.            RETURN  7 + IF(UPDATED(), 256, 0)
  222.         CASE LASTKEY() = 27                           // Esc
  223.            RETURN 12 + IF(UPDATED(), 256, 0)
  224.         CASE LASTKEY() = 23                           // ^W
  225.            RETURN 14 + IF(UPDATED(), 256, 0)
  226.         CASE LASTKEY() = 13                           // Enter
  227.            RETURN 15 + IF(UPDATED(), 256, 0)
  228.         CASE LASTKEY() = 31                           // ^PgUp
  229.            RETURN 34 + IF(UPDATED(), 256, 0)
  230.         CASE LASTKEY() = 30                           // ^PgDn
  231.            RETURN 35 + IF(UPDATED(), 256, 0)
  232.         CASE LASTKEY() >= 32                          // type past end
  233.            RETURN 15 + IF(UPDATED(), 256, 0)
  234.         OTHERWISE
  235.            RETURN 0
  236.     ENDCASE
  237.  
  238.     RETURN (0)    // never gets here
  239.  
  240.  
  241. /***
  242. *    SECS( <time string> )
  243. *
  244. *    Return numeric seconds as a quantity of the time string
  245. *
  246. *    Note: Seconds in time period
  247. *         -------    -----------
  248. *              60    1 minute
  249. *            3600    1 hour
  250. *           86400    1 day
  251. */
  252.  
  253. FUNCTION SECS(cl_time)
  254.  
  255.     RETURN VAL(       cl_time    ) * 3600 +;
  256.            VAL(SUBSTR(cl_time,4)) *   60 +;
  257.            VAL(SUBSTR(cl_time,7))
  258.  
  259.  
  260. /***
  261. *    TSTRING( <seconds> )
  262. *
  263. *    Return a 24-hour time string from numeric seconds
  264. *
  265. *    Note: Time quantities over 24 hours are returned by the DAYS() function.
  266. */
  267.  
  268. FUNCTION TSTRING(cl_secs)
  269.  
  270.     RETURN STRZERO( INT(MOD(cl_secs/3600, 24)), 2, 0 ) +':'+;
  271.            STRZERO( INT(MOD(cl_secs/  60, 60)), 2, 0 ) +':'+;
  272.            STRZERO( INT(MOD(cl_secs     , 60)), 2, 0 )
  273.  
  274.