home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / README.EXE / TBF1.PRG < prev    next >
Encoding:
Text File  |  1991-05-01  |  14.6 KB  |  499 lines
  1. /* 
  2.    Program:  BrowDemo.Prg
  3.    Date   :  03/12/91
  4.    Dialect:  Clipper 5.0
  5.    Author :  Kathleen B. Uchman
  6.    For Aquarium readers
  7.  
  8.    Compile:  Clipper browdemo /m /n 
  9.  
  10. */
  11.  
  12. #include "inkey.ch"
  13. memvar getlist
  14.  
  15. function main()
  16. local filestru_, stufdata_, i, j
  17.  
  18. set deleted on
  19.  
  20. /* first, let's make some databases to browse */
  21. filestru_ := { {"vendid ","C",06,0},;
  22.                {"name   ","C",20,0},;
  23.                {"address","C",20,0},;
  24.                {"city   ","C",20,0},;
  25.                {"state  ","C",02,0},;
  26.                {"zip    ","C",05,0},;
  27.                {"ytdpur ","N",09,2},;
  28.                {"ytdpay ","N",09,2} ;
  29.              }
  30. dbcreate("vendors",filestru_)
  31.  
  32. filestru_ := { {"vendid  ","C",06,0},;
  33.                {"invoice ","C",06,0},;
  34.                {"ponumber","C",06,0},;
  35.                {"purdate ","D",08,0},;
  36.                {"amount  ","N",09,2},;
  37.                {"paid    ","L",01,0} ;
  38.              }
  39. dbcreate("invoices",filestru_)
  40.  
  41. /* open the files, and throw in some default data */
  42. use vendors new
  43. index on vendors->vendid to vendors
  44. stufdata_ := { ;
  45.  {"000010","Ajax Supplies","P.O. Box 235","Concord","CA","94598"},;
  46.  {"000015","Wally's Pizza","1300 Clay Rd.",;
  47.            "Concord","CA","94521",1571.22,1255.98},;
  48.  {"100123","Aardvaark City","Bancroft & Main","Rodeo","CA","94310"} ;
  49. }
  50. for i := 1 to len(stufdata_)
  51.   append blank
  52.   for j := 1 to len(stufdata_[i])
  53.     fieldput(j,stufdata_[i,j])
  54.   next
  55.   commit
  56. next
  57. /* We'll set up a couple of invoices for vendor 000015 */
  58. use invoices new
  59. index on invoices->vendid+invoices->invoice to invoices
  60. stufdata_ := { ;
  61.  {"000015","102143","W00239",ctod("01/10/91"),315.24,.f.},;
  62.  {"000015","102144","W00100",ctod("02/14/91"),1255.98,.t.};
  63. }
  64. for i := 1 to len(stufdata_)
  65.   append blank
  66.   for j := 1 to len(stufdata_[i])
  67.     fieldput(j,stufdata_[i,j])
  68.   next
  69.   commit
  70. next
  71. /* Now let's browse these suckers! */
  72. Vendors()
  73. return nil
  74. * eof Main()
  75. * ==================================================== *
  76.  
  77. function Vendors()
  78. /* Called by  : Function Main()
  79.    Purpose    : Sets up call to Browser for Vendors.dbf
  80.    Parameters : None
  81.    Returns    : Nil
  82. */
  83. /* array fields_ contains the items to be browsed */
  84. local fields_ := { "vendors->vendid" ,;
  85.                    "vendors->name"   ,;
  86.                    "vendors->address",;
  87.                    "vendors->city"   ,;
  88.                    "vendors->state"  ,;
  89.                    "vendors->zip"  }
  90.  
  91. /* array heads_ contains the column headers for the browser */
  92. local heads_  := { "ID Key"      ,;
  93.                    "Vendor Name" ,;
  94.                    "Address"     ,;
  95.                    "City"        ,;
  96.                    "State"       ,;
  97.                    "Zip"     }
  98.  
  99. /* character var viewhead is the header to appear above the 
  100.    omnipresent data appearing in the viewbox.
  101.  
  102.    code block viewbox identifies the data to appear in the box
  103.    below the browse window
  104. */
  105. local viewhead := "YTD Purchases"+space(13)+"YTD Payments"+;
  106.                   space(3)+"(F10=View Invoices)"
  107. local viewbox  := { | | "$ "+trans(vendors->ytdpur,"###,###.##")+ ;
  108.                  space(14)+"$"+trans(vendors->ytdpay,"###,###.##") }
  109.  
  110. cls
  111. select vendors
  112. Browser(02,5,08,74,fields_,heads_,"VendAction",viewhead,viewbox)
  113. return nil
  114. * eof Vendors()
  115. * ==================================================== *
  116.  
  117. function VendAction(key)
  118. /* Called by  : Function Browser() (directed by Vendors() )
  119.    Purpose    : Hotkey handler for viewing vendor data.  Will
  120.                 set up the call to Browser() viewing Invoices.dbf.
  121.    Parameter  : key <expN> - last key hit by user in Browser()
  122.    Returns    : retval <expL> - determines whether to 
  123.                                 invoke brow:refreshAll()
  124. */
  125. local retval  := .f. ,;
  126.       fields_, heads_, keyfld, keydata
  127. if key == K_F10
  128.   /* these are the fields to appear in the browse window */
  129.   fields_ := { "invoices->invoice",;
  130.                "invoices->ponumber",;
  131.                "invoices->purdate",;
  132.                "invoices->amount",;
  133.                "iif(invoices->paid,'Paid   ','Pending')" ;
  134.              }
  135.   /* these are the column headers for the browse window */
  136.   heads_  := { "Invoice" ,;
  137.                "PO No."  ,;
  138.                "Purchased",;
  139.                "Amount"   ,;
  140.                "Status"    ;
  141.              }
  142.  
  143.   /* keyfld is the primary indexkey() value, and keydata is the
  144.      value we want to match in this next browse.
  145.   */
  146.   keyfld  := "vendid"
  147.   keydata := vendors->vendid
  148.  
  149.   /* notice that we don't want to display a viewbox with this browse,
  150.      so we just bypass those params in the Browser() call.
  151.   */
  152.  
  153.   select invoices
  154.   Browser(15,10,23,64,fields_,heads_,"InvAction",,,keyfld,keydata)
  155.   select vendors
  156. endif
  157. return retval
  158. * eof VendAction(key)
  159. * ==================================================== *
  160.  
  161. function InvAction(key)
  162. /* Called by  :  Function Browser() (directed by VendAction() )
  163.    Purpose    :  Hotkey handler for viewing Invoices.dbf
  164.    Parameter  :  key <expN> - last key pressed in Browser()
  165.    Returns    :  retval <expL> - directs brow:refreshAll()
  166. */
  167. local retval := .f. ,;
  168.       addone := (key == K_INS), ;
  169.       buffer, markrec := recno()
  170.  
  171. local mvendid, minvoice, mponumber, ;
  172.       mpurdate, mamount, mpaid, oldamount := 0.00
  173.  
  174. /* this is a random invoice number generator so you can add
  175.    unique invoices to this demo database
  176. */
  177. static invoicectr := 100145
  178.  
  179. if key == K_INS .or. ;
  180.    key == K_ENTER
  181.  
  182.    if addone
  183.      go lastrec() +1
  184.      mvendid   := vendors->vendid
  185.      minvoice  := str(++invoicectr,6)
  186.      mponumber := invoices->ponumber
  187.      mpurdate  := date()
  188.      mamount   := invoices->amount
  189.      mpaid     := .f.
  190.      go markrec
  191.    else
  192.      mvendid   := invoices->vendid
  193.      minvoice  := invoices->invoice
  194.      mponumber := invoices->ponumber
  195.      mpurdate  := invoices->purdate
  196.      mamount   := invoices->amount
  197.      oldamount := invoices->amount
  198.      mpaid     := invoices->paid
  199.    endif
  200.  
  201.    buffer := savescreen(18,10,20,64)
  202.    @ 18,10,20,64 box '╔═╗║╝═╚║ '
  203.    do while .t.
  204.      @ 19,14 say minvoice
  205.      @ 19,22 get mponumber picture "!#####"
  206.      @ 19,32 get mpurdate
  207.      @ 19,43 get mamount   picture "######.##"
  208.      @ 19,54 say iif(mpaid,"Paid   ","Pending")
  209.      read
  210.      if lastkey() == K_ESC
  211.        exit
  212.      endif
  213.      if addone
  214.        append blank
  215.      endif
  216.      replace invoices->vendid   with mvendid  ,;
  217.              invoices->invoice  with minvoice ,;
  218.              invoices->ponumber with mponumber,;
  219.              invoices->purdate  with mpurdate ,;
  220.              invoices->amount   with mamount  ,;
  221.              invoices->paid     with mpaid
  222.  
  223.      commit
  224.      select vendors
  225.      if addone
  226.        /* as long as we're putting the ytdpur field in
  227.           the vendors.dbf viewbox, we should keep the
  228.           values current.
  229.        */
  230.        vendors->ytdpur += mamount
  231.      else
  232.        vendors->ytdpur += (mamount - oldamount)
  233.      endif
  234.      commit
  235.      select invoices
  236.  
  237.      retval := .t.
  238.      exit
  239.    enddo while .t.
  240.    restscreen(18,10,20,64,buffer)
  241.  
  242. elseif key == K_DEL
  243.   delete
  244.   commit
  245.   /* just keeping the information current in the 
  246.      vendors.dbf -- keep your eye on the viewbox when
  247.      you leave the invoices.dbf browse!
  248.   */
  249.   select vendors
  250.   vendors->ytdpur -= invoices->amount
  251.   if invoices->paid
  252.     vendors->ytdpay -= invoices->amount
  253.   endif
  254.   commit
  255.   select invoices
  256.   skip -1
  257.   retval := .t.
  258. endif
  259. return retval
  260. * eof InvAction(key)
  261. * ==================================================== *
  262.  
  263. function Browser(t,l,b,r,fields_, heads_, keyfunc, ; 
  264.                  viewhead, viewbox, keyfld, keydata)
  265. /* Called by  : Functions Vendors() and VendAction()
  266.    Purpose    : Bare-bones browser for sake of this demo!
  267.    Parameters : t,l,b,r  <expN> - browse window params
  268.                 fields_  <expA> - fields to browse
  269.                 heads_   <expA> - column headers
  270.                 keyfunc  <expC> - name of hotkey handler func
  271.                 viewhead <expC> - header for viewbox
  272.                 viewbox  <expB> - code block of data for box
  273.                 keyfld   <expC> - key field(s) in indexkey()
  274.                 keydata  <expC> - data to be matched for a range
  275.    Returns    : Nil
  276. */
  277. /* Local vars:  "brow, col" <expO> are the browse and column objects.
  278.                 "key" <expN> is the user's keypress while browsing.
  279.                 "nokey" <expL> is the result of "seek keydata",
  280.                      where no match is found().
  281. */
  282. local brow, col, key := 0, i, nokey, ;
  283.       buffer := savescreen(0,0,24,79)
  284.  
  285. @ t,l,b,r box '╔═╗║╝═╚║ '
  286. /* if a box of always-viewable data is to appear with this browse,
  287.    draw a box for it and paint in the header.
  288. */
  289. if viewhead != NIL
  290.   @ b+2,l,b+5,r box '╔═╗║╝═╚║ '
  291.   @ b+3,l+1 say viewhead
  292. endif
  293.  
  294. /* set up the browse object */
  295. brow := TBrowseDB(t+1,l+1,b-1,r-1)
  296. brow:headSep = '═╤═'
  297. brow:colSep  = ' │ '
  298.  
  299. /* if a range of data is to be specified (e.g., "do while 
  300.    invoices->vendid = vendors->vendid"), we have to establish
  301.    the appropriate definitions for the browse movement blocks.
  302. */
  303. if keydata != NIL
  304.   brow:goTopBlock    := { | | GoTopBott(keydata,.t.) }
  305.   brow:goBottomBlock := { | | GoTopBott(keydata,.f.) }
  306.   brow:skipBlock     := { | move | Skipper(move, keyfld, keydata) }
  307. endif
  308.  
  309. /* now fill up the browse object with the columns defined by 
  310.    parameters "heads_" and "fields_" )
  311. */
  312. for i := 1 to len(fields_)
  313.   col := TBColumnNew(heads_[i], &("{ | | "+fields_[i]+"}") )
  314.   brow:AddColumn(col)
  315. next
  316.  
  317. /* here's where we determine if any data is available to meet the
  318.    browse criteria.
  319. */
  320. if keydata != NIL
  321.   seek keydata
  322.   nokey := !found()
  323. else
  324.   go top
  325.   nokey := ( eof() )
  326. endif
  327.  
  328. do while .t.
  329.  
  330.   do while ! brow:stabilize() .and. ( key := inkey() ) == 0
  331.   enddo
  332.  
  333.   /* if a box of data is to be kept current below the browse window,
  334.      this is where we do it.
  335.   */
  336.   if viewbox != NIL
  337.     @ b+4, l+1 say eval(viewbox)
  338.   endif
  339.  
  340.   if brow:stable
  341.     /* if no data in the browse matches the "seek keydata" criteria,
  342.        or if this is an empty database, we want to roll right into
  343.        insert mode and let the user start adding data.
  344.     */
  345.     if nokey
  346.       key := K_INS
  347.     else
  348.       key = inkey(0)
  349.     endif
  350.   endif
  351.  
  352.   do case
  353.     /* keeping it simple -- I didn't give you enough data to 
  354.        need more movement keys than these guys!
  355.     */
  356.     case key = K_UP
  357.        brow:up()
  358.     case key = K_DOWN
  359.        brow:down()
  360.     case key = K_LEFT
  361.        brow:left()
  362.     case key = K_RIGHT
  363.        brow:right()
  364.     case key = K_HOME
  365.        brow:goTop()
  366.     case key = K_END
  367.        brow:goBottom()
  368.     case key = K_ESC
  369.        exit
  370.   otherwise
  371.     /* If the user hit anything other than the keys in the case 
  372.        statement above, we'll let the keyfunc decide whether to
  373.        act upon it.  This way, the same browser can be used for
  374.        lots of different situations without having to modify the
  375.        basic function.
  376.     */
  377.     if keyfunc != NIL
  378.       /* The keyfunc must return a logical value.  Basically, if the
  379.          keypress resulted in activity that will change the content 
  380.          of the browse (edit, insert, delete), we want to refresh
  381.          the screen on the next brow:stabilize().  But we don't 
  382.          want to engage in a lot of gratuitous browser refreshing!
  383.       */
  384.       if eval(&( "{ | | " + (keyfunc) + "("+str(key,3)+") }" ) ,key)
  385.         brow:refreshAll()
  386.       endif
  387.     endif
  388.   endcase
  389.   /* if nokey was .t. when the loop started, or if the last key hit
  390.      was the delete key, we want to reevaluate the nokey situation,
  391.      and if it's *still* nokey, let's bail out of this browser.
  392.   */
  393.   if nokey .or. key == K_DEL
  394.     if keydata != NIL
  395.       seek keydata
  396.       nokey := !found()
  397.     else
  398.       go top
  399.       nokey := eof()
  400.     endif
  401.     if nokey
  402.       exit
  403.     endif
  404.   endif
  405. enddo while .t.
  406.  
  407. restscreen(0,0,24,79,buffer)
  408. return nil
  409. * eof Browser()
  410. * ==================================================== *
  411.  
  412. function GoTopBott(keydata,top)
  413. /* Called by  : Function Browser()
  414.    Purpose    : Responds to brow:goTopBlock and brow:goBottBlock
  415.    Parameters : keydata <expC> - indexkey() seek criteria
  416.                 top     <expL> - Is this brow:goTopBlock calling?
  417.    Returns    : Nil
  418. */
  419. local oldsoftseek := set(_SET_SOFTSEEK,.t.) ,;
  420.       trimmed, increment, seekdata
  421.  
  422. if top
  423.   seek keydata
  424. else
  425.   trimmed   := trim(keydata)
  426.   increment := chr(asc(subs(trimmed,len(trimmed)-1,1)) +1)
  427.   seekdata  := subs(trimmed,1,len(trimmed)-1) + increment
  428.   seek seekdata
  429.   skip -1
  430. endif
  431. set(_SET_SOFTSEEK,oldsoftseek)
  432. return nil
  433. * eof GoTopBott()
  434. * ==================================================== *
  435.  
  436. function Skipper(move,keyfld,keydata)
  437. /* Called by  : Function Browser()
  438.    Purpose    : Responds to brow:skipBlock
  439.    Parameters : move    <expN> - move how many?
  440.                 keyfld  <expC> - index key field
  441.                 keydata <expC> - seek criteria to match keyfld
  442.    Returns    : howmany <expN> - how many records actually moved?
  443. */
  444. local howmany := 0
  445. if move > 0 .and. ;
  446.   recno() != lastrec() +1
  447.  
  448.   do while howmany < move
  449.     skip +1
  450.     if !Moveabout(keyfld,keydata,.t.)
  451.       exit
  452.     endif
  453.     ++howmany
  454.   enddo
  455. elseif move < 0
  456.   do while howmany > move
  457.     skip -1
  458.     if !Moveabout(keyfld,keydata,.f.)
  459.       exit
  460.     endif
  461.     --howmany
  462.   enddo
  463. endif
  464. return howmany
  465. * eof Skipper()
  466. * ==================================================== *
  467.  
  468. function Moveabout(keyfld,keydata,skipahead)
  469. /* Called by  : Function Skipper()
  470.    Purpose    : Determines whether the new record position meets
  471.                 the criteria determined by keyfld and keydata
  472.    Parameters : keyfld <expC> - first key field in indexkey()
  473.                 keydata<expC> - value to match in the keyfld
  474.                 skipahead <expL> - are we going up (.t.), 
  475.                 or down (.f.)?
  476. */
  477. local fieldvalue, retval := .t.
  478. /* fieldvalue is the contents of the keyfld for the record we're
  479.    currently looking at.  To be compared to the keydata.
  480. */
  481. fieldvalue := eval(fieldblock(keyfld))
  482. if upper(fieldvalue) != upper(keydata) ;
  483.   .or. bof() .or. eof()
  484.   if Skipahead        // we were moving DOWN, have to back up one.
  485.     skip -1
  486.   else
  487.     if !bof()        // if we skipped into bof(), don't skip forward!
  488.       skip +1
  489.     endif
  490.   endif
  491.   retval := .f.
  492. endif
  493. return retval
  494. * eof MoveAbout()
  495. * ==================================================== *
  496.  
  497. * eop browdemo.prg
  498. * ------------------------------------------------------------------------ *
  499.