home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / LIEF.ZIP / VISIT.PRG < prev   
Encoding:
Text File  |  1990-06-02  |  8.2 KB  |  288 lines
  1. *!******************************************************
  2. *!
  3. *!   Program: SpreadEm
  4. *!   Purpose: Pseudo-spreadsheet demonstrating
  5. *!            creative use of SAVESCREEN()
  6. *!   Author:  Greg Lief
  7. *!   Copyright (c) 1990 Greg Lief
  8. *!
  9. *!******************************************************
  10. #include "gkeys.ch"
  11. LOCAL fields := { "REP" }, heads := { "Sales Rep" }, ;
  12.       botrow, oldcolor, buffer, mrep, mrep_no, ;
  13.       key := 0, mrow := 4, mcol := 6, marray,  ;
  14.       oldcursor := SETCURSOR(0), oldscoreb := SET(_SET_SCOREBOARD, .F.)
  15. PRIVATE box_color
  16. box_color := "+W/RB"
  17. SETCOLOR(main_color := "N/BG")
  18. CLEAR
  19. IF ! FILE('visit.dbf')
  20.    marray := {}
  21.    AADD(marray, { "Rep_No",   "C", 2, 0 } )
  22.    AADD(marray, { "Date",     "D", 8, 0 } )
  23.    AADD(marray, { "Branch",   "C", 3, 0 } )
  24.    AADD(marray, { "Comments", "M", 10, 0 } )
  25.    DBCREATE('visit', marray)
  26. ENDIF
  27. USE visit NEW
  28. IF ! FILE('visit.ntx')
  29.    INDEX ON Rep_No + Branch + DTOS(Date) TO visit
  30. ELSE
  31.    SET INDEX TO visit
  32. ENDIF
  33. USE rep NEW
  34. IF ! FILE('rep.ntx')
  35.    INDEX ON Rep_No TO rep
  36. ELSE
  37.    SET INDEX TO rep
  38. ENDIF
  39. USE repbranc NEW
  40. IF ! FILE('repbranc.ntx')
  41.    INDEX ON Rep_No + Branch TO repbranc
  42. ELSE
  43.    SET INDEX TO repbranc
  44. ENDIF
  45. USE branch NEW
  46. IF ! FILE('branch.ntx')
  47.    INDEX ON Number TO branch
  48. ELSE
  49.    SET INDEX TO branch
  50. ENDIF
  51. SELECT rep
  52. GO TOP
  53. SETCOLOR(box_color)
  54. buffer = SAVESCREEN(6, 19, 18, 60)
  55. BOX2(6, 19, 18, 60)
  56. Center(18, '┤ ' + CHR(17) + CHR(217) + ;
  57.            ' to select, Esc to exit ├')
  58. DBEDIT(7, 20, 17, 59, fields, '', '', heads)
  59. RESTSCREEN(6, 19, 18, 60, buffer)
  60. SETCOLOR(main_color)
  61. mrep = TRIM(Rep)
  62. mrep_no = Rep_No
  63. SELECT repbranc
  64. SEEK mrep_no
  65. IF ! FOUND()
  66.    TONE(400,1)
  67.    TONE(400,1)
  68.    CENTER(12, "Sorry, no branches for " + mrep)
  69.    INKEY(0)
  70. ELSE
  71.    CLEAR
  72.    CENTER(1, "Branch visits for " + mrep)
  73.    @ 3, 6 SAY "JAN   FEB   MAR   APR   MAY   JUN   " + ;
  74.               "JUL   AUG   SEP   OCT   NOV   DEC"
  75.    DO WHILE repbranc->Rep_No == mrep_no
  76.       @ ROW()+1, 0 SAY Branch
  77.       SELECT visit
  78.       SEEK mrep_no + repbranc->Branch
  79.       IF FOUND()
  80.          DO WHILE Rep_No == mrep_no .AND. ;
  81.                   Branch == repbranc->Branch
  82.             @ ROW(), MONTH(date) * 6 SAY ;
  83.                      DAY(date) PICTURE "##"
  84.             SKIP
  85.          ENDDO
  86.       ENDIF
  87.       SELECT repbranc
  88.       SKIP
  89.    ENDDO
  90.    botrow = ROW()  && can't sink any lower than this
  91.    SELECT visit
  92.    *** begin keystroke trapping routine
  93.    DO WHILE key != ESC
  94.       ChangeColor(mrow, mcol, mrow, mcol + 2, 78)
  95.       key = INKEY(0)
  96.       ChangeColor(mrow, mcol, mrow, mcol + 2, 48)
  97.       DO CASE
  98.  
  99.          CASE key = LTARROW
  100.             mcol = IF(mcol = 0, 72, mcol - 6)
  101.  
  102.          CASE key = UPARROW .AND. botrow != 4
  103.             IF mrow = 4
  104.                mrow = botrow
  105.             ELSE
  106.                mrow--
  107.             ENDIF
  108.  
  109.          CASE key = DNARROW .AND. botrow != 4
  110.             IF mrow = botrow
  111.                mrow = 4
  112.             ELSE
  113.                mrow++
  114.             ENDIF
  115.  
  116.          CASE key = RTARROW
  117.             mcol = IF(mcol = 72, 0, mcol + 6)
  118.  
  119.          CASE key = CTRL_LEFT
  120.             mcol = 6
  121.  
  122.          CASE key = CTRL_RIGHT
  123.             mcol = 72
  124.  
  125.          CASE key = HOME
  126.             mcol = 6
  127.             mrow = 4
  128.  
  129.          CASE key = END
  130.             mcol = 72
  131.             mrow = botrow
  132.  
  133.          CASE key = PGUP
  134.             mrow = 4
  135.  
  136.          CASE key = PGDN
  137.             mrow = botrow
  138.  
  139.          CASE key = ENTER
  140.             *** derive branch number for this row
  141.             mbranch = ;
  142.              LEFT(SAVESCREEN(mrow, 0, mrow, 0), 1) + ;
  143.              LEFT(SAVESCREEN(mrow, 1, mrow, 1), 1) + ;
  144.              LEFT(SAVESCREEN(mrow, 2, mrow, 2), 1)
  145.             IF mcol = 0
  146.                Br_Info(mbranch)  && show branch information
  147.             ELSE
  148.                *** determine whether this spot is empty
  149.                *** (no visit) or not
  150.                mmonth = INT(mcol / 6)
  151.                mdate = ;
  152.                  LTRIM(LEFT(SAVESCREEN(mrow, mcol, ;
  153.                  mrow, mcol), 1) + ;
  154.                  LEFT(SAVESCREEN(mrow, mcol+1, mrow, ;
  155.                  mcol+1), 1))
  156.                IF EMPTY(mdate)
  157.                   oldcolor = SETCOLOR(box_color)
  158.                   *** derive default date based on this column
  159.                   mdate = CTOD(IF(mmonth < 10, '0', '') + ;
  160.                           LTRIM(STR(mmonth)) + '/01/' + ;
  161.                           SUBSTR(STR(YEAR(DATE()), 4), 3))
  162.                   *** force them to enter a date within this month
  163.                   tdate = CTOD("")
  164.                   DO WHILE MONTH(tdate) != mmonth ;
  165.                              .AND. LASTKEY() != ESC
  166.                      tdate = getdate(mdate)
  167.                   ENDDO
  168.                   IF LASTKEY() != ESC
  169.                      APPEND BLANK
  170.                      REPLACE date WITH tdate, ;
  171.                              rep_no WITH mrep_no, ;
  172.                              branch WITH mbranch
  173.                      Edit_Memo()
  174.                      @ mrow, mcol SAY DAY(date) PICTURE '##'
  175.                   ENDIF
  176.                ELSE
  177.                   *** locate this record in VISIT.dbf
  178.                   mdate = CTOD(IF(mmonth < 10, '0', '') + ;
  179.                           LTRIM(STR(mmonth)) + '/' + ;
  180.                           IF(VAL(mdate) < 10, '0', '') + ;
  181.                           mdate + '/' + ;
  182.                           SUBSTR(STR(YEAR(DATE()), 4), 3))
  183.                   SEEK mrep_no + mbranch + DTOS(mdate)
  184.                   Edit_Memo(NIL)
  185.                ENDIF
  186.             ENDIF
  187.       ENDCASE
  188.    ENDDO
  189. ENDIF
  190. SETCURSOR(oldcursor)
  191. SET(_SET_SCOREBOARD, oldscoreb)
  192. CLOSE DATA
  193. RETURN
  194.  
  195. *!******************************************************
  196. *!
  197. *!    FUNCTION: ChangeColor() - change color in desired
  198. *!                              desired screen buffer
  199. *!
  200. *!******************************************************
  201. FUNCTION ChangeColor(top, left, bottom, right, color)
  202. LOCAL buffer, ret_val, xx
  203. ret_val = ""
  204. buffer = SAVESCREEN(top, left, bottom, right)
  205. FOR xx = 1 TO LEN(buffer) STEP 2
  206.    ret_val = ret_val + SUBSTR(buffer, xx, 1) + CHR(color)
  207. NEXT
  208. RESTSCREEN(top, left, bottom, right, ret_val)
  209. RETURN NIL
  210.  
  211.  
  212. *!******************************************************
  213. *!
  214. *!    FUNCTION: Edit_Memo() - view/edit comments for
  215. *!                            each visit
  216. *!
  217. *!******************************************************
  218. PROCEDURE Edit_Memo(view_only)
  219. LOCAL oldcolor, buffer, mcomments
  220. view_only = (PCOUNT() = 1)
  221. oldcolor = SETCOLOR(box_color)
  222. buffer = SAVESCREEN(06, 13, 12, 66)
  223. BOX2(6, 13, 12, 66)
  224. Center(6, 'Comments for ' + DATEWORD(date))
  225. Center(12, "┤ " + ;
  226.            IF(! view_only, "Ctrl-W to save, ", "") + ;
  227.            "Esc to exit ├")
  228. IF view_only
  229.    MEMOEDIT(COMMENTS, 07, 14, 11, 65, .F.)
  230. ELSE
  231.    SETCURSOR(3)   && large block cursor
  232.    mcomments = MEMOEDIT(COMMENTS, 07, 14, 11, 65, ;
  233.                .T., 'Esc_Func' , '', 3)
  234.    SETCURSOR(0)
  235.    modified = (LASTKEY() <> ESC)
  236.    IF modified
  237.       REPLACE comments WITH mcomments
  238.    ELSE
  239.       INKEY(1)
  240.    ENDIF
  241. ENDIF
  242. SETCOLOR(oldcolor)
  243. RESTSCREEN(6, 13, 12, 66, buffer)
  244. RETURN
  245.  
  246.  
  247. *!******************************************************
  248. *!
  249. *!    FUNCTION: Esc_Func() - Handle ESC keypress
  250. *!                           in MEMOEDIT()
  251. *!
  252. *!******************************************************
  253. FUNCTION Esc_Func(status, line, column)
  254. IF LASTKEY() = ESC
  255.    SETCOLOR("+W/R")
  256.    BOX1(8, 26, 10, 53)
  257.    @ 09, 28 SAY "Edits Will Not Be Saved!"
  258. ENDIF
  259. RETURN 0
  260.  
  261.  
  262. *!******************************************************
  263. *!
  264. *!    FUNCTION: Br_Info() - Display Branch Information
  265. *!
  266. *!******************************************************
  267. FUNCTION Br_Info(mbranch)
  268. PRIVATE buffer, oldcolor
  269. oldcolor = SETCOLOR(box_color)
  270. buffer = SAVESCREEN(8, 21, 15, 58)
  271. BOX1(8, 21, 15, 58)
  272. SELECT branch
  273. SEEK mbranch
  274. CENTER(8, "Branch Number " + number)
  275. CENTER(15, "┤ Press any key ├")
  276. @  9, 23 SAY "Address: " + ADDRESS
  277. @ 10, 23 SAY "City: " + CITY
  278. @ 10, 47 SAY "St: " + STATE
  279. @ 11, 23 SAY "Zip: " + ZIP
  280. @ 12, 23 SAY "Phone: " + PHONE
  281. @ 13, 23 SAY "Fax:   " + FAX
  282. @ 14, 23 SAY "Contact: " + CONTACT
  283. INKEY(0)
  284. RESTSCREEN(8, 21, 15, 58, buffer)
  285. SETCOLOR(oldcolor)
  286. SELECT visit
  287. RETURN NIL
  288.