[futurebasic] Calendar Year On A Page

Message: < previous - next > : Reply : Subscribe : Cleanse
Home   : July 2001 : Group Archive : Group : All Groups

From: Ken Shmidheiser <k.shmidheiser@...>
Date: Sun, 29 Jul 2001 20:49:52 -0400
Here's a little app to create a entire calendar year on a page using
FB^3 Release 5. (I was playing with DYNAMIC arrays and this is what
came out of my brain fog!)

As always, comments, critiques, bug reports welcome

I really would like to have a quicker response when redrawing the
EDIT FIELDS. (I hoped Release 5 would be quicker in this, but I would
still like more speed. Any suggestions?)

For demo purposes, this app speaks the date when a day EDIT FIELD is
clicked. (This can get annoying but is easily killed by commenting
out the _efClick  routines.)

It would be nice to be able to click an EDIT FIELD, have a window
open, and store info for that day as do the commercial calendar
programs. Any suggestions on how to implement that?

Anyway, maybe this will help you to build a little calendar in your
apps, should you need one.

Best to you all.

Ken Shmidheiser
Somerset, KY
July 29, 2001

p.s. Please watch for e-mail line breaks. I try to make the code
lines short enough to fit without line breaks, but I usually manage
to miss a few. Also, the constant underscores will be lost on the
Associate server, but should make it through via the e-mail list.

'---------- BEGIN FB^3 Release 5 CODE ---------

// This code must be run under FB^3 Release 5 or higher
// By Ken Shmidheiser, Somerset, KY  July 29, 2001

INCLUDE "Tlbx Appearance.Incl"
INCLUDE "Tlbx SpeechSynthesis.Incl"

BEGIN GLOBALS
// Create two dynamic arrays to handle
// EDIT FIELD month and day information
DYNAMIC monthhead( _maxInt ) AS STR255
DYNAMIC   dayhead( _maxInt ) AS STR255
// We use "i" as a universal counter in FOR/NEXT loops
DIM             i            AS INTEGER
DIM         gQuit            AS BOOLEAN
END GLOBALS

// Fill monthhead array with names
// for corresponding EDIT FIELDS
monthhead( 601) = "January"
monthhead( 602) = "February"
monthhead( 603) = "March"
monthhead( 604) = "April"
monthhead( 605) = "May"
monthhead( 606) = "June"
monthhead( 607) = "July"
monthhead( 608) = "August"
monthhead( 609) = "September"
monthhead( 610) = "October"
monthhead( 611) = "November"
monthhead( 612) = "December"

// Set min and max parameters for little arrows
// Note: This does not affect fast search
// which we later set at 0
_yearMinVal = 1800
_yearMaxVal = 2200

// Standard ON BREAK routine
LOCAL FN Quit
gQuit = _zTrue
END FN

// A little About info window for Apple Menu
LOCAL Fn aboutWindow
AutoClip =  _false
DIM infoStr AS STR255
// Note "-" (minus sign) before _dialogMovable
// this works in conjunction with FN doMouse
WINDOW -2,"", ( 0,  0 )-( 250,160 ),- _dialogMovable
LONG COLOR 0, 0, 0,  _false
LONG COLOR 0, 0, 65535,  _zTrue
TEXT _sysFont, 12, 0,_srcCopy
EDIT FIEld -2,"",(20, 20 )-( 230,140 ), _statFramed, _centerJust
infoStr = CHR$(13) + CHR$(13) + "Calendar Year on a Page" + CHR$(13)¬
+"Ken Shmidheiser" + CHR$(13) + "July, 2001" + CHR$(13) + "Somerset, KY"
EDIT$(2) = infoStr
WINDOW 2
AutoClip =  _zTrue
END FN

// Build the Menu bar using FB^3
LOCAL FN buildMenus
APPLE MENU "About Calendar Year on a Page..."
MENU 1,0,_enable, "File"
MENU 1,1,_disable, "-"
MENU 1,2,_enable, "Quit/Q"
EDIT MENU 2
END FN

