home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / dbase / duflp / fields.prg < prev    next >
Text File  |  1992-07-13  |  14KB  |  393 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: FIELDS.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 06/25/1992
  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/91
  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: None
  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/xx/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: None
  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/xx/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: None
  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/xx/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: None
  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/13/1992 -- Ken Mayer -- added '-' and '.' as valid
  369. *--               characters in list ...
  370. *-- Usage.......: Blanker()
  371. *-- Example.....: @5,10 get Salary when blanker()
  372. *-- Returns.....: Logical
  373. *-- Parameters..: None
  374. *-------------------------------------------------------------------------------
  375.     
  376.     private nX
  377.     
  378.     *-- get keystroke from user
  379.     nX = inkey(0)
  380.     
  381.     *-- if nX is in list
  382.     if chr(nX) $ "0123456789-."
  383.         keyboard "{CTRL-Y}"  && blank out field
  384.     endif
  385.     keyboard chr(nX)        && return this character ...
  386.  
  387. RETURN
  388. *-- EoF: Blanker()
  389.  
  390. *-------------------------------------------------------------------------------
  391. *-- EoP: FIELDS.PRG
  392. *-------------------------------------------------------------------------------
  393.