home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a067 / 1.img / GRUMP501.EXE / CALENDAR.PRG < prev    next >
Encoding:
Text File  |  1991-04-29  |  4.5 KB  |  148 lines
  1. /*
  2.   Program: CALENDAR.PRG
  3.   System: GRUMPFISH LIBRARY
  4.   Author: Greg Lief
  5.   Copyright (c) 1988-90, Greg Lief
  6.   Clipper 5.0 Version
  7.   Compile instructions: clipper calendar /n/w/a
  8.  
  9.   Procs & Fncts: CALENDBOX()
  10.                : NEXTMONTH()
  11.  
  12.   NOT FOR USE AS STAND-ALONE!!  CALLED BY GETDATE() and POPDATE
  13. */
  14.  
  15. /*
  16.    Function: CALENDBOX
  17.  
  18.    Called by: POPDATE      (procedure in POPDATE.PRG)
  19.               GETDATE()    (function  in GETDATE.PRG)
  20.  
  21.    Notes: Returns an array of row/col coordinates for the first,
  22.           last, current, and system dates
  23. */
  24.  
  25. //───── begin preprocessor directives
  26.  
  27. #include "grump.ch"
  28.  
  29. //───── end preprocessor directives
  30.  
  31. function calendbox(usingappts, ntop, nleft, curr_date, maincolor, firstloop)
  32. static calendscrn
  33. local hasappts, datecoords[10], gotlastday, datehead, tdate, tmonth, row := 5
  34. default firstloop to .f.
  35. if firstloop
  36.    ColorSet(maincolor)
  37.    shadowbox(ntop, nleft, ntop+12, nleft+21, 1)
  38.    @ ntop +  3, nleft +  1 ssay "Su Mo Tu We Th Fr Sa"
  39.    @ ntop +  1, nleft + 21 ssay "║"
  40.    @ ntop +  2, nleft      ssay "╠" + replicate("═",20) + "╣"
  41.    @ ntop +  4, nleft      ssay "╠" + replicate("═",20) + "╣"
  42.    @ ntop + 12, nleft      ssay "╚" + replicate("═",20) + "╝"
  43.    calendscrn := savescreen(ntop, nleft, ntop+13, nleft+23)
  44. else
  45.    restscreen(ntop, nleft, ntop+13, nleft+23, calendscrn)
  46. endif
  47. setcolor('+' + maincolor)
  48. datehead := gfmonth(curr_date) + ' ' + str(year(curr_date), 4)
  49. if len(datehead) < 14
  50.    datehead := space((14 - len(datehead)) / 2) + datehead + ;
  51.                space((14 - len(datehead)) / 2 + 1)
  52. endif
  53. @ ntop + 1, nleft + 4 ssay datehead
  54. tdate := curr_date
  55. tdate := stod(substr(dtos(tdate), 1, 6) + '01')  && 1st day of month
  56. tmonth := month(tdate)
  57. gotlastday := .f.   // flag for storing coordinates of last day of month
  58. CURRENTAPPTS := .f.
  59. do while .t.
  60.    hasappts := .f.  // flag for whether a date should be shown in inverse
  61.    // test for new week
  62.    if (day(tdate) > 1 .or. month(tdate) != tmonth) .and. dow(tdate) = 1
  63.       row++
  64.    endif
  65.    if row > 11
  66.       exit
  67.    endif
  68.    // no need to seek for appointments for current date unless we are
  69.    // using the appointment tracker
  70.    if usingappts
  71.       seek dtos(tdate)
  72.       if found()
  73.          hasappts := .t.
  74.          // set flag true if this date is the current date
  75.          // so that we know to display its appts in draw_appts
  76.          CURRENTAPPTS := if(tdate = curr_date, .t., CURRENTAPPTS)
  77.       endif
  78.    endif
  79.    do case
  80.       case usingappts .and. hasappts
  81.          setcolor(if(tdate = curr_date, '*n/w', 'i'))
  82.       case month(tdate) = month(curr_date)
  83.          setcolor(if(tdate = curr_date, '*', '') + '+' + maincolor)
  84.       otherwise
  85.          ColorSet(maincolor)
  86.    endcase
  87.    @ ntop+row, nleft + (dow(tdate) - 1) * 3 + 1 ssay str(day(tdate), 2)
  88.    do case
  89.       // first day of month
  90.    case day(tdate) = 1 .and. month(tdate) = tmonth
  91.       FIRSTDAY_ROW := row()
  92.       FIRSTDAY_COL := col()-2
  93.       * last day of month
  94.    case month(tdate + 1) != tmonth  .and. ! gotlastday
  95.       LASTDAY_ROW := row()
  96.       LASTDAY_COL := col()-2
  97.       LASTDAY_NUMBER := day(tdate)
  98.       gotlastday := .t.
  99.    endcase
  100.    // current day
  101.    if tdate = curr_date
  102.       CURRENTDAY_ROW := row()
  103.       CURRENTDAY_COL := col()-2
  104.    endif
  105.    // system date
  106.    if tdate = date()
  107.       SYSTEMDATE_ROW := row()
  108.       SYSTEMDATE_COL := col()-2
  109.    endif
  110.    tdate++     // increment date counter
  111. enddo
  112. ColorSet(maincolor)
  113. return datecoords
  114.  
  115. * end function CalendBox()
  116. *--------------------------------------------------------------------*
  117.  
  118.  
  119. /*
  120.    Function: NEXTMONTH()
  121.  
  122.    Called by: GETDATE()
  123.             : POPDATE        (procedure in POPDATE.PRG)
  124.             : RECURRING      (procedure in POPDATE.PRG)
  125. */
  126. function nextmonth(origdate)
  127. //───── check for validity of date when skipping forward one month
  128. //───── i.e., cannot go from march 31 to april 31, etcetera
  129. local ret_val
  130. ret_val := ctod('')
  131. if month(origdate) = 12    // going to January of next year
  132.    ret_val := stod(str(val(substr(dtos(origdate), 1, 4)) + 1, 4) + '01' + ;
  133.               substr(dtos(origdate), 7))
  134. else
  135.    do while empty(ret_val)
  136.       ret_val := stod(substr(dtos(origdate), 1, 4) + ;
  137.                  if(month(origdate) < 9, '0', '') + ;
  138.                  ltrim(str(month(origdate) + 1)) + substr(dtos(origdate), 7))
  139.       origdate--
  140.    enddo
  141. endif
  142. return (ret_val)
  143.  
  144. * end function NextMonth()
  145. *--------------------------------------------------------------------*
  146.  
  147. * eof calendar.prg
  148.