/*
The following five functions build information
for the calendar array. In this example we but the
information into the BUTTON title array.
*/
LOCAL FN daysPerMonth( month AS INT, year AS INT )
DIM days AS INTEGER
SELECT month
CASE  1 : days = 31
CASE  2 : days = 28
CASE  3 : days = 31
CASE  4 : days = 30
CASE  5 : days = 31
CASE  6 : days = 30
CASE  7 : days = 31
CASE  8 : days = 31
CASE  9 : days = 30
CASE 10 : days = 31
CASE 11 : days = 30
CASE 12 : days = 31
END SELECT
// Check for leap years; modify leap year February
LONG IF (year MOD 4 = 0 AND (year MOD 100 <> 0 OR year MOD 400 = 0))
IF month = 2 THEN days = 29
END IF
END FN = days

/*
   Calculates which day of the week any given day in any
given year falls on.
*/
LOCAL FN calcWeekday( month AS INT, day AS INT, year AS INT )
DIM AS LONG    t1,t2,t3,Julian
DIM AS INTEGER weekDay
// Calculate Julian date
LONG IF month > 2
month = month - 3
XELSE
month = month + 9
year  = year  - 1
END IF
t1 = ( 146097 * (year /100) )   / 4
t2 = (   1461 * (year MOD 100)) / 4
t3 = (    153 *  month + 2 )    / 5 + day + 1721119
Julian        = t1 + t2 + t3
weekDay       = Julian MOD 7 + 2
// Day one = Sunday to day 7 = Saturday
IF weekDay    > 7 THEN weekDay = 1
END FN = weekDay

/*
Simple function to translate a month value
into a string.
*/
LOCAL FN getMonth$( month AS INTEGER )
DIM monthStr AS STR255
SELECT month
CASE 1  : monthStr = "January"
CASE 2  : monthStr = "February"
CASE 3  : monthStr = "March"
CASE 4  : monthStr = "April"
CASE 5  : monthStr = "May"
CASE 6  : monthStr = "June"
CASE 7  : monthStr = "July"
CASE 8  : monthStr = "August"
CASE 9  : monthStr = "September"
CASE 10 : monthStr = "October"
CASE 11 : monthStr = "November"
CASE 12 : monthStr = "December"
END SELECT
END FN = monthStr

/*
   This function, similar to the above but for days
is not used, but I have left if in for reference.
*/
LOCAL FN getDay$( day AS INTEGER )
DIM dayStr AS STR255
SELECT day
CASE 1 : dayStr = "Sunday"
CASE 2 : dayStr = "Monday"
CASE 3 : dayStr = "Tuesday"
CASE 4 : dayStr = "Wednesday"
CASE 5 : dayStr = "Thursday"
CASE 6 : dayStr = "Friday"
CASE 7 : dayStr = "Saturday"
END SELECT
END FN = dayStr

/*
   This function calls data from above functions
and builds the date array, in this case for
EDIT FIELDS.
*/
LOCAL FN buildCalendar( month AS INT, year AS INT, id AS INT )
DIM AS INTEGER daysInMonth, startDay, day
DIM AS STR255  dayStr, dayOfMonthStr, monthStr
daysInMonth = FN daysPerMonth( month,year )
startDay    = FN calcWeekday ( month,1,year )
monthStr    = FN getMonth$   ( month )
day = 1
FOR i = 1 TO 42
LONG IF i => startDay AND day <= daysInMonth
dayOfMonthStr = RIGHT$(STR$( day ),LEN(STR$( day )) -1)
LONG IF(i MOD 7 = 0 OR i MOD 7 = 1)
// Is day Sat or Sun? Do weekend formatting here
END IF
EDIT$( id + (i - 1)) = dayOfMonthStr
INC( day )
END IF
NEXT i
END FN

LOCAL FN clearEditFields
for i = 1 TO 512
EDIT$(i) = ""
NEXT i
END FN

