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

callite: Add option coNoMonthChange to keep the current month of the calendar.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8754 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-03-01 12:11:54 +00:00
parent cebd61929e
commit beeab95b4a
1 changed files with 24 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

35
components/callite/source/calendarlite.pas
View File

@ -88,7 +88,8 @@ type
TCalOption = (coBoldDayNames, coBoldHolidays, coBoldToday, coBoldTopRow,
coBoldWeekend, coDayLine, coShowBorder, coShowHolidays,
coShowTodayFrame, coShowTodayName, coShowTodayRow,
coShowWeekend, coShowDayNames, coShowTopRow, coUseTopRowColors
coShowWeekend, coShowDayNames, coShowTopRow, coUseTopRowColors,
coNoMonthChange
);
TCalOptions = set of TCalOption;
@ -361,8 +362,7 @@ type
property DayNames: String read FCustomDayNames write SetCustomDayNames;
property DisplayTexts: String read GetDisplayTexts write SetCustomDisplayTexts;
property MonthNames: String read FCustomMonthNames write SetCustomMonthNames;
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect
default false;
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default false;
property Options: TCalOptions read FOptions write SetOptions
default [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays,
coShowTodayRow, coShowDayNames, coShowTopRow];
@ -1327,7 +1327,7 @@ end;
procedure TCalDrawer.GotoMonth(AMonth: word);
begin
if (AMonth < 1) or (AMonth > 12) then
if (AMonth < 1) or (AMonth > 12) or (coNoMonthChange in FOwner.FOptions) then
exit;
FThisDay := EnsureRange(FThisDay, 1, DaysInAMonth(FThisYear, AMonth));
FOwner.Date := EncodeDate(FThisYear, AMonth, FThisDay);
@ -1340,7 +1340,7 @@ end;
procedure TCalDrawer.GotoYear(AYear: word);
begin
if (FThisMonth < 1) or (FThisMonth > 12) then
if (FThisMonth < 1) or (FThisMonth > 12) or (coNoMonthChange in FOwner.Options) then
exit;
FThisDay := EnsureRange(FThisday, 1, DaysInAMonth(AYear, FThisMonth));
FOwner.Date := EncodeDate(AYear, FThisMonth, FThisDay);
@ -1352,14 +1352,17 @@ var
cell: TSize;
Rm, Ry: TRect;
sm: TCalSelMode;
newDate: TDate;
begin
sm := FOwner.SelMode(Shift);
cell := GetCellAt(APoint);
case cell.cy of
TopRow:
case cell.cx of
1: FOwner.Date := IncYear(FOwner.Date, -1);
2: FOwner.Date := IncMonth(FOwner.Date, -1);
1: if not (coNoMonthChange in FOwner.Options) then
FOwner.Date := IncYear(FOwner.Date, -1);
2: if not (coNoMonthChange in FOwner.Options) then
FOwner.Date := IncMonth(FOwner.Date, -1);
3..5:
begin
GetMonthYearRects(Rm{%H-}, Ry{%H-});
@ -1374,8 +1377,10 @@ begin
FOwner.FPopupMenu.Popup(ppopup.x, ppopup.y);
end;
end;
6: FOwner.Date := IncMonth(FOwner.Date, +1);
7: FOwner.Date := IncYear(FOwner.Date, +1);
6: if not (coNoMonthChange in FOwner.Options) then
FOwner.Date := IncMonth(FOwner.Date, +1);
7: if not (coNoMonthChange in FOwner.Options) then
FOwner.Date := IncYear(FOwner.Date, +1);
end;
DayRow: ;
@ -1502,6 +1507,9 @@ var
oldMonth: Integer;
begin
oldMonth := MonthOf(FDate);
if (coNoMonthChange in FOptions) and (oldMonth <> MonthOf(ADate)) then
exit;
FDate := ADate;
case ASelMode of
@ -1726,7 +1734,6 @@ procedure TCalendarLite.KeyDown(var Key: Word; Shift: TShiftState);
var
sm: TCalSelMode;
begin
sm := SelMode(Shift);
@ -1738,9 +1745,13 @@ begin
VK_HOME : ChangeDateTo(StartOfTheMonth(FDate), sm);
VK_END : ChangeDateTo(EndOfTheMonth(FDate), sm);
VK_PRIOR,
VK_NEXT : if not FMultiSelect and (ssCtrl in Shift) then
Date := IncYear(FDate, Delta(Key = VK_NEXT)) else
VK_NEXT : if not (coNoMonthChange in FOptions) then
begin
if not FMultiSelect and (ssCtrl in Shift) then
Date := IncYear(FDate, Delta(Key = VK_NEXT))
else
Date := IncMonth(FDate, Delta(Key = VK_NEXT));
end;
else inherited;
exit;
end;