pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

tvplanit: Add holiday support to TVpCalendar.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8553 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-10-13 15:00:41 +00:00
parent b7c534c59a
commit 23c4602593
2 changed files with 36 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
components/tvplanit/source/vpcalendar.pas
View File

@ -48,11 +48,12 @@ uses
type type
TVpCalDisplayOption = (cdoShortNames, cdoShowYear, cdoShowInactive, TVpCalDisplayOption = (cdoShortNames, cdoShowYear, cdoShowInactive,
cdoShowRevert, cdoShowToday, cdoShowNavBtns, cdoShowRevert, cdoShowToday, cdoShowNavBtns,
cdoHideActive, cdoHighlightSat, cdoHighlightSun); cdoHideActive, cdoHighlightSat, cdoHighlightSun,
cdoHighlightHolidays);
TVpCalDisplayOptions = set of TVpCalDisplayOption; TVpCalDisplayOptions = set of TVpCalDisplayOption;
TVpCalColorArray = array[0..9] of TColor; TVpCalColorArray = array[0..10] of TColor;
TVpCalColorScheme = (cscalCustom, cscalClassic, cscalWindows, TVpCalColorScheme = (cscalCustom, cscalClassic, cscalWindows,
cscalGold, cscalOcean, cscalRose); cscalGold, cscalOcean, cscalRose);
@ -65,13 +66,13 @@ type
const const
{ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend, EventDays, ActiveDayBorder, ActiveDayText} {ActiveDay, DayNames, Days, InactiveDays, MonthAndYear, Weekend, EventDays, ActiveDayBorder, ActiveDayText}
CalScheme : TVpCalSchemeArray = ( CalScheme : TVpCalSchemeArray = (
// Active BG DayNames Days Inact.Days Month/Year Weekend Event Background Active border Active text // Active BG DayNames Days Inact.Days Month/Year Weekend Event Background Active border Active text Holidays
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0), (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
(clWindow, clWindowText, clWindowText, clSilver, clWindowText, clRed, clWindowText, clWindow, clWindowText, clWindowText), // classic (clWindow, clWindowText, clWindowText, clSilver, clWindowText, clRed, clWindowText, clWindow, clWindowText, clWindowText, clRed), // classic
(clBlue, clMaroon, clBlack, clMedGray, clBlue, clRed, clBlack, clDefault, clBlack, clWhite), // windows (clBlue, clMaroon, clBlack, clMedGray, clBlue, clRed, clBlack, clDefault, clBlack, clWhite, clRed), // windows
(clMaroon, clBlack, clYellow, clSilver, clBlack, $7777FF, clWhite, clOlive, clBlack, clYellow), // gold (clMaroon, clBlack, clYellow, clSilver, clBlack, $7777FF, clWhite, clOlive, clBlack, clYellow, $7777FF), // gold
(clBlue, clSilver, clAqua, clBlue, clSilver, clRed, clWhite, clNavy, clNavy, clWhite), // ocean (clBlue, clSilver, clAqua, clBlue, clSilver, clRed, clWhite, clNavy, clNavy, clWhite, clRed), // ocean
($007500EA, clBlack, clFuchsia, clMedGray, clBlack, clRed, clMaroon, $00D9B3FF, clMaroon, clWhite) // rose ($007500EA, clBlack, clFuchsia, clMedGray, clBlack, clRed, clMaroon, $00D9B3FF, clMaroon, clWhite, clRed) // rose
); );
calDefWeekStarts = dtSunday; { default start of the week } calDefWeekStarts = dtSunday; { default start of the week }
@ -105,6 +106,7 @@ type
property MonthAndYear: TColor index 4 read GetColor write SetColor; property MonthAndYear: TColor index 4 read GetColor write SetColor;
property Weekend: TColor index 5 read GetColor write SetColor; property Weekend: TColor index 5 read GetColor write SetColor;
property EventDays: TColor index 6 read GetColor write SetColor; property EventDays: TColor index 6 read GetColor write SetColor;
property Holidays: TColor index 10 read GetColor write SetColor;
end; end;
type type
@ -144,6 +146,7 @@ type
FOnDrawItem : TCalendarDateEvent; FOnDrawItem : TCalendarDateEvent;
FOnGetDateEnabled: TGetDateEnabledEvent; FOnGetDateEnabled: TGetDateEnabledEvent;
FOnGetHighlight : TGetHighlightEvent; FOnGetHighlight : TGetHighlightEvent;
FOnHoliday : TVpHolidayEvent;
{internal variables} {internal variables}
clInLinkHandler : Boolean; clInLinkHandler : Boolean;
@ -258,6 +261,7 @@ type
procedure IncDay(Delta: Integer); procedure IncDay(Delta: Integer);
procedure IncMonth(Delta: Integer); procedure IncMonth(Delta: Integer);
procedure IncYear(Delta: Integer); procedure IncYear(Delta: Integer);
function IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect; procedure PaintToCanvas(ACanvas: TCanvas; ARect: TRect;
Angle: TVpRotationAngle; ADate: TDateTime); Angle: TVpRotationAngle; ADate: TDateTime);
@ -304,6 +308,7 @@ type
property OnDrawItem: TCalendarDateEvent read FOnDrawItem write FOnDrawItem; property OnDrawItem: TCalendarDateEvent read FOnDrawItem write FOnDrawItem;
property OnGetDateEnabled: TGetDateEnabledEvent read FOnGetDateEnabled write FOnGetDateEnabled; property OnGetDateEnabled: TGetDateEnabledEvent read FOnGetDateEnabled write FOnGetDateEnabled;
property OnGetHighlight: TGetHighlightEvent read FOnGetHighlight write FOnGetHighlight; property OnGetHighlight: TGetHighlightEvent read FOnGetHighlight write FOnGetHighlight;
property OnHoliday: TVpHolidayEvent read FOnHoliday write FOnHoliday;
end; end;
TVpCalendar = class(TVpCustomCalendar) TVpCalendar = class(TVpCustomCalendar)
@ -354,6 +359,7 @@ type
property OnExit; property OnExit;
property OnGetDateEnabled; property OnGetDateEnabled;
property OnGetHighlight; property OnGetHighlight;
property OnHoliday;
property OnKeyDown; property OnKeyDown;
property OnKeyPress; property OnKeyPress;
property OnKeyUp; property OnKeyUp;
@ -1418,6 +1424,18 @@ begin
SetDate(DateUtils.IncYear(FDate, Delta)); SetDate(DateUtils.IncYear(FDate, Delta));
end; end;
function TVpCustomCalendar.IsHoliday(ADate: TDate; out AHolidayName: String): Boolean;
begin
AHolidayName := '';
if Assigned(FOnHoliday) then
begin
FOnHoliday(Self, trunc(ADate), AHolidayName);
Result := AHolidayName <> '';
end else
if Assigned(FControlLink) then
Result := FControlLink.IsHoliday(ADate, AHolidayName);
end;
procedure TVpCustomCalendar.Paint; procedure TVpCustomCalendar.Paint;
begin begin
RenderToCanvas( RenderToCanvas(

9
components/tvplanit/source/vpcalendarpainter.pas
View File

@ -32,6 +32,7 @@ type
DayColor: TColor; DayColor: TColor;
RealColor: TColor; RealColor: TColor;
WeekendColor: TColor; WeekendColor: TColor;
HolidayColor: TColor;
protected protected
procedure DrawAllDays; procedure DrawAllDays;
@ -167,8 +168,10 @@ procedure TVpCalendarPainter.DrawDay(R, C, I: Integer; Grayed: Boolean);
var var
clr: TColor; clr: TColor;
day: Byte; day: Byte;
dt: TDate;
OldIdx: Integer; OldIdx: Integer;
NewIdx: Integer; NewIdx: Integer;
holiday: String;
S: string[10]; S: string[10];
DrawRect: TRect; DrawRect: TRect;
TH: Integer; TH: Integer;
@ -185,9 +188,13 @@ begin
day := TVpCalendarOpener(FCalendar).clCalendar[I]; day := TVpCalendarOpener(FCalendar).clCalendar[I];
S := IntToStr(day); S := IntToStr(day);
dt := Encodedate(FCalendar.Year, FCalendar.Month, day);
if Grayed then if Grayed then
RenderCanvas.Font.Color := InactiveDayColor RenderCanvas.Font.Color := InactiveDayColor
else else
if FCalendar.IsHoliday(dt, holiday) then
RenderCanvas.Font.Color := HolidayColor
else
if (day = FCalendar.Day) then if (day = FCalendar.Day) then
RenderCanvas.Font.Color := ActiveDayTextColor; RenderCanvas.Font.Color := ActiveDayTextColor;
@ -282,6 +289,7 @@ begin
DayColor := clBlack; DayColor := clBlack;
RealColor := clWhite; RealColor := clWhite;
WeekendColor := $5f5f5f; WeekendColor := $5f5f5f;
HolidayColor := $5f5f5f;
end else begin end else begin
BevelHighlight := clBtnHighlight; BevelHighlight := clBtnHighlight;
BevelShadow := clBtnShadow; BevelShadow := clBtnShadow;
@ -296,6 +304,7 @@ begin
DayColor := FCalendar.Colors.Days; DayColor := FCalendar.Colors.Days;
RealColor := FCalendar.Colors.Background; RealColor := FCalendar.Colors.Background;
WeekendColor := FCalendar.Colors.WeekEnd; WeekendColor := FCalendar.Colors.WeekEnd;
HolidayColor := FCalendar.Colors.Holidays;
end; end;
end; end;