A simple month calendar

[xProgrammer]

work in progress but now has slightly neater code and code to increment by any number of months (forward or backwards) and the same for years. That code looks slightly complicated but its to allow for leap years.

MoveYears( iIncrement), it has just occurred to me, could be implemented as:

Code: Select all

METHOD MoveYears( iIncrement ) CLASS CALENDAR

   ::MoveNonths( iIncrement * 12 )

RETURN nil 

MoveMonths() could be implemented in a simpler manner if you don't want to allow maintining a highlight on a certain day of the month as a possibility.

Here is the code (dirty) as it stands:

Code: Select all

// Calendar.prg

#include "FiveLinuxDF.ch"
#include "hbclass.ch"

#define GTK_NORMAL 0
#define GTK_ACTIVE   1
#define GTK_PRELIGHT 2
#define GTK_SELECTED 3
#define GTK_INSENSITIVE 4

CLASS CALENDAR

DATA aDATEBUTTONS
DATA aDOW
DATA dAnchorDate
DATA iStartOfMonth
DATA iEndOfMonth
DATA grp_CALENDAR

METHOD New() CONSTRUCTOR
METHOD Show()
METHOD SetButtons()
METHOD SetAnchorDate( dDate )
METHOD MoveMonths( iIncrement )
METHOD MoveYears( iIncrement )

ENDCLASS

METHOD New() CLASS CALENDAR

::SetAnchorDate( DATE() )
::aDATEBUTTONS := ARRAY( 37 )
::aDOW := { "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat" }

Return self


METHOD Show() CLASS CALENDAR

LOCAL dlg_CALENDAR
LOCAL sTitle
LOCAL ii
LOCAL oBtn

sTitle := "Calendar"
DEFINE DIALOG dlg_CALENDAR TITLE sTitle SIZE 400, 500

@ 90, 10 GROUP ::grp_CALENDAR LABEL "Calendar" OF dlg_CALENDAR SIZE 370, 250 PIXEL
iRow := 120
iCol = 20
FOR ii = -6 TO 37
   IF ii > 0
      @ iRow, iCol BUTTON ::aDATEBUTTONS[ii] PROMPT "Test" OF dlg_CALENDAR PIXEL SIZE 40, 25 NORMAL "aquamarine" PRELIGHT "medium aquamarine"
     ELSE
      @ iRow, iCol BUTTON oBtn PROMPT ::aDOW[ii + 7] OF dlg_CALENDAR PIXEL SIZE 40, 25 WHEN .F. 
      oBtn:SetBackgroundColor( "yellow", GTK_INSENSITIVE )    
   ENDIF
   iCol += 50
   IF iCol > 330
      iRow += 30
      iCol := 20
   ENDIF
NEXT

@360, 10 BUTTON "Previous Month" OF dlg_CALENDAR PIXEL SIZE 120, 27 ACTION ::MoveMonths( -1 )
@360,250 BUTTON "Following Month" OF dlg_CALENDAR PIXEL SIZE 120, 27 ACTION ::MoveMonths( 1 )
@400, 10 BUTTON "Previous Year"  OF dlg_CALENDAR PIXEL SIZE 120, 27 ACTION ::MoveYears( -1 )
@400,250 BUTTON "Following Year"  OF dlg_CALENDAR PIXEL SIZE 120, 27 ACTION ::MoveYears( 1 )

ACTIVATE DIALOG dlg_CALENDAR ON INIT ::SetButtons() 

RETURN nil


METHOD SetButtons() CLASS CALENDAR

FOR ii = 1 TO 37
   DO CASE
      CASE ii < ::iStartOfMonth
         ::aDATEBUTTONS[ii]:Hide()
      CASE ii > ::iEndOfMonth
         ::aDATEBUTTONS[ii]:Hide()
      OTHERWISE
         ::aDATEBUTTONS[ii]:SetText( ALLTRIM( STR( ii - ::iStartOfMonth + 1 ) ) )
         ::aDATEBUTTONS[ii]:Show()
   ENDCASE
NEXT
::grp_CALENDAR:SetText( CMONTH( ::dAnchorDate ) + " " + STR( YEAR( ::dAnchorDate ) ) )

RETURN nil


METHOD SetAnchorDate( dDate ) CLASS CALENDAR

::dAnchorDate   := dDate
::iStartOfMonth := DOW( BOM( dDate ) )
::iEndOfMonth   := DaysInMonth( MONTH( dDate ), IsLeap( dDate ) ) + ::iStartOfMonth -1


RETURN nil


METHOD MoveMonths( iIncrement ) CLASS CALENDAR

iTemp := MONTH( ::dAnchorDate ) + iIncrement
iNewMonth := iTemp % 12
IF iNewMonth == 0
   iNewMonth := 12
ENDIF
iNewYear  := YEAR( ::dAnchorDate ) + ( ( iTemp - iNewMonth ) / 12 )
dTestDate := CTOD( "01/01/" + STR( iNewYear, 4, 0 ) )
iNewDay   := MIN( DAY( ::dAnchorDate ), DaysInMonth( iNewMonth, IsLeap( dTestDate ) ) )
::SetAnchorDate( CTOD( PADL( ALLTRIM( STR( iNewDay, 2, 0 ) ), 2 ) + "/" + PADL( ALLTRIM( STR( iNewMonth, 2, 0 ) ), 2 ) + "/" + STR( iNewYear, 4, 0 ) ) )
::SetButtons()

RETURN nil


METHOD MoveYears( iIncrement ) CLASS CALENDAR

iNewYear  := YEAR( ::dAnchorDate ) + iIncrement
dTestDate := CTOD( "01/01/" + STR( iNewYear, 4, 0 ) )
iNewDay   := MIN( DAY( ::dAnchorDate ), DaysInMonth( MONTH( ::dAnchorDate ), IsLeap( dTestDate ) ) )
::SetAnchorDate( CTOD( PADL( ALLTRIM( STR( iNewDay, 2, 0 ) ), 2 ) + "/" + PADL( ALLTRIM( STR( MONTH( ::dAnchorDate ), 2, 0 ) ), 2 ) + "/" + STR( iNewYear, 4, 0 ) ) )
::SetButtons()

RETURN nil

Regards
xProgrammer

[Antonio Linares]

Doug,

Thanks for sharing it!

[xProgrammer]

Hi all

I discovered a small glitch in my code. It occurred when MoveMonths() was used to move backwards enough for iTemp to go negative. This of course only happened when the move was back more than 1 month (which couldn't happen in the version given above).

The problem is with the % operator.

-5 % 12 is giving -5 whereas I would have expected +7.

So the code can be corrected as follows. Replace:

Code: Select all

 iNewMonth := iTemp % 12

With:

Code: Select all

IF iTemp >= 0
   iNewMonth := iTemp % 12
  ELSE
   iNewMonth := 12 + (iTemp % 12 )
ENDIF

Regards
Doug
(xProgrammer)