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