Download text file
#if 0
Hi,
A little explaination on why this routine came about may not be necessary
but it may shed a bit of light on how it is used.
I have a client that owns a rental store. Rentals run from 1 hour to 1 month
but never any longer. Daily rentals and up do NOT pay for Holidays and/or
Holidays unless it was just for that one day. So I needed to know which days
he decided were 'free days'.
As the program also tracks employee time and calculates payroll I had to know
which days get normal pay, which get time and a half or double time, etc. So,
this routine is used twice in the program.
How you use it is, of course, up to you. The version you have here is a plain-
jane with no bells or whistles. To use it one need only click on the date to
rotate it's value from 0, 1, 2, or 4. Holydays (Sunday, Friday, etc) can be set
by clicking on the day names. (eg: Su, Mo, Tu, We, Th, Fr, Sa) Other than that
one can navigate between the 3 year span. That's it! Don't make it any more
difficult than it needs to be and you'll have A WHOLE LOT LESS TROUBLE from the
user. d;D
C'ya,
Don
#endif
#IF 0
---------------------------- PowerBASIC/WIN v3
---| DASoft |------------------------------------------
---------------------------- Code DATE: 2003-08-17
| FILE NAME Holidays.bas | by
---------------------------- Don Schullian, Jr.
This code is released into the Public Domain
----------------------------------------------------------
No guarantee as to the viability, accuracy, or safety of
use of this code is implied, warranted, or guaranteed
----------------------------------------------------------
Use at your own risk!
----------------------------------------------------------
CONTACT AUTHOR AT d83@DASoftVSS.com
-------------------------------------------------------------------------
The primary function of these routines is to allow user setup for holidays or
non-working days. Each day is represented by a byte in an array of 1101 bytes
covering 3 years and 3 'flags'. This array is best represented as Holiday(366,2)
but could just as easily be a string. If, however, you wish to address any of the
data yourself then I'd suggest you stay with the array.
The 3 flags are positioned at byte 0, 367, and 734 or H(0,0), H(0,1), H(0,2) and
the days of the year(s) all start with H(1,Y) and run through H(366,Y) allowing
for leap years. The day number is the Julian day.
eg: Jan 1 = 1 while Dec 31 would be 365 or 366 if it is a leap year.
Each day has one or more of 4 values:
0 = non-holiday
1 = weekly holiday or Holyday (Sunday for Christians, Friday for Jews, etc.)
2 = Annually occuring holiday but not a standard date. (Easter, Thanksgiving)
4 = Annually occuring holiday with a standard date. (Jan 1, July 4, Dec 25)
When a new year is required year 1 and 2 are shifted down. The new year holds
the standard date holidays, discards the non-standard dates, and sets all the
Holydays on. (There is an exception to this rule discussed later.)
The 3 flag bytes are as follows:
H(0,0) or Byte 0 holds the Flaged Holidays where bit 0 is Sunday and bit 6 is
Saturday.
H(0,1) or Byte 367 holds the value for Year zero.
eg: Current year = (H(0,1) + 2000) + 1
H(0,2) or Byte 734 uses bit 0 to set the flag to keep all holidays (not Holydays)
when creating a new year. (This is the exception spoken of above) Under this
condition a holiday with a value of 2 will be forwarded to the new year where
it would be removed if the flag is not set.
NOTE: Whether this flag is set or not the new year's holidays will NOT be
correct and some user manipulation will be required unless your client
has a standard set of holidays that you can determe programmatically.
If only the federal US holidays are used, for example, they can all be
computed and code is available on the PowerBASIC forum. In these cases
you'll want to modify the sub routine Holiday_NewYear to do these
computations.
There are always 3 years in use. Last year, This year and Next year. Year zero is
last year. eg: H(1,0) is January 1, LastYear
H(1,1) is January 1, ThisYear
H(1,2) is January 1, NextYear
It is up to your program to keep the data current. A simple check at the start up
of the program should suffice.
IF H(0,1) <> (VAL(MID$(DATE$,7)) - 2001) THEN
IF fHoliday_Setup(hDlg,VARPTR(H(0,0)),"Holiday Setup") THEN
' Save changes
END IF
END IF
There are only 2 functions that you are required to call:
fHoliday_Setup is the main DDT that allows the user to manipulate the data.
This version is devoid of any extras that you may wish to add. I'd suggest
some form of legand explaining (briefly) the 4 states for each date and
maybe some warning messages when a new year is being presented.
fHoliday_Value returns the byte value for a given Y,M,D or -1 if the year
is out of range. There is no other error checking done here so it is up
to your code to ensure that the month (M) and the day (D) are correct.
NOTE: If you are using the array, as suggested, you could also find the
value yourself using the fJulianDay function.
#endif
'
'==============================================================================
'=============================== TEST CODE ====================================
'==============================================================================
'
%Testing = 1
#if %Testing
#COMPILE EXE
'#OPTION VERSION5
#DIM ALL
#DEBUG ERROR ON
#INCLUDE "WIN32API.INC"
DECLARE FUNCTION fHoliday_Setup ALIAS "fHoliday_Setup" (BYVAL hParent???,BYVAL ArrPtr&,BYVAL Caption$) AS LONG
DECLARE FUNCTION fHoliday_Value ALIAS "fHoliday_Value" (BYVAL ArrPtr&,BYVAL Y&,BYVAL M&,BYVAL D&) AS LONG
FUNCTION PBMAIN()
DIM Holidays(366,2) AS LOCAL BYTE
fHoliday_Setup %HWND_DESKTOP, VARPTR(Holidays(0,0)), "Holiday Setup"
END FUNCTION
'
'==============================================================================
'========== CALENDAR INFO ==========
'==============================================================================
'
GLOBAL g_zLocDat AS ASCIIz * %MAX_PATH
GLOBAL g_Locale_Flag AS LONG
FUNCTION EnumCalendarProc(zReturn AS ASCIIZ) AS LONG
g_zLocDat = zReturn
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fGetCalendarInfo ALIAS "fGetCalendarInfo" ( BYVAL CalFrom AS LONG, _
OPT BYVAL CalTo AS LONG ) EXPORT AS STRING
DIM cbPtr AS LOCAL DWORD
DIM Txt AS LOCAL STRING
DIM X AS LOCAL LONG
cbPtr = CODEPTR(EnumCalendarProc)
IF CalTo = 0 THEN CalTo = CalFrom
FOR X = CalFrom TO CalTo
EnumCalendarInfo cbPtr, g_Locale_Flag, 1, X
Txt = Txt & g_zLocDat & ","
NEXT
FUNCTION = RTRIM$(Txt,",")
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fLeapYear ALIAS "fLeapYear" (BYVAL Year AS LONG) EXPORT AS LONG
IF ( ( Year MOD 4 ) = 0 ) AND _
( ( Year MOD 100 ) > 0 ) OR _
( ( Year MOD 400 ) = 0 ) THEN FUNCTION = 1
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fJulianDay ALIAS "fJulianDay" (BYVAL Year AS LONG, _
BYVAL Month AS LONG, _
BYVAL Day AS LONG ) EXPORT AS LONG
Day = Day + VAL(READ$(Month))
IF Month > 2 THEN
Day = Day + fLeapYear(Year)
END IF
FUNCTION = Day
DATA 000, 031, 059, 090, 120, 151
DATA 181, 212, 243, 273, 304, 334
FUNCTION = Day 'RETURN Day number for the year
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fDaysInMonth ALIAS "fDaysInMonth" (BYVAL Year AS LONG, _
BYVAL Month AS LONG ) EXPORT AS LONG
DIM Days AS LOCAL LONG
Days = VAL(READ$(Month))
IF Month = 2 THEN Days = Days + fLeapYear(Year)
FUNCTION = Days
DATA 31, 28, 31, 30, 31, 30
DATA 31, 31, 30, 31, 30, 31
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fWeekDay ALIAS "fWeekDay" (BYVAL Year AS LONG, _
BYVAL Month AS LONG, _
BYVAL Day AS LONG ) EXPORT AS LONG
IF ( Year = 0 ) OR _
( Month = 0 ) OR _
( Day = 0 ) THEN EXIT FUNCTION
IF Month > 1 THEN Day = fJulianDay(Year,Month,Day) 'compute Julian day
DECR Year 'don't count 'this year'
Day = Day + (Year * 365) + _ ' add full years
(Year \ 4) - _ ' add a day for each olympiad
(Year \ 100) + _ ' subtract a day for each century
(Year \ 400) ' add a day for each epoc
'
FUNCTION = (Day MOD 7) 'RETURN day of the week 0 = Sunday
'
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fBN_clicked ALIAS "fBN_Clicked" ( BYVAL Msg AS LONG ) EXPORT AS LONG
IF (Msg = %BN_CLICKED) OR _
(Msg = 1 ) THEN FUNCTION = 1
END FUNCTION
#endif
'
'==============================================================================
'===========================END TEST CODE =====================================
'==============================================================================
'
%Holiday_Flag1 = %SS_SIMPLE OR %WS_CHILD OR %WS_VISIBLE OR %SS_NOTIFY OR %SS_CENTERIMAGE
%Holiday_Flag2 = %WS_EX_LEFT OR %WS_EX_LTRREADING
%Holiday_HolyDays = 0
%Holiday_Year0 = 367
%Holiday_Flags = 734
%Holiday_Color1 = %RED
%Holiday_Color2 = &h008000 ' DkGreen
%Holiday_Color4 = %BLUE
'
'------------------------------------------------------------------------------
'
SUB Holiday_ColorDay ( BYVAL hParent AS DWORD, _
BYVAL HYear AS LONG , _
BYVAL Jday AS LONG )
DIM A_ptr AS LOCAL BYTE PTR
DIM Ctrl AS LOCAL LONG
DIM Offs AS LOCAL LONG
DIALOG GET USER hParent, 5 TO A_ptr
Ctrl = Jday + 1000
Offs = (%Holiday_Year0 * HYear) + Jday
IF @A_ptr[Offs] = 0 THEN
CONTROL SET COLOR hParent, Ctrl, %BLACK, %WHITE
ELSEif (@A_ptr[Offs] AND 4) THEN
CONTROL SET COLOR hParent, Ctrl, %WHITE, %Holiday_Color4
ELSEif (@A_ptr[Offs] AND 2) THEN
CONTROL SET COLOR hParent, Ctrl, %WHITE, %Holiday_Color2
ELSEif (@A_ptr[Offs] AND 1) THEN
CONTROL SET COLOR hParent, Ctrl, %WHITE, %Holiday_Color1
END IF
END SUB
'
'------------------------------------------------------------------------------
'
SUB Holiday_SetHolyDay ( BYVAL hParent AS DWORD, _
BYVAL HYear AS LONG, _
BYVAL DoW AS LONG )
DIM A_ptr AS LOCAL BYTE PTR
DIM D AS LOCAL LONG
DIM Jday AS LOCAL LONG
DIM M AS LOCAL LONG
DIM WkDay AS LOCAL LONG
DIM V AS LOCAL LONG
DIM Y AS LOCAL LONG
DIALOG GET USER hParent, 5 TO A_ptr
Y = @A_ptr[%Holiday_Year0] + HYear + 2000
WkDay = fWeekDay(Y,1,1)
DoW = (DoW MOD 7)
V = BIT(@A_ptr[%Holiday_HolyDays], DoW)
Jday = %Holiday_Year0 * HYear
FOR M = 1 TO 12
FOR D = 1 TO fDaysInMonth(Y,M)
INCR Jday
IF WkDay = DoW THEN
BIT CALC @A_ptr[Jday], 0, V
END IF
WkDay = IIF(WkDay < 6, WkDay + 1, 0)
NEXT
NEXT
END SUB
'
'------------------------------------------------------------------------------
'
SUB Holiday_NewYear (BYVAL A_ptr AS BYTE PTR)
DIM Bmap AS LOCAL BYTE
DIM D AS LOCAL LONG
DIM DoW AS LOCAL LONG
DIM Jday1 AS LOCAL LONG
DIM Jday2 AS LOCAL LONG
DIM Leap1 AS LOCAL LONG
DIM Leap2 AS LOCAL LONG
DIM WkDay AS LOCAL LONG
DIM Y AS LOCAL LONG
DIM Z AS LOCAL LONG
Y = %Holiday_Year0
Z = %Holiday_Flags
FOR D = 1 TO 366
INCR Y
INCR Z
@A_ptr[D] = @A_ptr[Y]
@A_ptr[Y] = @A_ptr[Z]
@A_ptr[Z] = 0
NEXT
INCR @A_ptr[%Holiday_Year0]
Y = @A_ptr[%Holiday_Year0] + 2000 + 2
Leap1 = fLeapYear(Y-1)
Leap2 = fLeapYear(Y )
FOR D = 0 TO 6
IF BIT(@A_ptr[%Holiday_HolyDays],D) = 1 THEN
DoW = fWeekDay(Y,1,1)
FOR Jday2 = 735 TO 1099 + Leap2
IF DoW = D THEN BIT SET @A_ptr[Jday2], 0
DoW = IIF(DoW < 6, DoW + 1, 0)
NEXT
END IF
NEXT
Jday1 = %Holiday_Year0
Jday2 = %Holiday_Flags
IF Leap1 = 1 THEN Leap1 = Jday1 + 60 ' zero if not a leap year
IF Leap2 = 1 THEN Leap2 = Jday2 + 60
IF (@A_ptr[%Holiday_Flags] AND 1) THEN
Bmap = &b0110
ELSE
Bmap = &b0100
END IF
FOR D = 365 TO 0 STEP -1
INCR Jday1 : IF (Jday1 = Leap1) THEN INCR Jday1
INCR Jday2 : IF (Jday2 = Leap2) THEN INCR Jday2
IF (@A_ptr[Jday1] AND Bmap) THEN
@A_ptr[Jday2] = (@A_ptr[Jday2] OR BMap)
END IF
NEXT
END SUB
'
'------------------------------------------------------------------------------
'
SUB Holiday_DisplayYear ( BYVAL hParent AS DWORD, _
BYVAL HYear AS LONG )
DIM A_ptr AS LOCAL BYTE PTR
DIM C_ptr AS LOCAL ASCIIz PTR * 128
DIM Col AS LOCAL LONG
DIM Cols AS LOCAL LONG
DIM Ctrl AS LOCAL LONG
DIM D AS LOCAL LONG
DIM DoW AS LOCAL LONG
DIM Jday AS LOCAL LONG
DIM M AS LOCAL LONG
DIM Row AS LOCAL LONG
DIM Txt AS LOCAL STRING
DIM Wlock AS LOCAL LONG
DIM X AS LOCAL LONG
DIM Y AS LOCAL LONG
DIALOG GET USER hParent, 5 TO A_ptr
Wlock = LockWindowUpdate(hParent)
FOR Ctrl = 1366 TO 1001 STEP -1
CONTROL KILL hParent, Ctrl
NEXT
Ctrl = 1400
DoW = 0
FOR D = 0 TO 36
IF BIT(@A_ptr[%Holiday_HolyDays],DoW) THEN
CONTROL SET COLOR hParent, Ctrl, %WHITE, %Holiday_Color1
ELSE
CONTROL SET COLOR hParent, Ctrl, %BLACK, %WHITE
END IF
DoW = IIF(DoW < 6,DoW+1,0)
IF DoW = 0 THEN Col = Col + 5
INCR Ctrl
NEXT
Y = @A_ptr[%Holiday_Year0] + HYear + 2000
Dow = fWeekDay(Y,1,1)
Jday = 1
Cols = 13
Ctrl = 1001
Row = 5
FOR M = 1 TO 12
Col = 21 + (DoW * Cols)
Row = Row + 15
FOR D = 1 TO fDaysInMonth(Y,M)
CONTROL ADD LABEL, hParent, Ctrl, FORMAT$(D,"0#"), Col, Row, Cols, 13, %Holiday_Flag1, %Holiday_Flag2
Holiday_ColorDay hParent, HYear, Jday
INCR Jday
Col = Col + Cols
DoW = IIF(DoW < 6,DoW+1,0)
IF DoW = 0 THEN Col = Col + 5
INCR Ctrl
NEXT
NEXT
SELECT CASE HYear
CASE 0 : CONTROL DISABLE hParent, 1600
CONTROL ENABLE hParent, 1601
CASE 1 : CONTROL ENABLE hParent, 1600
CONTROL ENABLE hParent, 1601
CASE 2 : CONTROL ENABLE hParent, 1600
CONTROL DISABLE hParent, 1601
END SELECT
DIALOG GET USER hParent, 6 TO C_ptr
Txt = @C_ptr & STR$(Y)
SetWindowText hParent, BYCOPY Txt
IF Wlock <> 0 THEN LockWindowUpdate 0
InvalidateRect hParent, BYVAL %NULL, %TRUE
UpdateWindow hParent
END SUB
'
'------------------------------------------------------------------------------
'
CALLBACK FUNCTION fHoliday_Setup_CB ()
DIM HYear AS STATIC LONG
DIM A_ptr AS LOCAL BYTE PTR
DIM D AS LOCAL LONG
DIM Y AS LOCAL LONG
SELECT CASE CBMSG
CASE %WM_INITDIALOG : HYear = 1
Holiday_DisplayYear CBHNDL, HYear
CASE %WM_COMMAND
SELECT CASE CBCTL
CASE 1400 TO 1436 : DIALOG GET USER CBHNDL, 5 TO A_ptr
D = (CBCTL MOD 7)
BIT TOGGLE @A_ptr[%Holiday_HolyDays], D
FOR Y = 0 TO 2
Holiday_SetHolyday CBHNDL, Y, D
NEXT
Holiday_DisplayYear CBHNDL, HYear
CASE 1001 TO 1366 : DIALOG GET USER CBHNDL, 5 TO A_ptr
D = CBCTL - 1000
Y = (HYear * %Holiday_Year0) + D
IF @A_ptr[Y] = 0 THEN
@A_ptr[Y] = 1
ELSE
ROTATE LEFT @A_ptr[Y], 1
@A_ptr[Y] = @A_ptr[Y] AND &b0111
END IF
Holiday_ColorDay CBHNDL, HYear, D
CONTROL REDRAW CBHNDL, CBCTL
CASE 1600 : IF fBN_clicked(CBCTLMSG) THEN
DECR HYear
Holiday_DisplayYear CBHNDL, HYear
END IF
CASE 1601 : IF fBN_clicked(CBCTLMSG) THEN
INCR HYear
Holiday_DisplayYear CBHNDL, HYear
END IF
CASE 1 : IF fBN_clicked(CBCTLMSG) THEN DIALOG END CBHNDL, 1
CASE 2 : IF fBN_clicked(CBCTLMSG) THEN DIALOG END CBHNDL, 0
END SELECT
END SELECT
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fHoliday_Setup ALIAS "fHoliday_Setup" ( BYVAL hParent AS DWORD , _
BYVAL ArrPtr AS LONG , _
BYVAL Caption AS STRING ) EXPORT AS LONG
DIM A_ptr AS LOCAL BYTE PTR
DIM Capt AS LOCAL ASCIIz * 128
DIM Col AS LOCAL LONG
DIM Cols AS LOCAL LONG
DIM Ctrl AS LOCAL LONG
DIM D AS LOCAL LONG
DIM DayAbbr AS LOCAL STRING
DIM DoW AS LOCAL LONG
DIM hDlg AS LOCAL DWORD
DIM M AS LOCAL LONG
DIM MonAbbr AS LOCAL STRING
DIM Row AS LOCAL LONG
DIM Txt AS LOCAL STRING
A_ptr = ArrPtr
D = VAL(MID$(DATE$,7)) - 2001
IF @A_ptr[%Holiday_Year0] = 0 THEN
@A_ptr[%Holiday_Year0] = D
ELSEif @A_ptr[%Holiday_Year0] <> D THEN
Holiday_NewYear A_ptr
END IF
Txt = fGetCalendarInfo(%CAL_SABBREVDAYNAME1,%CAL_SABBREVDAYNAME7)
DayAbbr = PARSE$(Txt,7)
FOR D = 1 TO 6
DayAbbr = DayAbbr & "," & PARSE$(Txt,$TAB,D)
NEXT
MonAbbr = fGetCalendarInfo(%CAL_SABBREVMONTHNAME1,%CAL_SABBREVMONTHNAME12)
DIALOG NEW hParent, "", , , 528, 220, %WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_MODALFRAME OR _
%DS_3DLOOK OR %DS_NOFAILCREATE OR %DS_SETFONT , _
%WS_EX_WINDOWEDGE OR %WS_EX_CONTROLPARENT OR %WS_EX_LEFT OR _
%WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR, TO hDlg
DIALOG SET COLOR hDlg, %BLACK, %WHITE
Cols = 13
Row = 20
Ctrl = 1500
FOR M = 1 TO 12
CONTROL ADD LABEL, hDlg, Ctrl, PARSE$(MonAbbr,M), 3, Row, 15, 13, %Holiday_Flag1, %Holiday_Flag2
CONTROL SET COLOR hDlg, Ctrl, %BLACK, %WHITE
Row = Row + 15
INCR Ctrl
NEXT
Ctrl = 1400
Col = 21
FOR D = 0 TO 36
Txt = LEFT$(PARSE$(DayAbbr,DoW+1), 2)
CONTROL ADD LABEL, hDlg, Ctrl, Txt, Col, 5, Cols, 13, %Holiday_Flag1, %Holiday_Flag2
Col = Col + Cols
DoW = IIF(DoW < 6,DoW+1,0)
IF DoW = 0 THEN Col = Col + 5
INCR Ctrl
NEXT
CONTROL ADD LINE , hDlg, 1513, "" , 0, 2, 528, 1
CONTROL ADD LINE , hDlg, 1514, "" , 0, 197, 528, 1
#if 1
CONTROL ADD LINE , hDlg, 1515, "" , 0, 16, 528, 1
CONTROL ADD LINE , hDlg, 1526, "" , 19, 16, 1, 182
CONTROL ADD LINE , hDlg, 1517, "" , 113, 16, 1, 182
CONTROL ADD LINE , hDlg, 1518, "" , 209, 16, 1, 182
CONTROL ADD LINE , hDlg, 1519, "" , 305, 16, 1, 182
CONTROL ADD LINE , hDlg, 1520, "" , 401, 16, 1, 182
CONTROL ADD LINE , hDlg, 1521, "" , 497, 16, 1, 182
CONTROL ADD LINE , hDlg, 1522, "" , 0, 62, 528, 1
CONTROL ADD LINE , hDlg, 1523, "" , 0, 107, 528, 1
CONTROL ADD LINE , hDlg, 1524, "" , 0, 152, 528, 1
#endif
CONTROL ADD BUTTON, hDlg, 1600, "<< Prev", 5, 200, 50, 15
CONTROL ADD BUTTON, hDlg, 1, "Save" , 214, 200, 50, 15
CONTROL ADD BUTTON, hDlg, 2, "Cancel" , 269, 200, 50, 15
CONTROL ADD BUTTON, hDlg, 1601, "Next >>", 478, 200, 50, 15
Capt = TRIM$(Caption) & $SPC
DIALOG SET USER hDlg, 5, ArrPtr
DIALOG SET USER hDlg, 6, VARPTR(Capt)
DIALOG SHOW MODAL hDlg, CALL fHoliday_Setup_CB TO D
FUNCTION = D
END FUNCTION
'
'------------------------------------------------------------------------------
'
FUNCTION fHoliday_Value ALIAS "fHoliday_Value" (BYVAL ArrPtr AS LONG, _
BYVAL Y AS LONG, _
BYVAL M AS LONG, _
BYVAL D AS LONG ) EXPORT AS LONG
DIM A_ptr AS LOCAL BYTE PTR
DIM HYear AS LOCAL LONG
DIM Jday AS LOCAL LONG
A_ptr = ArrPtr
HYear = (@A_ptr[%Holiday_Year0] - (Y - 2000))
IF (HYear < 0) OR _
(HYear > 2) THEN
FUNCTION = -1
EXIT FUNCTION
ELSE
Jday = fJulianDay(Y,M,D) + (HYear * %Holiday_Year0)
FUNCTION = @A_ptr[Jday]
END IF
END FUNCTION