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