From d92ca27508e0685598e5a484c3e01b2e2155d8a1 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 13 Nov 2016 11:58:11 +0000 Subject: [PATCH] CalLite: Improve selection of workdays per week; remove support of ALT key. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5344 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/callite/source/calendarlite.pas | 139 ++++++++++++++++----- 1 file changed, 109 insertions(+), 30 deletions(-) diff --git a/components/callite/source/calendarlite.pas b/components/callite/source/calendarlite.pas index 07dc24353..a1e046260 100644 --- a/components/callite/source/calendarlite.pas +++ b/components/callite/source/calendarlite.pas @@ -3,7 +3,7 @@ It is not a fixed-size component, as are most calendars, but will align and resize as needed - Originator : H Page-Clark, 2013 + Originator : H Page-Clark, 2013/2016 Contributions : Ariel Rodriguez, 2013 Werner Pamler, 2013/2016 @@ -40,8 +40,8 @@ unit CalendarLite; interface uses - Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, types, - menus; + Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Types, + ExtCtrls, Menus; const TopRow = 0; @@ -123,9 +123,10 @@ type TCalDateArray = array of TDate; - TCalSelMode = (smFirstSingle, smNextSingle, smFirstRange, smNextRange, smFirstWeek, smNextWeek); + TCalSelMode = (smFirstSingle, smNextSingle, smFirstRange, smNextRange, + smFirstWeek, smNextWeek, smNextWeekRange); - TLanguage = (lgEnglish, lgFrench, lgGerman, lgHebrew, lgSpanish); //Ariel Rodriguez 12/09/2013 + TLanguage = (lgEnglish, lgFrench, lgGerman, lgHebrew, lgSpanish); { TCalDateList } @@ -245,7 +246,11 @@ type FSavedHint: String; FMultiSelect: Boolean; FSelDates: TCalDateList; + FClickShift: TShiftState; + FClickPoint: TPoint; + FClickButton: TMouseButton; FLanguage: TLanguage; + FDblClickTimer: TTimer; function GetDayNames: String; function GetDisplayText(aTextIndex: TDisplayText): String; function GetDisplayTexts: String; @@ -264,13 +269,17 @@ type procedure SetOptions(AValue: TCalOptions); procedure SetStartingDayOfWeek(AValue: TDayOfWeek); procedure SetWeekendDays(AValue: TDaysOfWeek); - procedure YearMenuItemClicked(Sender: TObject); procedure SetLanguage(AValue: TLanguage); + procedure TimerExpired(Sender: TObject); + procedure YearMenuItemClicked(Sender: TObject); protected procedure ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode); + procedure Click; override; procedure DateChange; virtual; + procedure DblClick; override; class function GetControlClassDefaultSize: TSize; override; + procedure InternalClick; procedure KeyDown(var Key: Word; Shift: TShiftState); override; procedure MonthChange; virtual; procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override; @@ -378,6 +387,9 @@ implementation uses LCLType, LazUTF8, dateutils, math; +const + DBLCLICK_INTERVAL = 300; // Interval (ms) for detection of a double-click + { Holiday helpers } @@ -1272,6 +1284,10 @@ begin FPopupMenu := TPopupMenu.Create(Self); FCalDrawer := TCalDrawer.Create(Canvas); FCalDrawer.FOwner:= Self; + FDblClickTimer := TTimer.Create(self); + FDblClickTimer.Enabled := false; + FDblClickTimer.Interval := DBLCLICK_INTERVAL; + FDblClickTimer.OnTimer := @TimerExpired; FWeekendDays := [dowSunday, dowSaturday]; FOptions := [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays, coShowTodayRow]; @@ -1305,30 +1321,55 @@ begin begin FSelDates.Clear; FSelDates.AddDate(ADate); + FPrevDate := ADate; end; smNextSingle: - FSelDates.AddDate(ADate); - - smFirstRange, smNextRange, - smFirstWeek, smNextWeek: begin - if (ASelMode = smFirstRange) or (ASelMode = smFirstWeek) then + FSelDates.AddDate(ADate); + FPrevDate := ADate; + end; + + smFirstWeek, smNextWeek, smNextWeekRange: + begin + if (DayOfWeek(ADate) in [ord(dowSunday), ord(dowSaturday)]) then + exit; + if ASelMode = smFirstWeek then FSelDates.Clear; - if (ASelMode = smFirstRange) or (ASelMode = smNextRange) then begin - if FPrevDate < ADate then begin - d1 := FPrevDate; + // Collect all weekdays + if ASelMode = smNextWeekRange then begin + if FPRevDate < ADate then begin + d1 := FPrevDate + 7; d2 := ADate; end else begin d1 := ADate; - d2 := FPrevDate; + d2 := FPrevDate + 7; end; - end else - if (ASelMode = smFirstWeek) or (ASelMode = smNextWeek) then begin + end else begin d1 := ADate; - while DayOfWeek(d1) <> ord(dowMonday) do d1 := d1 - 1; d2 := ADate; - while DayOfWeek(d2) <> ord(dowFriday) do d2 := d2 + 1; + end; + while DayOfWeek(d1) <> ord(dowMonday) do d1 := d1 - 1; + while DayOfWeek(d2) <> ord(dowFriday) do d2 := d2 + 1; + d := d1; + while d <= d2 do begin + if not (DayOfWeek(d) in [ord(dowSunday), ord(dowSaturday)]) then + FSelDates.AddDate(d); + d := d + 1; + end; + FPrevDate := ADate; + end; + + smFirstRange, smNextRange: + begin + if (ASelMode = smFirstRange) then + FSelDates.Clear; + if FPrevDate < ADate then begin + d1 := FPrevDate + ord(ASelMode = smNextRange); + d2 := ADate; + end else begin + d1 := ADate; + d2 := FPrevDate - ord(ASelMode = smNextRange); end; d := d1; while (d <= d2) do begin @@ -1338,10 +1379,10 @@ begin end; end; - FPrevDate := ADate; DateChange; if MonthOf(FDate) <> oldMonth then MonthChange; + with FCalDrawer do begin FCanvas.Brush.Color := Colors.BackgroundColor; FCanvas.FillRect(FBoundsRect); @@ -1349,12 +1390,31 @@ begin Invalidate; end; +procedure TCalendarLite.Click; +begin + inherited; + + // Multi-select is handled by DblClickTimer + if not FMultiSelect then + InternalClick; +end; + procedure TCalendarLite.DateChange; begin if Assigned(FOnDateChange) then FOnDateChange(Self); end; +procedure TCalendarLite.DblClick; +begin + FDblClickTimer.Enabled := false; + inherited; + case FClickButton of + mbLeft : FCalDrawer.LeftClick(FClickShift + [ssDouble]); + mbRight : ; + end; +end; + class function TCalendarLite.GetControlClassDefaultSize: TSize; begin Result.cx := DefCalWidth; @@ -1400,6 +1460,14 @@ begin FCalDrawer.GotoDay(TMenuItem(Sender).Tag); end; +procedure TCalendarLite.InternalClick; +begin + case FClickButton of + mbLeft : FCalDrawer.LeftClick(FClickShift); + mbRight : FCalDrawer.RightClick; + end; +end; + function TCalendarLite.IsSelected(ADate: TDate): Boolean; begin if FMultiSelect then @@ -1454,10 +1522,10 @@ begin if not Focused and not(csNoFocus in ControlStyle) then SetFocus; - case Button of - mbLeft : FCalDrawer.LeftClick(Shift); - mbRight : FCalDrawer.RightClick; - end; + FClickPoint := Point(X, Y); + FClickShift := Shift; + FClickButton := Button; + FDblClickTimer.Enabled := true; end; procedure TCalendarLite.MouseEnter; @@ -1638,21 +1706,22 @@ begin if not FMultiSelect then exit; + if (ssDouble in Shift) then begin + Result := smFirstWeek; + if (ssCtrl in Shift) and (FPrevDate > 0) then + Result := smNextWeek + else if (ssShift in Shift) and (FPrevDate > 0) then + Result := smNextWeekRange + end else if (ssShift in Shift) then begin Result := smFirstRange; if (ssCtrl in Shift) and (FPrevDate > 0) then Result := smNextRange; end else - if (ssAlt in Shift) then begin - Result := smFirstWeek; - if (ssCtrl in Shift) and (FPrevDate > 0) then - Result := smNextWeek; - end else if (ssCtrl in Shift) and (FPrevDate > 0) then Result := smNextSingle; end; - procedure TCalendarLite.SetDate(AValue: TDateTime); var oldMonth: Integer; @@ -1770,6 +1839,16 @@ begin Invalidate; end; +{ The DblClickTimer was triggered by a mouse-down event; its purpose is to + prevent the Click method in addition to the DblClick method. In case of + a single click the TimerExpired event is reached. In case of a double-click + the click handled directly by the DblClick } +procedure TCalendarLite.TimerExpired(Sender: TObject); +begin + FDblClickTimer.Enabled := false; + InternalClick; +end; + procedure TCalendarLite.YearMenuItemClicked(Sender: TObject); begin FCalDrawer.GotoYear(TMenuItem(Sender).Tag);