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