/*
   Steve VavVoorst's classic grid builder function
   here modified for EDIT FIELDS under FB^3 Release 5.

    Input parameters include:
     id%  Number of first item in the series
      l%  Left starting point of first grid item
      t%  Top starting point of first grid item
      w%  Width of grid items
      h%  Height of grid items
    col%  Number of columns in grid
    row%  Number of rows in grid
     vg%  Vertical gutter spacing between grid items
     hg%  Horizontal grid spacing between grid items

     fr%  EF frame type
           1 = _framedNoCR
           2 = _framed
           3 = _noFramedNoCR
           4 = _noFramed
           5 = _statFramed
           7 = _statNoFramed
           9 = _statFramedGray
          11 = _statNoFramedGray
          13 = _statFramedInvert
          15 = _statNoFramedInvert
          29 = _statFramedInvert+_hilite
          31 = _statNoFramedInvert+_hilite
          32 = _round
          64 = _rounder
          66 = _roundest
         128 = _boldBox

     ju%  EF justification
           0 = _rightJust
           1 = _leftJust
           2 = _centerJust
           3 = _rightJust

Note: This functions produces an FB^3 Release 5 compiler warning
       that can safely be ignored (trust me!).
*/
LOCAL FN gridMaker( id%, l%, t%, w%, h%, col%, row%, vg%, hg%, fr%, ju%  )
DIM AS INT j, k, left, top
DIM inputRect as rect
FOR k = 0 TO row% - 1
FOR j = 0 TO col% - 1
left = l% + j * ( w% + vg% )
top  = t% + k * ( h% + hg% )
CALL SETRECT( inputRect, left, top, left + w%, top + h% )
EDIT FIELD -(id%), "", @inputRect, fr%, ju%
INC( id% )
NEXT j
NEXT k
END FN

// Fills month header EDIT FIELDs with monthhead array data
LOCAL FN buildMonthHeads
DIM monthHeadStr AS STR255
FOR i = 601 To 612
EDIT$(i) = monthhead( i )
NEXT i
KILL DYNAMIC monthhead
END FN

// Fills day header EDIT FIELDs with abbreviated titles
LOCAL FN buildDayHeads( id AS INt )
dayhead( id     ) = "Su"
dayhead( id + 1 ) = "Mo"
dayhead( id + 2 ) = "Tu"
dayhead( id + 3 ) = "We"
dayhead( id + 4 ) = "Th"
dayhead( id + 5 ) = "Fr"
dayhead( id + 6 ) = "Sa"
FOR i = id To id + 7
EDIT$( i ) = dayhead( i )
NEXT i
END FN

// Fills each month's day heades with titles from above
LOCAL FN addHeads
AUTOCLIP = _false
FN buildDayHeads( 701 )
FN buildDayHeads( 708 )
FN buildDayHeads( 715 )
FN buildDayHeads( 722 )
FN buildDayHeads( 729 )
FN buildDayHeads( 736 )
FN buildDayHeads( 743 )
FN buildDayHeads( 750 )
FN buildDayHeads( 757 )
FN buildDayHeads( 764 )
FN buildDayHeads( 771 )
FN buildDayHeads( 778 )
KILL DYNAMIC dayhead
TEXT _applFont, 9
EDIT FIELD 0
AUTOCLIP = _zTrue
END FN

/*
   Robert Purves' function to allow proper control
of Appearance little arrows
*/
local fn SetSmallArrows( id, min, max, initial )
DIM bH as handle
bH = button&( id )
long if bH
call SetControlMinimum( bH, min )
call SetControlMaximum( bH, max )
call SetControlValue  ( bH, max + min - initial )
end if
end fn

/*
   Used at program launch to make current year the default
calendar.
*/
LOCAL FN setCurrentArrowEFDates
DIM dateRec.14
DIM month AS INT
DIM year  AS INT
CALL SECS2DATE([_Time], @dateRec)
year = dateRec.year%
EDIT$( 801 ) = STR$(year)
END FN

