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

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

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