home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-386-Vol-2of3.iso / v / vtbdemo.zip / LPBROW5.PRG next >
Text File  |  1993-01-30  |  7KB  |  215 lines
  1. ********************************************************************
  2. * for those of us new to Clipper 5, I thought you might enjoy
  3. * seeing Grumpfish's utility-generated code for Tbrowsing
  4. * a .DBF
  5. * Structure of the .DBF is at bottom of this file
  6. * The Grumpfish utility VTBROW is available FREE with a
  7. * subscription the the Aquarium monthly disk-based newsletter
  8. * $ 159.00 per year
  9. ********************************************************************
  10. /*
  11.    Program: LPBROW5.PRG
  12.    Date:    01/30/93
  13.    Time:    12:03:29
  14.    Dialect: Clipper 5.01
  15.    Compile with: clipper LPBROW5 /n /w /a
  16.    Generated by THE VISIBLE TBROWSE
  17.    Copyright (c) 1991 Greg Lief
  18.       Grumpfish, Inc.
  19.       P. O. Box 17761
  20.       Salem, OR 97305
  21.       Tel 503.588.1815
  22.       Fax 503.588.1980
  23. */
  24.  
  25. #include "inkey.ch"
  26. #include "setcurs.ch"
  27.  
  28. function LPBROW5
  29. local b, c, oldcolor := setcolor(), key := 0
  30. local oldcurs := setcursor(0), oldscore := set(_SET_SCOREBOARD, .f.)
  31. local oldscrn := savescreen(0, 0, maxrow(), maxcol())
  32. local nrow, ncol     // for showing more arrows
  33. cls
  34. use louphone new
  35. b := TBrowseDB(2, 0, 21, 79)
  36. b:colorSpec := 'W/N,W+/R,GR+/B,GR+/R,N/W,R+/B,+W/N,+W/N,N/W,N/BG'
  37. b:headSep := '═╤═'
  38. b:colSep  := ' │ '
  39. b:footSep := '═╧═'
  40. c := TBColumnNew('Last Name', fieldblock('LNAME'))
  41. c:defColor := {9, 2}      /* default colors changed */
  42. c:colorBlock := { | x | {3, 2} }
  43. c:footing := 'Apellido'
  44. c:width := 25
  45. b:AddColumn( c )
  46. c := TBColumnNew('First Name', fieldblock('FNAME'))
  47. c:footing := 'Nombre'
  48. c:width := 25
  49. b:AddColumn( c )
  50. c := TBColumnNew('Title', fieldblock('TITLE'))
  51. c:footing := 'Cortesía'
  52. b:AddColumn( c )
  53. c := TBColumnNew('Company/Address 1', fieldblock('CO'))
  54. c:footing := 'Compañía/Dirección 1'
  55. b:AddColumn( c )
  56. c := TBColumnNew('Street/Address 2', fieldblock('STREET'))
  57. c:footing := 'Calle/Dirección 1'
  58. b:AddColumn( c )
  59. c := TBColumnNew('City', fieldblock('CITY'))
  60. c:footing := 'Ciudad'
  61. b:AddColumn( c )
  62. c := TBColumnNew('State', fieldblock('STATE'))
  63. c:footing := 'Estado'
  64. b:AddColumn( c )
  65. c := TBColumnNew('Zip Code', fieldblock('ZIP'))
  66. c:footing := 'Zona Postál'
  67. b:AddColumn( c )
  68. c := TBColumnNew('Telephone 1', fieldblock('TEL'))
  69. c:footing := 'Telefóno 1'
  70. b:AddColumn( c )
  71. c := TBColumnNew('Telephone 2', fieldblock('WORK'))
  72. c:footing := 'Telefóno 2'
  73. b:AddColumn( c )
  74. c := TBColumnNew('Note 1', fieldblock('MEMO'))
  75. c:footing := 'Nota 1'
  76. b:AddColumn( c )
  77. c := TBColumnNew('Note 2', fieldblock('MEMO2'))
  78. c:footing := 'Nota 2'
  79. b:AddColumn( c )
  80. c := TBColumnNew('Xmas;Card?', fieldblock('XMAS'))
  81. c:footing := '¿Carta de;Navidad?'
  82. b:AddColumn( c )
  83. c := TBColumnNew('Post;Card?', fieldblock('POSTCARD'))
  84. c:footing := '¿Tarjeta;Postál?'
  85. b:AddColumn( c )
  86. c := TBColumnNew('Birth;Date', fieldblock('BDAY'))
  87. c:footing := 'Fecha de;Nacimiento'
  88. b:AddColumn( c )
  89. c := TBColumnNew('Last;Updated', fieldblock('UPDATE'))
  90. c:footing := 'Ultima;Fecha'
  91. b:AddColumn( c )
  92. c := TBColumnNew('Memo Field;1 of 1', { | | '<memo>' } )
  93. c:footing := 'Descripción; 1 de 1'
  94. b:AddColumn( c )
  95. b:autoLite := .f.
  96. do while key != K_ESC
  97.    do while ! b:stabilize() .and. ( key := inkey() ) == 0
  98.    enddo
  99.    if b:stable
  100.       //───── save cursor location
  101.       nrow := row()
  102.       ncol := col()
  103.       //───── draw arrows if data off to left or right
  104.       //───── must take frozen columns into account
  105.       //───── note: dependent upon Clipper 5.01!
  106.       if b:leftvisible > b:freeze + 1
  107.          @ 22, 0 say chr(17) + chr(196) color 'N/BG'
  108.       else
  109.          @ 22, 0 say space(2)
  110.       endif
  111.       if b:rightvisible < b:colCount
  112.          @ 22, 78 say chr(196) + chr(16) color 'N/BG'
  113.       else
  114.          @ 22, 78 say space(2)
  115.       endif
  116.       setpos(nrow, ncol)
  117.       //──── highlight current row
  118.       b:colorRect( {b:rowPos, 1, b:rowPos, b:colCount}, { 9, 10 })
  119.       b:hiLite()         // highlight current cell
  120.       key := inkey(0)
  121.    endif
  122.    do case
  123.       case key == K_UP
  124.          b:refreshCurrent()   // remove highlight from current row
  125.          b:up()
  126.       case key == K_DOWN
  127.          b:refreshCurrent()   // remove highlight from current row
  128.          b:down()
  129.       case key == K_LEFT
  130.          b:left()
  131.       case key == K_RIGHT
  132.          b:right()
  133.       case key == K_PGDN
  134.          b:refreshCurrent()   // remove highlight from current row
  135.          b:pageDown()
  136.       case key == K_PGUP
  137.          b:refreshCurrent()   // remove highlight from current row
  138.          b:pageUp()
  139.       case key == K_CTRL_PGDN
  140.          b:refreshCurrent()   // remove highlight from current row
  141.          b:goBottom()
  142.       case key == K_CTRL_PGUP
  143.          b:refreshCurrent()   // remove highlight from current row
  144.          b:goTop()
  145.       case key == K_HOME
  146.          b:home()
  147.       case key == K_END
  148.          b:end()
  149.       case key == K_CTRL_HOME
  150.          b:panHome()
  151.       case key == K_CTRL_END
  152.          b:panEnd()
  153.       case key == K_CTRL_LEFT
  154.          b:panLeft()
  155.       case key == K_CTRL_RIGHT
  156.          b:panRight()
  157.       case key == K_ENTER   // edit current cell directly
  158.          editcell(b)
  159.          //──── force redisplay of current row
  160.          b:refreshCurrent()
  161.    endcase
  162. enddo
  163. setcursor(oldcurs)              // restore previous cursor
  164. set(_SET_SCOREBOARD, oldscore)  // restore previous SCOREBOARD
  165. setcolor(oldcolor)              // restore previous color
  166. restscreen(0, 0, maxrow(), maxcol(), oldscrn)
  167. use
  168. return nil
  169.  
  170. static function editcell(b)
  171. local c := b:getColumn(b:colPos)
  172. //──── set insert key to toggle both insert mode & cursor
  173. local oldins := setkey( K_INS, {|| setcursor( ;
  174.          if(readinsert(! readInsert()), SC_NORMAL, SC_INSERT))} )
  175.  
  176. //──── initial cursor setting based on current mode
  177. setcursor( if(readInsert(), SC_INSERT, SC_NORMAL) )
  178.  
  179. //──── create corresponding GET with GETNEW() and read it now
  180. readmodal( { getnew(Row(), Col(), c:block, c:heading,, b:colorSpec) } )
  181. setcursor(0)              // turn cursor back off
  182. setkey(K_INS, oldins)     // reset INS key
  183. return NIL
  184.  
  185. * eof: LPBROW5.PRG
  186. ** here is the structure of LOUPHONE.DBF **
  187. ** Louis Hemmi, CPA
  188. ** 309 Avondale
  189. ** Houston, Tx. 77006-3113
  190.  
  191. *  Structure for database : LOUPHONE.DBF
  192. *  Number of data records : 286
  193. *  Date of last update    : 1/24/93
  194. *  Field  Field Name  Type       Width    Dec
  195. *      1  LNAME       Character     30
  196. *      2  FNAME       Character     30
  197. *      3  TITLE       Character      8
  198. *      4  CO          Character     30
  199. *      5  STREET      Character     30
  200. *      6  CITY        Character     20
  201. *      7  STATE       Character      2
  202. *      8  ZIP         Character     10
  203. *      9  TEL         Character     21
  204. *     10  WORK        Character     21
  205. *     11  MEMO        Character     30
  206. *     12  MEMO2       Character     30
  207. *     13  XMAS        Logical        1
  208. *     14  POSTCARD    Logical        1
  209. *     15  BDAY        Date           8
  210. *     16  UPDATE      Date           8
  211. *     17  TEST        Memo          10
  212. *  ** Total **                     291
  213. *
  214. * enjoy *
  215.