// Builds grid of 42 EDIT FIELDs ( 7 colums by 6 rows )
// for each of the 12 calendar months
LOCAL FN dayGrid
FN gridMaker(   1,  10,  60, 19, 14, 7, 6, 1, 1, 1, 2 )'January
FN gridMaker(  43, 160,  60, 19, 14, 7, 6, 1, 1, 1, 2 )'February
FN gridMaker(  85, 310,  60, 19, 14, 7, 6, 1, 1, 1, 2 )'March
FN gridMaker( 127, 460,  60, 19, 14, 7, 6, 1, 1, 1, 2 )'April

FN gridMaker( 169,  10, 190, 19, 14, 7, 6, 1, 1, 1, 2 )'May
FN gridMaker( 211, 160, 190, 19, 14, 7, 6, 1, 1, 1, 2 )'June
FN gridMaker( 253, 310, 190, 19, 14, 7, 6, 1, 1, 1, 2 )'July
FN gridMaker( 295, 460, 190, 19, 14, 7, 6, 1, 1, 1, 2 )'August

FN gridMaker( 337,  10, 320, 19, 14, 7, 6, 1, 1, 1, 2 )'September
FN gridMaker( 379, 160, 320, 19, 14, 7, 6, 1, 1, 1, 2 )'October
FN gridMaker( 421, 310, 320, 19, 14, 7, 6, 1, 1, 1, 2 )'November
FN gridMaker( 463, 460, 320, 19, 14, 7, 6, 1, 1, 1, 2 )'December
END FN

// Creates main window
LOCAL FN buildWindow
DIM wndPtr  AS POINTER
DIM dateRec.14
DIM theYear AS INTEGER
DIM fastStr AS STR255
DIM err     AS SHORT
DIM cRect   AS RECT

CALL SECS2DATE([_Time], @dateRec)
theYear = dateRec.year%

WINDOW-1,"Calendar Year On  A Page",(0,0)-(610,465),_docNoGrow
AUTOCLIP = _false
TEXT _applFont, 9
EDIT = 1

FN dayGrid

EDIT FIELD 900,STR$( theYear),( 150, 437 )-( 180, 451), _framedNoCR, _leftJust

wndPtr = WINDOW(_wndPointer) : IF wndPtr = _nil THEN EXIT FN
err    = FN SetThemeWindowBackground(wndPtr, 1, _zTrue)

fastStr = "Fast search: Enter year and press return"
EDIT FIELD 901,fastStr,( 10, 432 )-( 140, 456), _statNoFramed, _rightJust

FN gridMaker( 601,  10,  31, 140, 15, 4, 3, 10, 115, 7, 2 )
FN buildMonthHeads

FN gridMaker( 701,  10,  45, 20, 12, 7, 1, 0, 0, 7, 2 )'January
FN gridMaker( 708, 160,  45, 20, 12, 7, 1, 0, 0, 7, 2 )'February
FN gridMaker( 715, 310,  45, 20, 12, 7, 1, 0, 0, 7, 2 )'March
FN gridMaker( 722, 460,  45, 20, 12, 7, 1, 0, 0, 7, 2 )'April

FN gridMaker( 729, 460, 175, 20, 12, 7, 1, 0, 0, 7, 2 )'May
FN gridMaker( 736,  10, 175, 20, 12, 7, 1, 0, 0, 7, 2 )'June
FN gridMaker( 743, 160, 175, 20, 12, 7, 1, 0, 0, 7, 2 )'July
FN gridMaker( 750, 310, 175, 20, 12, 7, 1, 0, 0, 7, 2 )'August

FN gridMaker( 757, 460, 305, 20, 12, 7, 1, 0, 0, 7, 2 )'September
FN gridMaker( 764,  10, 305, 20, 12, 7, 1, 0, 0, 7, 2 )'October
FN gridMaker( 771, 160, 305, 20, 12, 7, 1, 0, 0, 7, 2 )'November
FN gridMaker( 778, 310, 305, 20, 12, 7, 1, 0, 0, 7, 2 )'December

