home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / progmisc / dblib201.zip / FIELDS.PRG < prev    next >
Text File  |  1993-03-24  |  24KB  |  623 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: FIELDS.PRG
  3. *-- Programmer: Ken Mayer (CIS: 71333,1030)
  4. *-- Date......: 03/24/1993
  5. *-- Notes.....: These field processing routines were deemed as not as commonly
  6. *--             used (at least in my own Applications), and relegated to a 
  7. *--             library file. See: README.TXT about how to use this library
  8. *--             file.
  9. *-------------------------------------------------------------------------------
  10.  
  11. FUNCTION MemoPagr
  12. *-------------------------------------------------------------------------------
  13. *-- Programmer..: Martin Leon (HMAN - ATBBS/Borland BBS)
  14. *-- Date........: 10/28/1991
  15. *-- Notes.......: Used to display a memo on screen, allowing user to scroll
  16. *--               memo at will.
  17. *-- Written for.: dBASE IV, 1.1
  18. *-- Rev. History: 10/28/1991 -- Original
  19. *-- Calls.......: None
  20. *-- Called by...: Any
  21. *-- Usage.......: ?MemoPagr(<cMemo>,<ULRow>,<ULCol>,<BRRow>,<BRCol>)
  22. *-- Example.....: ?MemoPagr(MoreData,10,20,20,65)
  23. *-- Returns.....: .F.
  24. *-- Parameters..: cMemo   = name of memo field
  25. *--               nULRow  = upper left row position
  26. *--               nULCol  = upper left column position
  27. *--               nBRRow  = bottom right row position
  28. *--               nBRCol  = bottom right column position
  29. *-------------------------------------------------------------------------------
  30.     
  31.     PARAMETER cMemo, nULRow, nULCol, nBRRow, nBRCol
  32.     private cCursor, nEsc, nPgDn, nPgUp, nUp, nDn, nNumLines,nLines,nKey
  33.     private nAtLine,nAtRow
  34.     
  35.     *-- set environment
  36.     set memowidth to nBRCol - nULCol - 1
  37.     cCursor = set( "CURSOR" )
  38.     set cursor off
  39.     
  40.     *-- define a few keys
  41.     nEsc  = 27
  42.     nPgDn = 3
  43.     nPgUp = 18
  44.     nUp   = 5
  45.     nDn   = 24
  46.     
  47.     *-- determine size of window
  48.     nNumLines = memlines(&cMemo)
  49.     nLines = nBRRow - nULRow - 1
  50.     *-- save the screen, so we can restore it
  51.     save screen to sTmp
  52.     @ nULRow+1, nULCol+1 clear to nBRRow+1, nBRCol+1
  53.     @ nULRow+1, nULCol+1 fill to nBRRow+1, nBRCol+1 color B/N
  54.     @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 color RG+/B
  55.     @ nULRow, nULCol to nBRRow, nBRCol double color RG+/B
  56.     
  57.     *-- deal with a blank memo ...
  58.     if nNumLines = 0
  59.        @ nULRow + 1, nULCol + 1 SAY ;
  60.           "Blank Memo.  Press any key to continue..." color RG+/B
  61.        nKey = inkey(0)
  62.         *-- reset the whole thing
  63.        restore screen from sTmp
  64.        release screen sTmp
  65.        set cursor &cCursor
  66.        RETURN .F.
  67.     endif
  68.     
  69.     nAtLine = 1
  70.     nAtRow = 1
  71.     do while nAtLine <= nNumLines
  72.        *-- Show one window full
  73.        do while nAtRow <= nLines .and. nAtLine <= nNumLines
  74.           @ nULRow+nAtRow, nULCol + 1 say ;
  75.              mline( &cMemo, nAtLine ) color RG+/B
  76.           nAtLine = nAtLine + 1
  77.           nAtRow = nAtRow + 1
  78.        enddo
  79.    
  80.        *-- If at last line of memo...
  81.        if nAtLine > nNumLines
  82.           *-- If memo is shorter than one page, put box character in
  83.           *-- bottom left corner of box, otherwise, put an up arrow
  84.           *-- symbol there.
  85.           @ nBRRow - 1, nBRCol SAY ;
  86.          iif( nNumLines <= nLines, chr(186), chr(24)) color W+/B
  87.           do while .T.
  88.              nKey = inkey(0)
  89.              *-- If memo is shorter than one page, only allow Esc key
  90.              if nNumLines <= nLines
  91.                 if nKey = nEsc
  92.                    exit
  93.                 endif
  94.              *-- Otherwise, allow Esc or PgUp keys
  95.              else
  96.                 if nKey = nEsc .or. nKey = nPgUp .or. nKey = nUp
  97.                    exit
  98.                 endif
  99.              endif
  100.              ?? chr(7)
  101.           enddo
  102.           if nKey = nEsc
  103.              restore screen from sTmp
  104.              release screen sTmp
  105.              set cursor &cCursor
  106.              RETURN .F.
  107.           endif
  108.           @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  109.           @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  110.              color RG+/B
  111.           nAtLine = nAtLine -  nAtRow - nLines + 1
  112.           nAtLine = iif( nAtLine < 1, 1, nAtLine )
  113.           nAtRow = 1
  114.           loop
  115.        endif
  116.    
  117.        *-- Not at end of memo yet...
  118.        *-- If on first page, show down arrow only, otherwise show
  119.        *-- up/down arrow on border of box.
  120.        @ nBRRow - 1, nBRCol say ;
  121.            iif( nAtLine - nLines = 1, chr(25), chr(18)) color W+/B
  122.        do while .T.
  123.           nKey = inkey(0)
  124.           *-- If this is the first page of the memo on screen...
  125.           if nAtLine - nLines = 1
  126.               *-- Only honor PgDn, up cursor, and Esc keys
  127.              if nKey = nPgDn .or. nKey = nDn .or. nKey = nEsc
  128.                 exit
  129.              endif
  130.           *-- otherwise honor PgUp and up cursor as well key as well
  131.           else 
  132.              if nKey = nPgUp .or. nKey = nUp .or. nKey = nPgDn .or. ;
  133.                     nKey = nDn .or. nKey = nEsc
  134.                 exit
  135.              endif
  136.           endif
  137.           ?? chr(7)
  138.        enddo
  139.        do case
  140.           case nKey = nEsc
  141.              restore screen from sTmp
  142.              release screen sTmp
  143.              set cursor &cCursor
  144.              RETURN .F.
  145.           case nKey = nPgUp .or. nKey = nUp
  146.              @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  147.              @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  148.                 color RG+/B
  149.              nAtLine = (nAtLine - (2 * nLines))
  150.              nAtLine = IIF( nAtLine < 1, 1, nAtLine )
  151.              nAtRow = 1
  152.              loop
  153.           case nKey = nPgDn .or. nKey = nDn
  154.              @ nULRow+1, nULCol+1 clear to nBRRow-1, nBRCol-1
  155.              @ nULRow+1, nULCol+1 fill to nBRRow-1, nBRCol-1 ;
  156.                 color RG+/B
  157.              nAtRow = 1
  158.              loop
  159.        endcase
  160.     enddo
  161.  
  162. RETURN .F.
  163. *-- EoF: MemoPagr()
  164.  
  165. PROCEDURE ScanMemo
  166. *-------------------------------------------------------------------------------
  167. *-- Programmer..: Martin Leon (HMAN)
  168. *-- Date........: 02/27/1992
  169. *-- Notes.......: This simple procedure is used to strip hard carriage returns
  170. *--               out of all Memos in a database.
  171. *-- Written for.: dBASE IV, 1.1
  172. *-- Rev. History: 04/15/1991 - original procedure.
  173. *--               02/07/1992 -- Douglas P. Saine (XRED) modified to handle
  174. *--                passing of database name as a parameter
  175. *-- Calls.......: None
  176. *-- Called by...: Any
  177. *-- Usage.......: Do ScanMemo with "<cDbf>"
  178. *-- Example.....: Do ScanMemo with "TEST"
  179. *-- Returns.....: None.
  180. *-- Parameters..: cDbf = Name of the database to scan memos ...
  181. *-------------------------------------------------------------------------------
  182.  
  183.     parameter cDbf
  184.     private nFields, cFieldName, nLines, nLineNum
  185.     
  186.     use (cDbf)
  187.     
  188.     scan   && search database 1 record at a time ...
  189.         nFields = 1
  190.         *-- This loop goes through all fields in the database
  191.         do while asc(field(nFields)) # 0
  192.             cFieldName = field(nFields)     && save current field name
  193.             if type(cFieldName) = "M"       && check to see if it's a memo
  194.                 nLines = memlines(&cFieldName)  && number of lines in memo
  195.                 if nLines > 1                   && if there's something there
  196.                     delete file temp.txt         && kill old file if it exists
  197.                     set printer to file temp.txt && copy memo a line at a time to
  198.                     nLineNum = 1                 && temp file, using ??? command.
  199.                     do while nLineNum <= nLines
  200.                         ??? mline(&cFieldName,nLineNum)
  201.                         ??? " "
  202.                         nLineNum = nLineNum + 1
  203.                     enddo
  204.                     close printer
  205.                     set printer to
  206.                     append memo &cFieldName from temp.txt overwrite
  207.                 endif  && nLines > 1
  208.             endif  && type(cFieldName) = "M"
  209.             nFields = nFields + 1  && go to next field ...
  210.         enddo  && asc(field....
  211.     endscan  && scan of database record by record ...
  212.     
  213.     use  && close database
  214.  
  215. RETURN
  216. *-- EoP: ScanMemo
  217.  
  218. PROCEDURE Cut
  219. *-------------------------------------------------------------------------------
  220. *-- Programmer..: Michael B. Carlisle (Borland)
  221. *-- Date........: 01/01/1992 
  222. *-- Notes.......: This retrieves information from the field the user has
  223. *--               currently selected and stores the information into a 
  224. *--               memory variable titled CLIPBOARD. The field itself is
  225. *--               then cleared. CLIPBOARD should be declared public. 
  226. *--               This routine is taken from TECHNOTES.
  227. *-- Written for.: dBASE IV, 1.1
  228. *-- Rev. History: 01/01/1992 -- Original
  229. *-- Calls.......: None
  230. *-- Called by...: Any
  231. *-- Usage.......: do CUT with "<cFld>","<cScrType>"
  232. *-- Example.....: on key label F6 do CUT with varread(),"READ"
  233. *-- Returns.....: None
  234. *-- Parameters..: cFld     = Field to 'CUT' the data from.
  235. *--               cScrType = What screen type? Valid options are BROWSE,
  236. *--                           EDIT and READ.
  237. *-------------------------------------------------------------------------------
  238.  
  239.     parameters cFld,cScrType
  240.     
  241.     *-- test field type, ignore if field is memo
  242.     clipboard = iif(type(cFld) = "D",;
  243.                     right(dtos(&cFld),4)+substr(dtos(&cFld),3,2),;
  244.                  iif(type(cFld) = "L",iif(&cFld,"T","F"),;
  245.                  iif(type(cFld)="M","",&cFld)))
  246.         
  247.     *-- if field type is Numeric or Float, convert to string.
  248.     if type(cFld) $ "NF"
  249.         clipboard = ltrim(str(int(fixed(&cFld)),20)+;
  250.                      right(str(fixed(&cFld) - int(fixed(&cFld)),20,18,19))
  251.         do while val(right(clipboard,1)) = 0 .and. .not. right(clipboard,1)="."
  252.             clipboard = left(clipboard,len(clipboard)-1)
  253.         enddo
  254.     endif
  255.     
  256.     *-- Ring bell if field is MEMO, otherwise, clear the field
  257.     if type(cFld) = "M"
  258.         ?? chr(7)
  259.     else
  260.         *-- do to difference in function of the HOME keys in BROWSE mode,
  261.         *-- Ctrl-Home has to be used in BROWSE
  262.         if upper(cScrType) = "BROWS"
  263.             keyboard chr(29)+chr(25)  && go to beginning of field and clear
  264.         else
  265.             keyboard chr(26)+chr(25)  && ditto
  266.         endif
  267.     endif
  268.  
  269. RETURN
  270. *-- EoP: Cut
  271.  
  272. PROCEDURE Copy
  273. *-------------------------------------------------------------------------------
  274. *-- Programmer..: Michael B. Carlisle (Borland)
  275. *-- Date........: 01/01/1992
  276. *-- Notes.......: This retrieves information from the field the user has
  277. *--               currently selected and stores the information into a 
  278. *--               memory variable titled CLIPBOARD. The field itself is
  279. *--               left 'as is' (unlike CUT). CLIPBOARD should be declared 
  280. *--               public. This routine is taken from TECHNOTES.
  281. *-- Written for.: dBASE IV, 1.1
  282. *-- Rev. History: 01/01/1992 -- Original
  283. *-- Calls.......: None
  284. *-- Called by...: Any
  285. *-- Usage.......: do COPY with "<cFld>"
  286. *-- Example.....: on key label F8 do COPY with varread()
  287. *-- Returns.....: None
  288. *-- Parameters..: cFld     = Field to 'COPY' the data from.
  289. *-------------------------------------------------------------------------------
  290.  
  291.     parameters cFld
  292.     
  293.     *-- test field type, ignore if field is memo
  294.     clipboard = iif(type(cFld) = "D",;
  295.                     right(dtos(&cFld),4)+substr(dtos(&cFld),3,2),;
  296.                  iif(type(cFld) = "L",iif(&cFld,"T","F"),;
  297.                  iif(type(cFld)="M","",&cFld)))
  298.         
  299.     *-- if field type is Numeric or Float, convert to string.
  300.     if type(cFld) $ "NF"
  301.         clipboard = ltrim(str(int(fixed(&cFld)),20)+;
  302.                      right(str(fixed(&cFld) - int(fixed(&cFld)),20,18,19))
  303.         do while val(right(clipboard,1)) = 0 .and. .not. right(clipboard,1)="."
  304.             clipboard = left(clipboard,len(clipboard)-1)
  305.         enddo
  306.     endif
  307.     
  308.     *-- Ring bell if field is MEMO, otherwise, clear the field
  309.     if type(cFld) = "M"
  310.         ?? chr(7)
  311.     endif
  312.     
  313. RETURN
  314. *-- EoP: Copy
  315.  
  316. PROCEDURE Paste
  317. *-------------------------------------------------------------------------------
  318. *-- Programmer..: Michael B. Carlisle (Borland)
  319. *-- Date........: 01/01/1992
  320. *-- Notes.......: Paste writes out the contents of the CLIPBOARD (public)
  321. *--               memvar to the currently selected field. Because all values
  322. *--               are converted to strings when stored into the CLIPBOARD,
  323. *--               Paste is able to write values from one field type to another
  324. *--               (such as numeric to character, date to numeric, etc.).
  325. *--               This routine is taken from TECHNOTES.
  326. *-- Written for.: dBASE IV, 1.1
  327. *-- Rev. History: 01/01/1992 -- Original
  328. *-- Calls.......: None
  329. *-- Called by...: Any
  330. *-- Usage.......: do PASTE with "<cFld>","<cScrType>"
  331. *-- Example.....: on key label F7 do PASTE with varread(), "READ"
  332. *-- Returns.....: None
  333. *-- Parameters..: cFld     = Field to 'PASTE' the data in CLIPBOARD to.
  334. *--               cScrType = What screen type? Valid options are BROWSE,
  335. *--                           EDIT and READ.
  336. *-------------------------------------------------------------------------------
  337.     
  338.     parameters cFld, cScrType
  339.  
  340.     *-- ring bell if field is MEMO, otherwise, fill the field.
  341.     if type(cFld) = "M"
  342.         ?? chr(7)
  343.     else
  344.         *-- due to difference in function of HOME in the BROWSE mode,
  345.         *-- Ctrl-Home has to be used in BROWSE.
  346.         if upper(cScrType) = "BROWSE"
  347.             keyboard chr(29)+chr(25)+ClipBoard   && go to beginning of field,
  348.                                                  && and clear, putting contents
  349.                                                  && of clipboard in.
  350.         else
  351.             keyboard chr(26)+chr(25)+ClipBoard
  352.         endif
  353.     endif  && type ...
  354.  
  355. RETURN
  356. *-- EoP: Paste
  357.  
  358. FUNCTION Blanker
  359. *-------------------------------------------------------------------------------
  360. *-- Programmer..: Curt Schroeders (Borland Tech Support)
  361. *-- Date........: 07/01/1992
  362. *-- Notes.......: Used to BLANK a numeric field once the user presses a key
  363. *--               that may be used IN a numeric field. 
  364. *--               SIDE EFFECT -- if you use this function, the original value
  365. *--               in the field will be erased ... this does not allow editing
  366. *--               of the numeric field.
  367. *-- Written for.: dBASE IV, 1.5 (should work in 1.1)
  368. *-- Rev. History: 07/01/1992 -- Original
  369. *--               07/13/1992 -- Ken Mayer -- added '-' and '.' as valid
  370. *--               characters in list ...
  371. *-- Usage.......: Blanker()
  372. *-- Example.....: @5,10 get Salary when blanker()
  373. *-- Returns.....: Logical
  374. *-- Parameters..: None
  375. *-------------------------------------------------------------------------------
  376.     
  377.     private nX
  378.     
  379.     *-- get keystroke from user
  380.     nX = inkey(0)
  381.     
  382.     *-- if nX is in list
  383.     if chr(nX) $ "0123456789-."
  384.         keyboard "{CTRL-Y}"  && blank out field
  385.     endif
  386.     keyboard chr(nX)        && return this character ...
  387.  
  388. RETURN .t.
  389. *-- EoF: Blanker()
  390.  
  391. FUNCTION GetRange
  392. *-------------------------------------------------------------------------------
  393. *-- Programmer..: Joey D. Carroll  (JOEY)
  394. *-- Date........: 10/12/1992
  395. *-- Notes.......: A function to get a range for use with 'set key to range x,y'
  396. *--               or 'set filter to'. Works with character, numeric, float,
  397. *--               and date types.
  398. *-- Written for.: dBASE IV, 1.5
  399. *-- Rev. History: 11/08/1992 Changed to protect active windows.
  400. *--               Added SHADOW  (JOEY)
  401. *--               11/09/1992 Added (optional) cStyle parameter  (JOEY)
  402. *-- Calls.......: CENTER               Procedure in PROC.PRG
  403. *--               SHADOW               Procedure in PROC.PRG
  404. *-- Called by...: Any
  405. *-- Usage.......: ?? GetRange(<cText>,<xPara1>,<xPara2>,<cPicture>, ;
  406. *--               <nStartRow>,<cColor>[,cStyle])
  407. *-- Example.....: * get a range for a date, dbf in use is ordered by TRANDATE
  408. *--               dDate1={}
  409. *--               dDate2={}
  410. *--               ?? GetRange("Enter date range for your report",dDate1,dDate2,;
  411. *--                  "",10,"w+/r,n/w,w+/gb")
  412. *--               * now use values determined by getrange()
  413. *--               set key to range dDate1,dDate2
  414. *--               go top
  415. *--               * if the dbf is not indexed on a date or if you just =have=
  416. *--               *  to use a filter e.g.--
  417. *--               * set filter to Transdate >= dDate1 .and. Transdate<=dDate2
  418. *--               report form <yourreport> to print
  419. *-- Returns.....: .t. if correct type parameters, otherwise .f.
  420. *-- Parameters..: cText     = Message to center in window.  May be nul "".
  421. *--               xPara1     = First elemement of the 'key'.
  422. *--                              The 'width' of the character 'get' is
  423. *--                              determined by len(xPara1).
  424. *--                              The 'width' of the date 'get' is determined
  425. *--                              by set("century").
  426. *--               xPara2     = Second element of the 'key'.
  427. *--               cPicture  = Used to determine 'width' and format of
  428. *--                              numeric or float 'get', and the format
  429. *--                              of the character 'get'.  May be nul "".
  430. *--                              Ignored if xPara1 is date type.
  431. *--               nStartRow = Row to place top of window.
  432. *--                              Message row (24) is protected.
  433. *--               cColor    = Colors to be used ("Normal/HiLite/Box")
  434. *--                              (may be nul "", in order to use the
  435. *--                              default colors of window/screen)
  436. *--               cStyle    = "H" = horizontal  "V" = verticle  (may be
  437. *--                              omitted or ""/nul to default to "H" --
  438. *--                              =Very= long parameters default to "V")
  439. *-------------------------------------------------------------------------------
  440.  
  441.    parameters cText,xPara1,xPara2,cPicture,nStartRow,cColor,cStyle
  442.    private cTalk,cColor2,nSayLen,nPictLen,wPrevWind,nEndRow
  443.  
  444.    *-- is a window active
  445.    wPrevWind = window()
  446.    activate screen
  447.  
  448.    *-- in case no color is passed, this will prevent bomb
  449.    cColor2 = iif(isblank(cColor),"","color &cColor")
  450.  
  451.    *-- calculate window size based on parameters
  452.    do case
  453.       case type("xPara1") = "C"
  454.          *-- xPara1,xPara2 should initialized with space(len(alias->fieldname))
  455.          *--  or space(len(var))
  456.          nPictLen = 2 * len(xPara1)
  457.       case type("xPara1") = "N" .or. type("xPara1") = "F"
  458.          *-- gotta have a picture to define window width
  459.          cPicture = iif(isblank(cPicture),"9999999999",cPicture)
  460.          nPictLen  = 2 * len(cPicture)
  461.       case type("xPara1")="D"
  462.          nPictLen = 2 * (iif(set("CENTURY")="OFF",8,10))
  463.       otherwise
  464.          if .not. isblank(wPrevWind)
  465.             activate window &wPrevWind
  466.          endif
  467.          ?? chr(7)
  468.          RETURN .f.                  && stupid!
  469.    endcase
  470.  
  471.    cText = " "+cText       && don't jamb against box edge
  472.  
  473.    *-- is the window width going to be wider than 75 cols, OR was "V"
  474.    *--   passed in the cStyle param?  If so, use verticle style
  475.  
  476.    nSayLen = len("From: ") + len("To: ")
  477.    nWindWidth = nSayLen + nPictLen + 7
  478.    *-- if len(cText) > nWindWidth, fix it
  479.    nWindWidth = max(nWindWidth,len(cText) + 3)
  480.  
  481.    if nWindWidth <= 76 .and. (pcount() < 7 .or. upper(cStyle) = "H")
  482.       cStyle = "H"                        && make it so
  483.       nStartRow = min(nStartRow,16)       && protect row 24 even from shadow
  484.       nStartCol = (80-nWindWidth) / 2     && center the window
  485.       nEndRow = nStartRow + 6
  486.  
  487.       define window wGetRange from nStartRow,nStartCol to nEndRow, ;
  488.          nStartCol+nWindWidth &cColor2. double
  489.    else
  490.       *-- wants verticle style or params are too wide for horizontal
  491.       *--   so do some re-figgering
  492.       cStyle = "V"                        && make it so
  493.       nStartRow = min(nStartRow,14)       && protect row 24 even from shadow
  494.       nEndRow = nStartRow + 8
  495.       *-- recalc window width for this style
  496.       nSayLen    = len("From: ")
  497.       nPictLen   = nPictLen / 2           && doubled for horz., so cut by 1/2
  498.       nWindWidth = nSayLen + nPictLen + 7
  499.       *-- if len(cText) > nWindWidth, fix it
  500.       nWindWidth = max(nWindWidth,len(cText) + 3)
  501.       nStartCol  = (80-nWindWidth) / 2     && center the window
  502.  
  503.       define window wGetRange from nStartRow,nStartCol to nEndRow, ;
  504.          nStartCol+nWindWidth &cColor2. double
  505.    endif
  506.  
  507.    save screen to sGetRange
  508.  
  509.    *-- now USE what you've done so far
  510.    do shadow with nStartRow,nStartCol,nEndRow,nStartCol+nWindWidth
  511.    activate window wGetRange
  512.    do center with 1,nWindWidth - 2,"",cText
  513.  
  514.    @ 2,0 to 2,nWindWidth - 2
  515.    @ 3,2 say 'From:' get xPara1 picture cPicture
  516.  
  517.    if cStyle = "H"
  518.       @ 3,(nWindWidth- 2 ) - (len("To: ")) - (nPictLen/2) - 1 ;
  519.                   say 'To:' get xPara2 picture cPicture
  520.    else
  521.       @ 5,4 say 'To:' get xPara2 picture cPicture
  522.    endif
  523.  
  524.    read
  525.  
  526.    *-- clean up your doin's
  527.    deactivate window wGetRange
  528.    restore screen from sGetRange
  529.    release screen sGetRange
  530.    release window wGetRange
  531.  
  532.    if .not. isblank(wPrevWind)
  533.       activate window &wPrevWind
  534.    endif
  535.  
  536. RETURN .t.
  537. *-- EoF: GetRange()
  538.  
  539. FUNCTION FldWidth
  540. *-------------------------------------------------------------------------------
  541. *-- Programmer..: Kenneth Chan [HazMatZak] (CIS: 71542,2712)
  542. *-- Date........: 03/24/1993
  543. *-- Notes.......: Returns the width of a field, without having to read the
  544. *--               .DBF structure into a file and use low-level functions ...
  545. *-- Written for.: dBASE IV, 1.5
  546. *-- Rev. History: 01/28/1993 -- Original
  547. *--               03/24/1993 -- Lee Hite -- Enhanced to accept a field name
  548. *--               as well as a field number, also added optional <cAlias>
  549. *--               to allow checking a file that is not currently selected.
  550. *-- Calls.......: None
  551. *-- Called by...: Any
  552. *-- Usage.......: FldWidth(<nField>[,<cAlias>])
  553. *-- Example.....: ?FldWidth(3)           or
  554. *--               ?FldWidth("MyField")   or
  555. *--               ?FldWidth("MyField","MyFile")
  556. *-- Returns.....: Numeric value
  557. *-- Parameters..: nField = field number (or name) in file structure
  558. *--               cAlias = Optional file alias (defaults to current)
  559. *-------------------------------------------------------------------------------
  560.  
  561.     parameters nField, cAlias
  562.     private nReturn, cFldType, cFldName, cDBF
  563.  
  564.     *-- Deal with alias passed as a parameter
  565.     cDBF = iif(type("CALIAS") = "L",alias(),cAlias)
  566.  
  567.     *-- deal with field parameter being numeric or character
  568.     cFldName = iif(type("nField") = "N",field(nField,cDBF),nField)
  569.  
  570.     *-- readyt to go ...
  571.     cFldType = type("&cDBF.->&cFldName.")  && get the type ...
  572.     do case
  573.         case cFldType = "L"
  574.             nReturn = 1
  575.         case cFldType = "D"
  576.             nReturn = 8
  577.         case cFldType = "C"
  578.             nReturn = len(&cDBF.->&cFldName.)
  579.         case cFldType $ "NF"
  580.             nReturn = len(transform(&cDBF.->&cFldName.,"@L"))
  581.         otherwise
  582.             nReturn = 0
  583.     endcase
  584.     
  585. RETURN nReturn
  586. *-- EoF: FldWidth()
  587.  
  588. FUNCTION FldDec
  589. *-------------------------------------------------------------------------------
  590. *-- Programmer..: Kenneth Chan [HazMatZak] (CIS: 71542,2712)
  591. *-- Date........: 01/28/1993
  592. *-- Notes.......: Returns the number of decimal places of a numeric field. 
  593. *-- Written for.: dBASE IV, 1.5
  594. *-- Rev. History: 01/28/1993 -- Original
  595. *-- Calls.......: None
  596. *-- Called by...: Any
  597. *-- Usage.......: FldDec(<nField>)
  598. *-- Example.....: ?FldDec(3)
  599. *-- Returns.....: Numeric value, 0 if non-numeric field type
  600. *-- Parameters..: nField = field number in file structure
  601. *-------------------------------------------------------------------------------
  602.  
  603.     parameters nField
  604.     private nReturn, cTemplate, cFldName
  605.     
  606.     cFldName = field(nField)
  607.     if type(cFldName) $ "NF"    && if it's numeric/float type
  608.         cTemplate = transform(&cFldName.,"@L")
  609.         nReturn = at(".",cTemplate)
  610.         if nReturn > 0
  611.             nReturn = len(cTemplate) - nReturn
  612.         endif
  613.     else
  614.         nReturn = 0
  615.     endif
  616.  
  617. RETURN nReturn
  618. *-- EoF: FldDec()
  619.  
  620. *-------------------------------------------------------------------------------
  621. *-- EoP: FIELDS.PRG
  622. *-------------------------------------------------------------------------------
  623.