home *** CD-ROM | disk | FTP | other *** search
/ PC Press 1997 July / Sezamfile97_1.iso / msdos / database / dbx132.arj / MYFUNC.PRG < prev    next >
Text File  |  1993-09-20  |  26KB  |  843 lines
  1. * Program...: MYFUNC.PRG
  2. * Author....: Your Name Here
  3. * Date......:
  4. * Notes.....: This routine is called by pressing Sh-F1 when browsing a
  5. *             database.  You can create any routine you like by expanding
  6. *             the code below and linking the routine into dbMAX.  Sample
  7. *             code is included at the end of this file (commented-out).
  8. *
  9. *             Compile with -n -l switches
  10. *
  11. *             IMPORTANT:  You may notice that Clipper 5.2 index order
  12. *             functions are used in the sample code below.  If you are
  13. *             using Clipper 5.0x, these functions WILL work properly!
  14. *
  15. * Revised...: 03/15/93, rev 1.30 - revised for Clipper 5.2
  16. *             05/22/93, rev 1.31 - added DBFNSX support
  17. *             08/21/93, rev 1.32 - revised for SIXCDX v1.5 and SIXNSX 1.5
  18. *
  19. *****************************************************************************
  20. *
  21. #include "inkey.ch"
  22. *
  23. #ifdef DBFNDX
  24.   #ifdef CL50
  25.     external _VDBFNDX
  26.   #else
  27.     request dbfndx
  28.   #endif
  29. #endif
  30. *
  31. #ifdef DBFCDX
  32.   request dbfcdx
  33. #endif
  34. *
  35. #ifdef DBFMDX
  36.   request dbfmdx
  37. #endif
  38. *
  39. * WARNING: do not request or link both DBFCDX and SIXCDX RDDs!  Doing so
  40. * will cause errors!
  41. *
  42. #ifdef SIXCDX
  43.   #ifdef CL50
  44.     external _VSIXCDX
  45.   #else
  46.     request sixcdx
  47.   #endif
  48. #endif
  49. *
  50. * WARNING: do not request or link both SIXCDX and SIXNSX RDDs at this time!
  51. * Doing so will cause errors!
  52. *
  53. #ifdef SIXNSX
  54.   #ifdef CL50
  55.     external _VSIXNSX
  56.   #else
  57.     request sixnsx
  58.   #endif
  59. #endif
  60. *
  61. *****************************************************************************
  62. * DO NOT REMOVE OR RENAME THE FOLLOWING FUNCTION
  63. *****************************************************************************
  64. *
  65. function MyFunc( vnKey,voBrowse,vlEditMode,vlNoAppend,vlNoDelete,vaField, ;
  66.                  vcEditFunc)
  67. *
  68. * vnKey      = the ASCII value of the last key pressed, passed by reference
  69. *              (will always be -10/K_SH_F1)
  70. * voBrowse   = the current browse object, passed by reference
  71. * vlEditMode = .T. if editing allowed
  72. * vlNoAppend = .T. if no appending allowed (always .F.)
  73. * vlNoDelete = .T. if no deleting allowed (always .F.)
  74. * vaField    = DBSTRUCT() of all fields in database, passed by reference
  75. * vcEditFunc = name of a user-defined edit routine (always '')
  76. *
  77. * Although some of the variables above have been passed by reference, any
  78. * changes to them will be ignored (see below for more info).
  79. *
  80. *
  81. * NOTE:  PRESSING SH-F1 WILL CALL MYFUNC(), BUT ALL PARAMETERS WILL BE NIL!!
  82. *        MYFUNC() is currently called by evaluating the following code block,
  83. *        as follows:
  84. *
  85. *          bBlock := {|| MyFunc()}        && declared in main procedure
  86. *          *
  87. *          eval(bBlock,@vnKey,@voBrowse,vlEditMode,vlNoAppend,vlNoDelete, ;
  88. *           @vaField,vcEditFunc)
  89. *
  90. *       To properly allow parameters to be passed, the code block would have
  91. *       to be defined as something like:
  92. *
  93. *          bBlock := {|p1,p2,p3,p4,p5,p6,p7| MyFunc(p1,p2,p3,p4,p5,p6,p7)}
  94. *
  95. *       This version of dbMAX does not do this.  HOWEVER, THIS DOES NOT
  96. *       REALLY MATTER SINCE ALL PARAMETERS CAN BE OBTAINED BY CHECKING THE
  97. *       VARIABLES LISTED BELOW.
  98. *
  99. local vcScreen
  100. local vcColrSave := setcolor(vcMenuBar)
  101. local vnChoice   := 1
  102. *
  103. save screen to vcScreen
  104. @ 0,0                                   && clear off default menu bar
  105. HelpBar('User-defined function menu.')
  106. setcolor(vcColrSave)
  107. *
  108. do while vnChoice<>0
  109.   PullDown(0,2,{'  Utils  '},{'U'},{.T.},nil,@vnChoice)
  110.   *
  111.   do case
  112.     case vnChoice=1
  113.       HelpBar('User-defined utilities.')
  114.       if UserUtils()
  115.         vnChoice := 0
  116.       endif
  117.       *
  118.     otherwise
  119.       vnChoice := 0
  120.       *
  121.   endcase
  122.   *
  123.   HelpBar()
  124.   *
  125. enddo
  126. restore screen from vcScreen
  127. return (nil)
  128. *
  129. *****************************************************************************
  130. * DO NOT REMOVE OR RENAME THE FOLLOWING FUNCTION
  131. *****************************************************************************
  132. *
  133. * Basic SIx Driver trigger handler code - modify as needed to extend the
  134. * trigger event handlers
  135. *
  136. #ifdef SIXCDX
  137.   #define SIXTRIGGER
  138. #endif
  139. #ifdef SIXNSX
  140.   #define SIXTRIGGER
  141. #endif
  142. *
  143. #ifdef SIXTRIGGER
  144.   *
  145.   * #DEFINEs from .CH file (included here since SIXCDX.CH/SIXNSX.CH are
  146.   * not #INCLUDEd); may need revision if SuccessWare adds/changes events!
  147.   *
  148.   #define  EVENT_PREUSE       1
  149.   #define  EVENT_POSTUSE      2
  150.   #define  EVENT_UPDATE          3
  151.   #define  EVENT_APPEND       4
  152.   #define  EVENT_DELETE       5
  153.   #define  EVENT_RECALL       6
  154.   #define  EVENT_PACK         7
  155.   #define  EVENT_ZAP            8
  156.   #define  EVENT_PUT          9
  157.   #define  EVENT_GET          10
  158.   #define  EVENT_PRECLOSE     11
  159.   #define  EVENT_POSTCLOSE    12
  160.   #define  EVENT_PREMEMOPACK  13
  161.   #define  EVENT_POSTMEMOPACK 14
  162.   *
  163.   function Sx_DefTrigger(vnEvent,vnArea,vnFieldPos,vxTrigVal)
  164.   *
  165.   * replacement trigger function for the SIx Driver
  166.   *
  167.   local vcScreen,vcColrSave
  168.   local vcPassWord := space(8)
  169.   *
  170.   do case
  171.     *case vnEvent=EVENT_PREUSE
  172.     case vnEvent=EVENT_POSTUSE
  173.       if Sx_TableType()=2        && encrypted database
  174.         *
  175.         * ask for decryption password
  176.         *
  177.         save screen to vcScreen
  178.         vcColrSave := setcolor()
  179.         HelpBar('Encrypted database!  Enter password or press <Esc> to cancel.')
  180.         PopBox(4,30,6,50,2)
  181.         @ 5,32 say 'Password' get vcPassWord
  182.         set cursor on
  183.         read
  184.         clear gets
  185.         set cursor off
  186.         restore screen from vcScreen
  187.         setcolor(vcColrSave)
  188.         *
  189.         if lastkey()<>K_ESC
  190.           Sx_SetPass(trim(vcPassWord))
  191.         endif
  192.       endif
  193.       *
  194.     *case vnEvent=EVENT_PREUSE
  195.     *case vnEvent=EVENT_UPDATE
  196.     *case vnEvent=EVENT_APPEND
  197.     *case vnEvent=EVENT_DELETE
  198.     *case vnEvent=EVENT_RECALL
  199.     *case vnEvent=EVENT_PACK
  200.     *case vnEvent=EVENT_ZAP
  201.     *case vnEvent=EVENT_PUT
  202.     *case vnEvent=EVENT_GET
  203.     *case vnEvent=EVENT_PRECLOSE
  204.     *case vnEvent=EVENT_POSTCLOSE
  205.     *case vnEvent=EVENT_PREMEMOPACK
  206.     *case vnEvent=EVENT_POSTMEMOPACK
  207.   endcase
  208.   *
  209.   return (.T.)
  210. #endif
  211. *
  212. *****************************************************************************
  213. * THE REMAIN FUNCTIONS CAN BE REMOVED/RENAMED IF MYFUNC() IS REVISED
  214. *****************************************************************************
  215. *
  216. static function UserUtils()
  217. *
  218. local vcScreen
  219. local vnChoice := 1
  220. local vlRetVal := .F.         && .T.=exited normally, .F.=used Esc to exit
  221. *
  222. local vaMenu := {'  List dups '}
  223. *
  224. local vaHotKeys := {'L'}
  225. local vaValid := {(vnInUse>0 .and. ordnumber(ordsetfocus(),ordbagname(0))<>0)}
  226. local vaMessage := {'List duplicate records (contributed by John Wright).'}
  227. *
  228. save screen to vcScreen
  229. *
  230. do while vnChoice<>0
  231.   *
  232.   PullDown(1,1,vaMenu,vaHotKeys,vaValid,vaMessage,@vnChoice)
  233.   *
  234.   do case
  235.     case vnChoice=1
  236.       if HuntDups()          && if .T. (task complete), quits back to
  237.         vnChoice := 0        && ...dbMAX menu or browse
  238.         vlRetVal := .T.
  239.       endif
  240.       *
  241.   endcase
  242. enddo
  243. restore screen from vcScreen
  244. *
  245. return (vlRetVal)
  246. *
  247. *****************************************************************************
  248. *
  249. static function HuntDups()
  250. *
  251. * Contributed by:  John Wright
  252. * Revised by:      David Kennedy, 03/07/93 for Clipper 5.2
  253. *
  254. * HuntDups() uses the currently selected index to hunt for duplicates.
  255. * HuntDups() allows you to create an index with numerous fields, check for
  256. * a specific section of that index and then display even more data than the
  257. * "hunt" criteria.  There is no need to create a new index if you already
  258. * have one that meets your search needs.
  259. *
  260. * Example:  You have a database of customer names and want to find
  261. *           duplicates.  Index the database on LASTNAME+FIRSTNAME+CITY,
  262. *           search for duplicates of LASTNAME+FIRSTNAME and display
  263. *           LASTNAME+FIRSTNAME+CITY+PHONE etc... so you can see if the
  264. *           names are really duplicates.
  265. *
  266. *           A client's INVOICE database gets messed up when duplicate
  267. *           order records are merged in by mistake.  Use HuntDups() to
  268. *           search on invoice number and delete duplicates.  This saves
  269. *           the extra step of having to go back to clean up the file.
  270. *           The duplicate records are only marked for deletion.  You
  271. *           still have to pack the database to get rid of the dups...
  272. *
  273. local vcColrSave := setcolor()
  274. local vnRecNo := recno()
  275. local vlOk := .F.
  276. local vcScreen
  277. *
  278. local vcCheck := padr(upper(ordkey(ordsetfocus(),ordbagname(0))),254)
  279. local vcList := padr(upper(ordkey(ordsetfocus(),ordbagname(0))),254)
  280. local vcFile := padr(vcRamDrv+'DUPS.PRN',80)
  281. local vlKill := .F.
  282. local vnDeleted := 0
  283. local vnCount := 0
  284. local vbCheck, vbList, vcPrev, vlFirst
  285. *
  286. save screen to vcScreen
  287. HelpBar('Enter the search parameters.')
  288. PopBox(4,5,13,74,2,'List duplicates')
  289. *
  290. do while .not. vlOK
  291.   *
  292.   vlOK := .T.
  293.   *
  294.   @  6,7 say 'Check for dups of ' get vcCheck picture '@K@S47@X'
  295.   @  7,7 say 'List for each dup ' get vcList picture '@K@S47@X'
  296.   @  8,7 say 'Send dup list to  ' get vcFile picture '@K@S47@!'
  297.   @  9,7 say 'Delete duplicates?' get vlKill picture 'Y'
  298.   *
  299.   @ 11,27 say ' Ok '
  300.   @ 11,34 say ' Retry '
  301.   @ 11,44 say ' Cancel '
  302.   *
  303.   set cursor on
  304.   read
  305.   clear gets
  306.   set cursor off
  307.   *
  308.   if lastkey()<>K_ESC
  309.     *
  310.     if vlOK
  311.       *
  312.       * everything is OK, so see if user wants to save
  313.       *
  314.       @ 11,27 prompt ' Ok '
  315.       @ 11,34 prompt ' Retry '
  316.       @ 11,44 prompt ' Cancel '
  317.       menu to vnTemp
  318.       *
  319.       do case
  320.         case vnTemp=1 .and. !empty(vcCheck) .and. !empty(vcList) ;
  321.          .and. !empty(vcFile)
  322.           *
  323.         case vnTemp=2
  324.           vlOK := .F.
  325.           *
  326.         otherwise
  327.           vlOK := .F.
  328.           exit
  329.           *
  330.       endcase
  331.     endif
  332.   else
  333.     vlOK := .F.
  334.     exit
  335.   endif
  336. enddo
  337. *
  338. * locate data if OK
  339. *
  340. restore screen from vcScreen
  341. if vlOK
  342.   *
  343.   HelpBar()
  344.   PopBox(4,23,8,56,2)
  345.   @ 6,25 say 'Please wait while searching...'
  346.   *
  347.   ZeroCnt()
  348.   *
  349.   vcFile := FixFile(vcFile,'.PRN')
  350.   set printer to (vcFile) additive
  351.   set console off
  352.   set print on
  353.   set device to print
  354.   *
  355.   * print database information
  356.   *
  357.   ? 'Database: '+vaDbfNtx[vnCurrArea,1]+vaDbfNtx[vnCurrArea,2]
  358.   ? 'Index:    '+vaDbfNtx[vnCurrArea,3,OrdFilePos(ordbagname(0)),1]+;
  359.    vaDbfNtx[vnCurrArea,3,OrdFilePos(ordbagname(0)),2]
  360.   ? 'Look for: '+upper(trim(vcCheck))
  361.   ? 'Display:  '+upper(trim(vcList))
  362.   ?
  363.   vbCheck := &('{||'+trim(vcCheck)+'}' )
  364.   vbList  := &("{|| if(deleted(),'*',' ')+str(recno(),7,0)+'  '+"+trim(vcList)+'}')
  365.   *
  366.   go top
  367.   vlFirst := .T.
  368.   vcPrev  := eval(vbCheck)
  369.   do while !eof() .and. inkey()<>K_ESC
  370.     skip
  371.     if eval(vbCheck)==vcPrev
  372.       if vlFirst                        // skip back to print first duplicate
  373.         skip -1
  374.         ?
  375.         ? eval(vbList)
  376.         skip
  377.         vlFirst := .F.
  378.       endif
  379.       if vlKill .and. rec_lock(2)
  380.         delete
  381.         vnDeleted++
  382.         unlock
  383.       endif
  384.       ? eval(vbList)
  385.       set device to screen
  386.       DispCnt('duplicated')
  387.       vnCount++
  388.       set device to print
  389.     else
  390.       vcPrev  := eval(vbCheck)
  391.       vlFirst := .T.
  392.     endif
  393.   enddo
  394.   *
  395.   vcList := ltrim(str(vnCount))+' duplicate records found.'
  396.   ?
  397.   ?
  398.   ? vcList
  399.   if vlKill
  400.     vcCheck := ltrim(str(vnDeleted))+' records deleted.'
  401.     ? vcCheck
  402.   endif
  403.   eject
  404.   *
  405.   set device to screen
  406.   set print off
  407.   set console on
  408.   set printer to
  409.   keyboard ''                          // clear buffer of any unwanted Esc's
  410.   *
  411.   * display information about the search for duplicates
  412.   *
  413.   restore screen from vcScreen
  414.   PopBox(10,23,if(vlKill,15,14),26+len(vcList),2)
  415.   @ 12,25 say vcList
  416.   if vlKill
  417.     @ 13,25 say vcCheck
  418.   endif
  419.   tone(100,1)
  420.   HelpBar('Press any key to continue...')
  421.   inkey(0)
  422.   *
  423.   go vnRecNo
  424.   setcolor(vcColrSave)
  425.   restore screen from vcScreen
  426.   if vlKill .and. vnDeleted > 0
  427.     vaBrowStak[vnCurrArea,1]:refreshAll()
  428.   endif
  429. else
  430.   setcolor(vcColrSave)
  431. endif
  432. *
  433. return (vlOK)
  434. *
  435. *****************************************************************************
  436. *
  437. * The following variables are used by dbMAX and CAN be changed:
  438. *                                               ▀▀▀
  439. * vcPath      = current drive and path used by dbMAX (initially set to your
  440. *               current DOS path but changes when any pop-up directories are
  441. *               used (Alt-B, Alt-N, etc.))
  442. * vnInUse     = total number of work areas in use
  443. * vnCurrArea  = current work area number
  444. * vaDBFNTX    = array of .DBFs/.NTXs/open modes
  445. * vaBrowStak  = browse object stack
  446. * vlRepaint   = set to .T. to completely repaint desktop/browse(s)
  447. *
  448. * vcDosColr   = current DOS screen color
  449. * vcDeskTop   = desktop color
  450. * vcBrowse    = browse color
  451. * vcShadow    = box shadow color
  452. * vcMenuBar   = menu bar color
  453. * vcPullDown  = pull-down menu color
  454. * vcPullBox   = pull-down box border color
  455. * vcHotKey    = accelerator key color
  456. * vcError     = error message color
  457. *
  458. * vcRdd       = the name of the currently selected RDD
  459. * vlMultiUser = .T. if running in multi-user mode (database could be opened
  460. *               shared or exclusive, regardless of this setting)
  461. * vcRamDrv    = temporary files drive
  462. * vcEditor    = default memo editor ("" = use MEMOEDIT())
  463. * vnMemoWidth = default memo line length (0 = screen width)
  464. * vcPrnSetup  = printer setup string
  465. * vnPageLen   = max lines per page
  466. * vnLeftMar   = left margin
  467. * vnTopMar    = top margin
  468. * vnMaxRow    = max rows on screen
  469. * vnInitRow   = max initial rows on screen (DOS)
  470. * vnMaxCol    = max columns on screen
  471. * vnInitCol   = max initial columns on screen (DOS)
  472. * vlDelStru   = .T. to delete .STR files when done
  473. * vnBlank     = 0=don't blank GETs,1=blank if insert on,2=blank if insert off
  474. * vlWarn      = .T. warns if .DBF doesn't match driver
  475. * vlAllowEdit = .T. if editing allowed
  476. * vlBadEMS    = .T. if bad EMS switch set (bypasses Overlay())
  477. *
  478. *
  479. * The most important variables are the vaDBFNTX and vaBrowStak arrays.  The
  480. * vaDBFNTX array contains a list of all open databases.  All elements in a
  481. * "row" will be NIL if a database was opened and then closed.  The number
  482. * of the array element that is currently active is stored in vnCurrArea,
  483. * which is also SELECT() (usually).  The structure for one element is as
  484. * follows:
  485. *
  486. * vaDBFNTX[1] = {"<drive:\path\>","dbase.dbf",{"index <drive:\path\>",;
  487. *               "index.ntx"},"E/S","RDD"}
  488. *
  489. *   vaDBFNTX[1,1] = the full drive and path with trailing backslash for the
  490. *                   database; i.e., "C:\DATA\"
  491. *   vaDBFNTX[1,2] = the full name and extension of the database; i.e.,
  492. *                   "MYDATA.DBF"
  493. *   vaDBFNTX[1,3] = an array of open indexes for the database; if no indexes
  494. *                   are open, this will be NIL
  495. *
  496. *     vaDBFNTX[1,3,1] = the full drive and path with trailing backslash for
  497. *                       the index; i.e., "C:\DATA\"
  498. *     vaDBFNTX[1,3,2] = the full name and extension of the index; i.e.,
  499. *                       "MYDATA.NTX"
  500. *
  501. *   vaDBFNTX[1,4] = "E" if file is opened exclusively, "S" if shared
  502. *
  503. *   vaDBFNTX[1,5] = name of the RDD that the database was opened under,
  504. *                   such as "DBFNTX" or "DBFNDX".
  505. *
  506. * The vaBrowStak contains all the browse objects currently in use.  The
  507. * number of the array element that is currently active is stored in
  508. * vnCurrArea, which is normally the same as SELECT().  The structure for one
  509. * element is as follows:
  510. *
  511. * vaBrowStak[1] = {<oBrowse>,{<structure>}}
  512. *
  513. *   vaBrowStak[1,1] = the browse object; oBrowse:cargo contains append mode
  514. *                     flag; oColumn:cargo contains actual field name/
  515. *                     expression for the column
  516. *   vaBrowStak[1,2] = the structure of the database, the same as that
  517. *                     created by the DBSTRUCT() function
  518. *
  519. * Usage example:
  520. *
  521. *   * refresh the current browse window
  522. *   vaBrowStak[vnCurrArea,1]:refreshAll()
  523. *
  524. *****************************************************************************
  525. *
  526. * Some internal dbMAX functions that may be called by your routines are:
  527. *
  528. * ColStru() - returns the structure of a field/expression
  529. *
  530. *     Usage:   aArray := ColStru( cFieldName )
  531. *
  532. *     Where:   cFieldName = the name of a field or memory variable
  533. *
  534. *     Returns: {cFieldName,cType,nLength,nDecimals} array for a field or
  535. *              expression.  If cFieldName contains an expression, cType
  536. *              will be "E".
  537. *
  538. *     Example:
  539. *
  540. *       * returns the structure array for the field where a hot-key was
  541. *       * pressed
  542. *       *
  543. *       aArray := ColStru( (voBrowse:getColumn(voBrowse:colPos)):cargo )
  544. *
  545. *
  546. * PullDown() - sets up and displays menu system
  547. *
  548. *     Usage:   PullDown( nRow,nCol,aMenu,aHotKeys,aValid,aMessage,@nChoice )
  549. *
  550. *     Where:   nRow     = top row of the pop-up menu box.  If nRow=0, the
  551. *                         menu appears horizontally on line 0!
  552. *              nCol     = left column of the pop-up menu box
  553. *              aMenu    = array of menu choices
  554. *              aHotKeys = array of hot key letters for the menu choices,
  555. *                         "" for choices with no hot key (horizontal menus
  556. *                         will not use hot keys)
  557. *              aValid   = parallel logical array for valid menu choices
  558. *              aMessage = help bar messages to display when selecting
  559. *                         (horizontal menus will not use messages)
  560. *              nChoice  = variable to take menu selection, passed by ref.
  561. *
  562. *     Returns: NIL, but nChoice contains the number of the menu item
  563. *              selected, 0 if nothing was selected.
  564. *
  565. *     Example:
  566. *
  567. *       local nChoice := 0
  568. *       PullDown(1,1,{'  New...      Alt-N ',;
  569. *                     '  Open...     Alt-O ',;
  570. *                     ' ────────────────── ',;
  571. *                     '  Quit        Alt-Q '},{'N','O','','Q'},;
  572. *                     {.T.,.T.,.F.,.T.},{'Message 1','Message 2','',''},;
  573. *                     @nChoice)
  574. *
  575. *
  576. * HelpBar() - places a message on the help bar
  577. *
  578. *     Usage:   HelpBar( [cMessage] )
  579. *
  580. *     Where:   cMessage = any character string or NIL
  581. *
  582. *     Returns: NIL
  583. *
  584. *     Example:
  585. *
  586. *       HelpBar()                         // clears off help bar
  587. *       HelpBar('Press <Esc> to quit.')
  588. *
  589. *
  590. * PopBox() - pops up a single- or double-lined filled shadowed box
  591. *
  592. *     Usage:   PopBox( nTRow,nTCol,nBRow,nBCol,nBorder [,cTitle] )
  593. *
  594. *     Where:   nTRow   = top row of box
  595. *              nTCol   = top left col of box
  596. *              nBRow   = bottom row of box
  597. *              nBCol   = bottom left col of box
  598. *              nBorder = 1=single line, 2=double line
  599. *              cTitle  = optional title to be displayed (@ nTRow,nTCol+2)
  600. *
  601. *     Returns: NIL
  602. *
  603. *     Example:
  604. *
  605. *       PopBox(4,9,10,70,2,'Database name')
  606. *
  607. *
  608. * PopError()  - pops up an error message
  609. *
  610. *     Usage:   PopError( cMessage )
  611. *              nChoice := PopError( cMessage [,aPrompts] )
  612. *
  613. *     Where:   cMessage = any character string for the error message
  614. *              aPrompts = an optional array of selection options, defaults
  615. *                         to " Ok " if nothing passed
  616. *
  617. *     Returns: number of choice selected
  618. *
  619. *     Example:
  620. *
  621. *       PopError('Not enough file handles ('+ltrim(str(MaxHand()))+')!')
  622. *       nChoice := PopError('File exists!',{' Overwrite ',' Cancel '})
  623. *
  624. *
  625. * MaxHand()   - gets maximum number of file handles remaining
  626. *
  627. *     Usage:   MaxHand()
  628. *
  629. *     Returns: number of file handles remaining
  630. *
  631. *     Example:
  632. *
  633. *       @ 1,1 say 'You have '+ltrim(str(MaxHand()))+' handles remaining!'
  634. *
  635. *
  636. * fil_lock() - tries to lock a file
  637. *
  638. *     Usage:   fil_lock( nWait )
  639. *
  640. *     Where:   nWait = number of seconds to wait for the lock, 0=forever
  641. *
  642. *     Returns: .T. if lock was successful, .F. otherwise
  643. *
  644. *     Example:
  645. *
  646. *       if fil_lock(2)
  647. *         replace all field with 'stuff'
  648. *         commit
  649. *         unlock
  650. *       else
  651. *         PopError('File could not be locked!')
  652. *       endif
  653. *
  654. *
  655. * rec_lock() - tries to lock a record
  656. *
  657. *     Usage:   rec_lock( nWait )
  658. *
  659. *     Where:   nWait = number of seconds to wait for the lock, 0=forever
  660. *
  661. *     Returns: .T. if lock was successful, .F. otherwise
  662. *
  663. *     Example:
  664. *
  665. *       if rec_lock(2)
  666. *         delete
  667. *         commit
  668. *         unlock
  669. *       else
  670. *         PopError('Record could not be locked!')
  671. *       endif
  672. *
  673. *
  674. * net_use() - tries to USE a database in shared or exclusive mode
  675. *
  676. *     Usage:   net_use( cFile,lExclus,nWait )
  677. *
  678. *     Where:   cFile   = name of database to open
  679. *              lExclus = .T. to open file exclusively
  680. *              nWait = number of seconds to wait for the lock, 0=forever
  681. *
  682. *     Returns: .T. if open was successful, .F. otherwise
  683. *
  684. *     Example: none!  Don't use this function unless you are sure you know
  685. *              what's going on inside dbMAX.  If you do not update
  686. *              vnCurrArea and vaDBFNTX[] when this command is used, you may
  687. *              cause the program to crash or operate incorrectly.
  688. *
  689. *
  690. * app_blank() - tries to append a blank record to a shared database
  691. *
  692. *     Usage:   app_blank( nWait )
  693. *
  694. *     Where:   nWait = number of seconds to wait for the append, 0=forever
  695. *
  696. *     Returns: .T. if append was successful, .F. otherwise
  697. *
  698. *     Example:
  699. *
  700. *       if app_blank(2)
  701. *         replace field with 'stuff'
  702. *         commit
  703. *         unlock
  704. *       else
  705. *         PopError('LASTREC()+1 is locked.  Something is screwed up!')
  706. *       endif
  707. *
  708. *****************************************************************************
  709. *****************************************************************************
  710. *
  711. * Sample MYFUNC() #1
  712. *
  713. * function MyFunc()
  714. * PopError('Function unavailable!')
  715. * return (nil)
  716. *
  717. *****************************************************************************
  718. *****************************************************************************
  719. *
  720. * Sample MYFUNC() #2
  721. *
  722. * *
  723. * function MyFunc()
  724. * *
  725. * local vnChoice := 1
  726. * local vcColrSave := setcolor(vcMenuBar)
  727. * local vcScreen
  728. * *
  729. * save screen to vcScreen
  730. * @ 0,0                                 && clear off default menu bar
  731. * HelpBar('Shift-F1 Main Menu.')
  732. * setcolor(vcColrSave)
  733. * *
  734. * do while vnChoice<>0
  735. *   PullDown(0,2,{'  Option 1  ',;
  736. *                 '  Option 2  ',;
  737. *                 '  Option 3  '},;
  738. *                 {'1','2','3'},{.T.,.T.,.T.},nil,@vnChoice)
  739. *   *
  740. *   do case
  741. *     case vnChoice=1
  742. *       HelpBar('Option 1 tasks menu.')
  743. *       if Sample()
  744. *         vnChoice := 0
  745. *       endif
  746. *       *
  747. *     case vnChoice=2
  748. *       HelpBar('Option 2 tasks menu.')
  749. *       PopError('Option 2 unavailable!')
  750. *       *
  751. *     case vnChoice=3
  752. *       HelpBar('Option 3 tasks menu.')
  753. *       PopError('Option 3 unavailable!')
  754. *       *
  755. *     otherwise
  756. *       vnChoice := 0
  757. *       *
  758. *   endcase
  759. *   *
  760. *   HelpBar()
  761. *   *
  762. * enddo
  763. * restore screen from vcScreen
  764. * return (nil)
  765. * *
  766. * *****************************************************************************
  767. * *
  768. * static function Sample()
  769. * *
  770. * local vnChoice := 1
  771. * local vlRetVal := .F.         && .T.=exited normally, .F.=used Esc to exit
  772. * local vcScreen
  773. * *
  774. * local vaMenu := {'  Check this ',;
  775. *                  ' ─────────── ',;
  776. *                  '  Allow edit ',;
  777. *                  '  In use > 0 ',;
  778. *                  '  Browse     '}
  779. * *
  780. * local vaHotKeys := {'C','','A','I','B'}
  781. * local vaValid := {.T.,.F.,vlAllowEdit,(vnInUse>0),(vnInUse>0)}
  782. * local vaMessage := {'Check/uncheck this item by pressing <Enter>.','',;
  783. *                     'Selectable if editing allowed.',;
  784. *                     'Selectable if at least one .DBF opened.',;
  785. *                     'Changes the color of the hilighted column.'}
  786. * *
  787. * save screen to vcScreen
  788. * *
  789. * do while vnChoice<>0
  790. *   *
  791. *   PullDown(1,1,vaMenu,vaHotKeys,vaValid,vaMessage,@vnChoice)
  792. *   *
  793. *   do case
  794. *     case vnChoice=1
  795. *       vaMenu[1] := iif(substr(vaMenu[1],1,1)=' ','√',' ')+;
  796. *        substr(vaMenu[1],2)
  797. *       *
  798. *     case vnChoice=3
  799. *       restore screen from vcScreen
  800. *       *
  801. *       *if YourOption()        && if .T. (task complete), quits back to
  802. *       *  vnChoice := 0        && ...dbMAX menu or browse
  803. *       *  vlRetVal := .T.
  804. *       *endif
  805. *       *
  806. *     case vnChoice=4
  807. *       restore screen from vcScreen     && don't RESTORE if you want the
  808. *       *                                   pull-down to stay on the screen
  809. *       *
  810. *       *MoreStuff()            && quits to dbMAX menu or browse whether task
  811. *       vnChoice := 0           && ...was completed or not
  812. *       vlRetVal := .T.
  813. *       *
  814. *     case vnChoice=5
  815. *       ChangeColor()
  816. *       vnChoice := 0
  817. *       vlRetVal := .T.
  818. *       *
  819. *   endcase
  820. * enddo
  821. * restore screen from vcScreen
  822. * *
  823. * return (vlRetVal)
  824. * *
  825. * *****************************************************************************
  826. * *
  827. * static function ChangeColor()
  828. * *
  829. * * Changes color of the currently highlighted column.  Can only be called if
  830. * * a file is being browsed, so error checking is not required.  :colorSpec
  831. * * is initially set to vcBrowse color.
  832. * *
  833. * local voBrowse := vaBrowStak[vnCurrArea,1]              && get curr browse
  834. * local voColumn := voBrowse:getColumn(voBrowse:colPos)   && get column
  835. * *
  836. * voBrowse:colorSpec := voBrowse:colorSpec+',+BG/B,+W/G'
  837. * voColumn:colorBlock := {|| {6,7} }
  838. * *
  839. * voBrowse:setColumn(voBrowse:colPos,voColumn)            && reset column
  840. * *
  841. * vaBrowStak[vnCurrArea,1] := voBrowse                    && save browse
  842. * return (nil)
  843.