CALL SetRect( cRect, 0, 22, 610, 26 )
err = FN NewControl( wndPtr,cRect,"", _zTrue,0,0,0,¬
_kControlSeparatorLineProc,0 )

CALL SetRect( cRect, 0, 422, 610, 426 )
err = FN NewControl( wndPtr,cRect,"", _zTrue,0,0,0,¬
_kControlSeparatorLineProc,0 )

Text _sysFont, 12
EDIT FIELD -800,"", (   0,   5 )-( 610,  20 ), _statNoFramed, _centerJust
BUTTON 1,1,"Quit",  ( 540, 434 )-( 600, 454 ), 41
TEXT _applFont, 9
BUTTON 60, 1,"",    ( 500, 432 )-( 530, 456 ),  96 + 1'little arrows
EDIT FIELD -801,"", ( 461, 437 )-( 494, 450 ), _statFramed, _centerJust

FN SetSmallArrows( 60, _yearMinVal,  _yearMaxVal, theYear )

AUTOCLIP = _zTrue
WINDOW 1
END FN

/*
   This function builds an array for each month,
and puts date in respective EDIT FIELD.
*/
LOCAL FN buildYear( year AS INTEGER )
AUTOCLIP = _false
EDIT$(800) = STR$( year )
FN clearEditFields
FN dayGrid
FN buildCalendar(  1, year,   1 )
FN buildCalendar(  2, year,  43 )
FN buildCalendar(  3, year,  85 )
FN buildCalendar(  4, year, 127 )
FN buildCalendar(  5, year, 169 )
FN buildCalendar(  6, year, 211 )
FN buildCalendar(  7, year, 253 )
FN buildCalendar(  8, year, 295 )
FN buildCalendar(  9, year, 337 )
FN buildCalendar( 10, year, 379 )
FN buildCalendar( 11, year, 421 )
FN buildCalendar( 12, year, 463 )
AUTOCLIP = _zTrue
TEXT _applFont, 9
EDIT FIELD 0
END FN

/*
   This function creates the opening calendar
based on your computer's current date and time
*/
LOCAL FN createInitialCalendar
DIM dateRec.14
DIM as STR255 monthstr
DIM AS INT    month, year
CALL SECS2DATE( [_Time], @dateRec )
year  = dateRec.year%
EDIT$(801) = STR$( year )
FN buildYear( year )
TEXT _applFont, 9
EDIT FIELD 0
END FN

// Little arrow handler
local fn getSmallArrowsVal( id, ef )
DIM bH      as handle
DIM currVal as LONG
bH = button&( id )
long if bH
currVal = fn GetControlMaximum( bH ) + ¬
fn GetControlMinimum( bH ) - fn GetControlValue( bH )
EDIT$(ef) = STR$( currVal )
xelse
currVal = 0
EDIT$(ef) = STR$( currVal )
end if
end fn = currVal

/*
   The following three functions allow each
BUTTON name string to be spoken when clicked.

   The first function from Staz checks to see
if Speech Manager is installed on the machine.
*/
LOCAL FN hasSpeechMgr
DIM @speechAttr&
END FN = (FN GESTALT (_"ttsc", speechAttr&) = _noErr)

/*
   Enabling Staz's WHILE/WEND loop will allow each speech
string to be spoken without interruption. However, I found
in this demo that that slows things down too much, and I
don't mind hearing the strings overspoken. (My kids
do it all the time.)
*/
LOCAL FN speakEF( dayStr AS STR255 )
long if fn SpeechManagerVersion => 0
DIM err     AS SHORT
DIM monStr  AS STR255
DIM yearStr AS STR255
DIM outStr  AS STR255

SELECT WINDOW( _efNum )
CASE <=  42 : monStr = "January"
CASE <=  84 : monStr = "February"
CASE <= 126 : monStr = "March"
CASE <= 168 : monStr = "April"
CASE <= 210 : monStr = "May"
CASE <= 252 : monStr = "June"
CASE <= 294 : monStr = "July
CASE <= 336 : monStr = "August"
CASE <= 378 : monStr = "September"
CASE <= 420 : monStr = "October"
CASE <= 462 : monStr = "November"
CASE <= 503 : monStr = "December"
END SELECT

