home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / data / dbas / 004 / obsolete.prg < prev    next >
Text File  |  1992-07-24  |  16KB  |  381 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: OBSOLETE.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 04/30/1992
  5. *-- Notes.....: The following functions are not necessary using dBASE IV, 1.5,
  6. *--             but have been retained in the current version of the library
  7. *--             system in order to have some compatibility with 1.1.
  8. *-------------------------------------------------------------------------------
  9.  
  10. FUNCTION Empty
  11. *-------------------------------------------------------------------------------
  12. *-- Programmer..: Jerry Wightman (WIGHTMAN)
  13. *-- Date........: ?
  14. *-- Notes.......: Used to check whether a memory variable in dBASE contains
  15. *--               anything, based on type of field. (Pulled from BORBBS)
  16. *--               NOTE: In release 1.5, replace all calls to EMPTY() with
  17. *--               the new:  ISBLANK() function. This will be faster.
  18. *-- Written for.: dBASE IV, 1.1
  19. *-- Rev. History: None
  20. *-- Calls.......: None
  21. *-- Called by...: Any
  22. *-- Usage.......: Empty(<cFld>)
  23. *-- Example.....: @5,10 say "Enter date: " get bDate;
  24. *--                         valid required .not. empty(bDate);
  25. *--                         error chr(7)+"** Date cannot be Empty! **"
  26. *-- Returns.....: Logical (.t./.f.)
  27. *-- Parameters..: cFld  =  Field/Memvar/Expression to check for "Emptiness"
  28. *-------------------------------------------------------------------------------
  29.  
  30.     PARAMETERS cFld       && may be memory variable or database field name
  31.     private cTalk, lReturn
  32.  
  33.     cTalk = SET("TALK")
  34.  
  35.     lReturn = .F.      &&  FALSE means:  variable is NOT empty
  36.  
  37.     do case
  38.        case type( "cFld" ) = "C"
  39.           if len( ltrim(rtrim( cFld )) ) = 0
  40.              lReturn = .T.
  41.             endif
  42.  
  43.         case type( "cFld" ) = "N" .or. type( "cFld" ) = "F"
  44.             if cFld = 0
  45.                 lReturn = .T.
  46.             endif
  47.  
  48.         case type( "cFld" ) = "L"
  49.             lReturn = .F.  && Can't check logical fields
  50.  
  51.         case type( "cFld" ) = "D"
  52.             if cFld = {}
  53.                 lReturn = .T.
  54.             endif
  55.  
  56.         case type( "cFld" ) = "M"
  57.             if len( cFld ) = 0
  58.                                 lReturn = .T.
  59.             endif
  60.  
  61.         otherwise   && TYPE = "U"
  62.             lReturn = .T.
  63.  
  64.     endcase
  65.  
  66.     set talk &cTalk
  67.     
  68. RETURN lReturn
  69. *-- EoF: Empty()
  70.  
  71. FUNCTION NumFlds
  72. *-------------------------------------------------------------------------------
  73. *-- Programmer..: Bowen Moursund (BOWEN)
  74. *-- Date........: 07/12/1991
  75. *-- Notes.......: Returns the number of fields in a database structure --
  76. *--               only in the currently selected DBF
  77. *--               NOTE: In release 1.5, replace function NUMFLDS() with
  78. *--               FLDCOUNT() -- built in to 1.5, faster ...
  79. *-- Written for.: dBASE IV, 1.1
  80. *-- Rev. History: None
  81. *-- Calls.......: None
  82. *-- Called by...: Any
  83. *-- Usage.......: NumFlds()
  84. *-- Example.....: ? NumFlds()
  85. *-- Returns.....: Number of fields
  86. *-- Parameters..: None
  87. *-------------------------------------------------------------------------------
  88.  
  89.     private nFlds,cFldName
  90.     
  91.     *-- If currently selected database is empty (no dbf file)
  92.     if len(trim(dbf())) = 0
  93.         nFlds = 0                     && set to 0
  94.     *-- we have something ...
  95.     else
  96.         nFlds = 0                     && initialize
  97.         do while .t.                  && loop through the record structure
  98.             nFlds= nFlds + 1           && increment counter
  99.             cFldName = field(nFlds)    && get fieldname
  100.             if len(trim(cFldName)) = 0 && if length = 0,
  101.                 nFlds = nFlds - 1       &&   decrement counter
  102.                 exit                    &&   get out of loop, we're done
  103.             endif                      && endif(length...)
  104.         enddo                         && end of loop
  105.     endif
  106.  
  107. RETURN nFlds
  108. *-- EoF: NumFlds()
  109.  
  110. FUNCTION DateSet
  111. *-------------------------------------------------------------------------------
  112. *-- Programmer..: Jay Parsons (JPARSONS)
  113. *-- Date........: 03/01/1992
  114. *-- Notes.......: Returns string giving name of current DATE format
  115. *--               This is not needed in Version 1.5, in which set("DATE")
  116. *--               returns the format.  Unlike that function in 1.5, this
  117. *--               one cannot distinguish between date formats set with
  118. *--               different terms that amount to the same thing:
  119. *--                     DMY = BRITISH = FRENCH
  120. *--                     MDY = AMERICAN
  121. *--                     YMD = JAPAN
  122. *--               If your users will be using one of these formats and
  123. *--               are sensitive about the name, substitute the one they
  124. *--               want for the equivalent in this function.
  125. *-- Rev. History: None
  126. *-- Written for.: dBASE IV, versions below 1.5
  127. *-- Rev. History: None
  128. *-- Calls.......: None
  129. *-- Called by...: Any
  130. *-- Usage.......: DateSet()
  131. *-- Example.....: ?DateSet()
  132. *-- Returns.....: Character
  133. *-- Parameters..: None
  134. *-------------------------------------------------------------------------------
  135.  
  136.     private cCent, cTestdate, cDelimiter
  137.     cCent = set( "CENTURY" )
  138.     set century off
  139.     cTestdate = ctod( "01/02/03" )
  140.     cDelimiter = substr( dtoc( cTestdate ), 3, 1 )
  141.     set century &cCent
  142.     do case
  143.       case month( cTestdate ) = 1
  144.         RETURN iif( cDelimiter = "-", "USA", "MDY" )
  145.       case day( cTestdate ) = 1
  146.         RETURN iif( cDelimiter = "/", "DMY", ;
  147.           iif( cDelimiter = ".", "GERMAN", "ITALIAN" ) )
  148.       otherwise
  149.         RETURN iif( cDelimiter = ".", "ANSI", "YMD" )
  150.     endcase
  151.     
  152. *-- EoF: DateSet()
  153.  
  154. FUNCTION Stampval
  155. *-------------------------------------------------------------------------------
  156. *-- Programmer..: Jay Parsons (Jparsons)
  157. *-- Date........: 04/07/1992
  158. *-- Notes.......: Passed a 16-character string in the form of the rightmost
  159. *--             : 16 characters returned by the DOS DIR command for a file,
  160. *--             : returns a number that will compare properly in date/time
  161. *--             : order with the numbers returned by this function for other
  162. *--             : files.
  163. *-- Written for.: dBASE IV Versions below 1.5
  164. *-- Rev. History: None
  165. *-- Calls       : None
  166. *-- Called by...: Any
  167. *-- Usage.......: Stampval(<cTimestamp>)
  168. *-- Example.....: IF Stampval("02-22-92  10:54a") > Stampval("04-05-92   5:54p")
  169. *-- Returns.....: Numeric corresponding to time stamp of file
  170. *-- Parameters..: cStamp, a DIR timestamp
  171. *-------------------------------------------------------------------------------
  172.    parameters cStamp
  173.    RETURN 1440 * ( 12 * val( left(cStamp,2)) + val(substr(cStamp,4,2)) ;
  174.        + 372*val(substr(cStamp,7,2)) ) + 60 * val(substr(cStamp,11,2)) ;
  175.        + val(substr(Cstamp,14,2)) + iif(right(cStamp,1)="p",720,0)
  176. *--Eof() Stampval
  177.  
  178. PROCEDURE FullWin
  179. *-------------------------------------------------------------------------------
  180. *-- Programmer..: Ken Mayer (KENMAYER)
  181. *-- Date........: 05/23/91
  182. *-- Notes.......: Overlays menus or another screen with a full window,
  183. *--               so that processing is done in the window, and one can return
  184. *--               directly to the menus, without redrawing screen and such.
  185. *--               This routine may be a problem in dBASE IV, 1.5 ... use
  186. *--               with caution ...
  187. *-- Written for.: dBASE IV, 1.1
  188. *-- Rev. History: None
  189. *-- Calls.......: None
  190. *-- Called by...: Any
  191. *-- Usage.......: do fullwin with <cColor>,<cWinName>,<cScreen>
  192. *-- Example.....: do fullwin with "w+/b","w_Edit","sc_Main"
  193. *--                * perform whatever actions are needed in the window
  194. *--               deactivate window wEdit
  195. *--               release window wEdit
  196. *--               restore screen from sMain
  197. *--               release screen sMain
  198. *-- Returns.....: None
  199. *-- Parameters..: cColor   = Colors for window
  200. *--               cWinName = Name of window
  201. *--               cScreen  = Name of screen
  202. *-------------------------------------------------------------------------------
  203.     
  204.     parameters cColor,cWinName,sScreen
  205.     
  206.     define window &cWinName from 0,0 to 23,79 none color &cColor.
  207.     save screen to &sScreen.
  208.     activate window &cWinName.
  209.     
  210. RETURN  
  211. *-- EoP: FullWin
  212.     
  213. PROCEDURE SetColor
  214. *-------------------------------------------------------------------------------
  215. *-- Programmer..: Phil Steele
  216. *