yearStr = EDIT$( 800 )
outStr = monStr + dayStr + yearStr

LONG IF FN hasSpeechMgr
err = FN SpeakString( monStr )
WHILE FN SpeechBusy
WEND
err = FN SpeakString( dayStr )
WHILE FN SpeechBusy
WEND
err = FN SpeakString( yearStr )
WHILE FN SpeechBusy
WEND
XELSE
// Warn with BEEP if no Speech Manager
BEEP
END IF

END IF
END FN

// If EDIT FIELD contains a date, the date is spoken
// otherwise nothing happens
LOCAL FN doEFs( id )
DIM dayStr AS STR255
DIM err    AS SHORT
dayStr = EDIT$( id )
LONG IF dayStr = ""
XELSE
FN speakEF( dayStr )
END IF
END FN

// Bypasses the little arrows and directly initiates
// search for year input in Fast Search EDIT FIELD
LOCAL FN fastSearch
DIM search AS INTEGER
search = VAL( EDIT$(900))
LONG IF search > 0
FN buildYear( search )
XELSE
BEEP
END IF
EDIT$(900) = STR$( search )
EDIT FIELD 900
END FN

// Standard FB^3 dialog handler
LOCAL FN doDialog
DIM AS INTEGER evnt,id
DIM AS STR255  activateStr
evnt = DIALOG(0)
id = DIALOG(evnt)
SELECT CASE( evnt )
CASE _wndClose
SELECT( id )
CASE 1 : END
END SELECT
CASE _btnClick
SELECT( id )
CASE 1 : END
CASE 60
FN getSmallArrowsVal( id, 801 )
FN buildYear( VAL( EDIT$( 801 ) ) )
EDIT$(900) = EDIT$( 801 )
TEXT _applFont, 9
EDIt FIELD 0
END SELECT
CASE _wndRefresh
SELECT( id )
CASE 1
AutoClip =  _false
activateStr = EDIT$(801)
EDIT$(801) = activateStr
AutoClip =  _zTrue
END SELECT
CASE _efClick
TEXT _applFont, 9
SELECT( id )
IF id =< 504 THEN FN doEFs( id )
END SELECT
CASE _efReturn
TEXT _applFont, 9
SELECT( id )
CASE 900
FN fastSearch
EDIt FIELD 0
CASE =< 504 : FN doEFs( id )
END SELECT
CASE _eftab, _efUpArrow
SELECT( id )
IF id =< 503 THEN EDIT FIELD( id + 1) ELSE EDIT FIELD 1
END SELECT
CASE _efShiftTab, _efDownArrow
SELECT( id )
IF id = 1 THEN EDIT FIELD 504 ELSE EDIT FIELD( id - 1)
END SELECT
END SELECT
END FN

// Standard FB^3 menu handler
LOCAL FN doMenu
DIM AS INTEGER menuID,itemID
menuID = MENU(_menuID)
itemID = MENU(_itemID)
SELECT CASE( menuID )
CASE _applemenu
SELECT( itemID )
CASE 1
Fn aboutWindow
END SELECT
CASE 1
SELECT( itemID )
CASE 2
END
END SELECT
END SELECT
MENU
END FN

// ON MOUSE handler closes
// About window with a mouse click
LOCAL FN doMouse
DIM msEvnt AS INTEGER
msEvnt = MOUSE (0)
LONG IF ABS(msEvnt) = _click1
WINDOW CLOSE 2
XELSE
BEEP
END IF
END FN

ON DIALOG FN doDialog
ON MENU   FN doMenu
ON MOUSE  FN doMouse
ON BREAK  FN Quit

FN buildMenus
FN buildWindow
FN addHeads
FN createInitialCalendar

DO
HANDLEEVENTS
UNTIL gQuit
END

'---------- END  CODE ---------