CalLite: Add MultiSelect support (ctrl: add single date, shift: add date range, alt: add week)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5339 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/callite/demo2/testCalLite.lpi

@@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <Version Value="9"/>
+    <Version Value="10"/>
     <PathDelim Value="\"/>
     <General>
       <SessionStorage Value="InProjectDir"/>

components/callite/demo2/umaintestcallite.lfm

@@ -441,7 +441,7 @@ object Form1: TForm1
     object BtnFont: TButton
       Left = 560
       Height = 25
-      Top = 272
+      Top = 8
       Width = 75
       Caption = 'Font...'
       OnClick = BtnFontClick
@@ -476,16 +476,34 @@ object Form1: TForm1
       State = cbChecked
       TabOrder = 11
     end
+    object CbMultiSelect: TCheckBox
+      Left = 560
+      Height = 19
+      Top = 264
+      Width = 81
+      Caption = 'Multi select'
+      OnChange = CbMultiSelectChange
+      TabOrder = 12
+    end
+    object SelDateListbox: TListBox
+      Left = 560
+      Height = 104
+      Top = 288
+      Width = 168
+      Columns = 2
+      ItemHeight = 0
+      TabOrder = 13
+    end
   end
   object FontDialog: TFontDialog
     MinFontSize = 0
     MaxFontSize = 0
-    left = 664
+    left = 408
-    top = 272
+    top = 416
   end
   object ImageList1: TImageList
-    left = 564
+    left = 336
-    top = 334
+    top = 432
     Bitmap = {
       4C69010000001000000010000000FFFFFF00FFFFFF00FFFFFF0000BBC74800C7
       D3C7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000BBC74800C7

components/callite/demo2/umaintestcallite.pp

@@ -33,6 +33,7 @@ type
     CbDrawCell: TCheckBox;
     CbAddHolidayNameToCell: TCheckBox;
     CbShowHints: TCheckBox;
+    CbMultiSelect: TCheckBox;
     FontDialog: TFontDialog;
     GroupBox1: TGroupBox;
     ImageList1: TImageList;
@@ -49,6 +50,7 @@ type
     Label7: TLabel;
     Label8: TLabel;
     Label9: TLabel;
+    SelDateListbox: TListBox;
     LTitle: TLabel;
     LWidth: TLabel;
     lHeight: TLabel;
@@ -60,6 +62,7 @@ type
     procedure BtnFontClick(Sender: TObject);
     procedure CbAddHolidayNameToCellChange(Sender: TObject);
     procedure CbDrawCellChange(Sender: TObject);
+    procedure CbMultiSelectChange(Sender: TObject);
     procedure CbPrepareCanvasChange(Sender: TObject);
     procedure CbShowHintsChange(Sender: TObject);
     procedure ColorButtonChanged(Sender: TObject);
@@ -274,6 +277,11 @@ begin
   demoCal.Invalidate;
 end;
 
+procedure TForm1.CbMultiSelectChange(Sender: TObject);
+begin
+  demoCal.MultiSelect := CbMultiSelect.Checked;
+end;
+
 procedure TForm1.CbPrepareCanvasChange(Sender: TObject);
 begin
   if CbPrepareCanvas.Checked then
@@ -288,8 +296,17 @@ begin
 end;
 
 procedure TForm1.RespondToDateChange(Sender: tObject);
+var
+  s: TCalDateArray;
+  i: Integer;
 begin
   copyCal.Date:= TCalendarLite(Sender).Date;
+
+  s := demoCal.SelectedDates;
+  SelDateListbox.Clear;
+  for i:=0 to High(s) do
+    SelDateListbox.Items.Add(DateToStr(s[i]));
+
 end;
 
 procedure TForm1.GetDayText(Sender: TObject; AYear, AMonth, ADay: Word;

components/callite/source/calendarlite.pas

@@ -140,8 +140,35 @@ type
                 coShowWeekend, coUseTopRowColors);
   TCalOptions = set of TCalOption;
 
+  TCalDateArray = array of TDate;
+
+  TCalSelMode = (smFirstSingle, smNextSingle, smFirstRange, smNextRange, smFirstWeek, smNextWeek);
+
   TLanguage = (lgEnglish, lgFrench, lgGerman, lgHebrew, lgSpanish); //Ariel Rodriguez 12/09/2013
 
+  { TCalDateList }
+
+  TCalDateList = class
+  private
+    FList: TFPList;
+    function GetCount: Integer;
+    function GetDate(AIndex: Integer): TDate;
+    procedure SetDate(AIndex: Integer; AValue: TDate);
+  protected
+    procedure Sort;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    procedure AddDate(ADate: TDate);
+    function AsArray: TCalDateArray;
+    procedure Clear;
+    procedure DeleteDate(ADate: TDate);
+    function IndexOfDate(ADate: TDate): Integer;
+    procedure Insert(AIndex: Integer; ADate: TDate);
+    property Count: Integer read GetCount;
+    property Values[AIndex: Integer]: TDate read GetDate write SetDate; default;
+  end;
+
   { TCalDrawer }
 
   TCalDrawer = class
@@ -158,7 +185,7 @@ type
     FThisYear: word;
     FTStyle: TTextStyle;
     procedure CalcSettings;
-    procedure ChangeDateTo(ACell: TSize);
+//    procedure ChangeDateTo(ACell: TSize; AddToSel: Boolean = false);
     procedure DrawArrow(ARect: TRect; AHead: TArrowhead; ADirec: TArrowDirection);
     procedure DrawDayCells;
     procedure DrawDayLabels;
@@ -175,8 +202,8 @@ type
     procedure GotoMonth(AMonth: word);
     procedure GotoToday;
     procedure GotoYear(AYear: word);
-    procedure LeftClick;
+    procedure LeftClick(Shift: TShiftState);
-    procedure RightClick;
+    procedure RightClick(Shift: TShiftState);
   public
     constructor Create(ACanvas: TCanvas);
     procedure Draw;
@@ -232,7 +259,10 @@ type
     FStartingDayOfWeek: TDayOfWeek;
     FWeekendDays: TDaysOfWeek;
     FPrevMouseDate: TDate;
+    FPrevDate: TDate;
     FSavedHint: String;
+    FMultiSelect: Boolean;
+    FSelDates: TCalDateList;
     FLanguage: TLanguage; //Ariel Rodriguez 12/09/2013
     procedure DateChange;
     function GetDayNames: String;
@@ -248,6 +278,7 @@ type
     procedure SetDefaultDisplayTexts;
     procedure SetDisplayTexts(AValue: String);
     procedure SetMonthNames(const AValue: String);
+    procedure SetMultiSelect(AValue: Boolean);
     procedure SetOptions(AValue: TCalOptions);
     procedure SetStartingDayOfWeek(AValue: TDayOfWeek);
     procedure SetWeekendDays(AValue: TDaysOfWeek);
@@ -255,6 +286,7 @@ type
     procedure SetLanguage(AValue: TLanguage); //Ariel Rodriguez 12/09/2013
 
   protected
+    procedure ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
     class function GetControlClassDefaultSize: TSize; override;
     function GetDayName(ADayOfWeek: TDayOfWeek): String;
     function GetDisplayText(aTextIndex: TDisplayText): String;
@@ -264,6 +296,7 @@ type
     procedure MouseEnter; override;
     procedure MouseLeave; override;
     procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
+    function SelMode(Shift: TShiftState): TCalSelMode;
 
     procedure Paint; override;
 
@@ -275,6 +308,9 @@ type
     constructor Create(anOwner: TComponent); override;
     destructor Destroy; override;
 
+    function IsSelected(ADate: TDate): Boolean;
+    function SelectedDates: TCalDateArray;
+
   published
     property Align;
     property Anchors;
@@ -326,6 +362,7 @@ type
     property DayNames: String read GetDayNames write SetDayNames;
     property DisplayTexts: String read GetDisplaytexts write SetDisplayTexts;
     property MonthNames: String read GetMonthnames write SetMonthNames;
+    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect;
     property Options: TCalOptions read FOptions write SetOptions
       default [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays, coShowTodayRow];
     property StartingDayOfWeek: TDayOfWeek read FStartingDayOfWeek
@@ -377,6 +414,143 @@ begin
 end;
 
 
+{ TCalSortedDateList }
+
+type
+  TDateItem = TDate;
+  PDateItem = ^TDateItem;
+
+function CompareDates(P1, P2: Pointer): Integer;
+begin
+  Result := CompareDate(PDateItem(P1)^, PDateItem(P2)^);
+end;
+
+constructor TCalDateList.Create;
+begin
+  inherited;
+  FList := TFPList.Create;
+end;
+
+destructor TCalDateList.Destroy;
+begin
+  Clear;
+  FList.Free;
+  inherited;
+end;
+
+procedure TCalDateList.AddDate(ADate: TDate);
+var
+  i: Integer;
+  P: PDateItem;
+begin
+  i := IndexOfDate(ADate);
+  if i > -1 then begin
+    P := PDateItem(FList.Items[i]);
+    Dispose(P);
+    FList.Delete(i);
+    exit;
+  end;
+
+  // Assume that the list is sorted
+  for i:= FList.Count-1 downto 0 do begin
+    P := PDateItem(FList.Items[i]);
+    // Add new date
+    if P^ < ADate then begin
+      Insert(i+1, ADate);   // meaning: "insert BEFORE index i"
+      exit;
+    end;
+  end;
+  Insert(0, ADate);
+end;
+
+function TCalDateList.AsArray: TCalDateArray;
+var
+  i: Integer;
+begin
+  SetLength(Result, Count);
+  for i:=0 to High(Result) do
+    Result[i] := Values[i];
+end;
+
+procedure TCalDateList.Clear;
+var
+  i: Integer;
+  P: PDateItem;
+begin
+  for i := FList.Count-1 downto 0 do begin
+    P := PDateItem(FList.Items[i]);
+    Dispose(P);
+    FList.Delete(i);
+  end;
+  FList.Clear;
+end;
+
+procedure TCalDateList.DeleteDate(ADate: TDate);
+var
+  i: Integer;
+  P: PDateItem;
+begin
+  i := IndexOfDate(ADate);
+  if i > -1 then begin
+    P := PDateItem(FList.Items[i]);
+    Dispose(P);
+    FList.Delete(i);
+  end;
+end;
+
+function TCalDateList.GetCount: Integer;
+begin
+  Result := FList.Count;
+end;
+
+function TCalDateList.GetDate(AIndex: Integer): TDate;
+var
+  P: PDateItem;
+begin
+  P := PDateItem(FList.Items[AIndex]);
+  Result := P^;
+end;
+
+function TCalDateList.IndexOfDate(ADate: TDate): Integer;
+// to do: Since the list is always ordered use a binary search here
+var
+  i: Integer;
+begin
+  for i:=0 to FList.Count-1 do
+    if SameDate(GetDate(i), ADate) then begin
+      Result := i;
+      exit;
+    end;
+  Result := -1;
+end;
+
+procedure TCalDateList.Insert(AIndex: Integer; ADate: TDate);
+var
+  P: PDateItem;
+begin
+  New(P);
+  P^ := ADate;
+  if AIndex >= FList.Count then
+    FList.Add(P)
+  else
+    FList.Insert(AIndex, P);
+end;
+
+procedure TCalDateList.SetDate(AIndex: Integer; AValue: TDate);
+var
+  P: PDateItem;
+begin
+  P := PDateItem(FList.Items[AIndex]);
+  P^ := AValue;
+  Sort;
+end;
+
+procedure TCalDateList.Sort;
+begin
+  FList.Sort(@CompareDates);
+end;
+
+
 { TCalDrawer }
 
 constructor TCalDrawer.Create(ACanvas: TCanvas);
@@ -447,12 +621,12 @@ begin
   if (LastRow = TodayRow) then
    FRowPositions[TodayRow] := FRowPositions[LastDateRow] + borderv + ch + rem;
 end;
-
+                          {
-procedure TCalDrawer.ChangeDateTo(ACell: TSize);
+procedure TCalDrawer.ChangeDateTo(ACell: TSize; AddToSel: Boolean = false);
 var
   diff: integer;
   newDate: TDateTime;
-  d, m, y: word;
+  //d, m, y: word;
 begin
   diff := ACell.cx + LastCol * (ACell.cy - 2);
   newDate := FStartDate + diff - 1;
@@ -461,8 +635,8 @@ begin
   FCanvas.Brush.Color := FOwner.Colors.BackgroundColor;
   FCanvas.FillRect(FBoundsRect);
   Draw;
-  DecodeDate(newDate, y, m, d);
+  //DecodeDate(newDate, y, m, d);
-end;
+end;                       }
 
 procedure TCalDrawer.Draw;
 begin
@@ -617,7 +791,7 @@ begin
       end;
 
       { Set default background color }
-      if (dt = FOwner.FDate) then begin
+      if FOwner.IsSelected(dt) then begin
         FCanvas.Brush.Color:= FOwner.FColors.SelectedDateColor;
         Include(state, csSelectedDay);
       end else
@@ -647,7 +821,7 @@ begin
       if continueDrawing then
       begin
         { Paint the background of the selected date }
-        if (dt = FOwner.FDate) or
+        if FOwner.IsSelected(dt) or
           (oldBrush.Color <> FCanvas.Brush.Color) or
           (oldBrush.Style <> FCanvas.brush.Style) or
           (oldPen.Color <> FCanvas.Pen.Color) or
@@ -1000,12 +1174,14 @@ begin
   FOwner.Date := d;
 end;
 
-procedure TCalDrawer.LeftClick;
+procedure TCalDrawer.LeftClick(Shift: TShiftState);
 var
   p, ppopup: TPoint;
   cell: TSize;
   Rm, Ry: TRect;
+  sm: TCalSelMode;
 begin
+  sm := FOwner.SelMode(Shift);
   p := FOwner.ScreenToClient(Mouse.CursorPos);
   cell := GetCellAt(p);
   case cell.cy of
@@ -1034,14 +1210,14 @@ begin
     DayRow: ;
 
     FirstDateRow..LastDateRow :
-      ChangeDateTo(cell);
+      FOwner.ChangeDateTo(GetDateOfCell(cell), sm);
 
     else
       GotoToday;
   end;
 end;
 
-procedure TCalDrawer.RightClick;
+procedure TCalDrawer.RightClick(Shift: TShiftState);
 begin
   if Assigned(FOwner.FOnGetHolidays) then
   begin
@@ -1090,8 +1266,8 @@ end;
 constructor TCalendarLite.Create(anOwner: TComponent);
 begin
   inherited Create(anOwner);
+  FSelDates := TCalDateList.Create;
   FColors := TCalColors.Create(self);
-  FDate := SysUtils.Date;
   Color := clWhite;
   FStartingDayOfWeek:= dowSunday;
   with GetControlClassDefaultSize do
@@ -1114,10 +1290,12 @@ begin
                coShowTodayRow];
   SetLanguage(lgEnglish); //Ariel Rodriguez 12/09/2013
   FPrevMouseDate := 0;
+  Date := SysUtils.Date;
 end;
 
 destructor TCalendarLite.Destroy;
 begin
+  FreeAndNil(FSelDates);
   FreeAndNil(FDayNames);
   FreeAndNil(FMonthNames);
   FreeAndNil(FDisplayTexts);
@@ -1127,6 +1305,59 @@ begin
   inherited Destroy;
 end;
 
+procedure TCalendarLite.ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
+var
+  d, d1, d2: TDate;
+begin
+  FDate := ADate;
+
+  case ASelMode of
+    smFirstSingle:
+      begin
+        FSelDates.Clear;
+        FSelDates.AddDate(ADate);
+      end;
+
+    smNextSingle:
+      FSelDates.AddDate(ADate);
+
+    smFirstRange, smNextRange,
+    smFirstWeek, smNextWeek:
+      begin
+        if (ASelMode = smFirstRange) or (ASelMode = smFirstWeek) then
+          FSelDates.Clear;
+        if (ASelMode = smFirstRange) or (ASelMode = smNextRange) then begin
+          if FPrevDate < ADate then begin
+            d1 := FPrevDate;
+            d2 := ADate;
+          end else begin
+            d1 := ADate;
+            d2 := FPrevDate;
+          end;
+        end else
+        if (ASelMode = smFirstWeek) or (ASelMode = smNextWeek) then begin
+          d1 := ADate;
+          while DayOfWeek(d1) <> ord(dowMonday) do d1 := d1 - 1;
+          d2 := ADate;
+          while DayOfWeek(d2) <> ord(dowFriday) do d2 := d2 + 1;
+        end;
+        d := d1;
+        while (d <= d2) do begin
+          FSelDates.AddDate(d);
+          d := d + 1;
+        end;
+      end;
+  end;
+
+  FPrevDate := ADate;
+  DateChange;
+  with FCalDrawer do begin
+    FCanvas.Brush.Color := Colors.BackgroundColor;
+    FCanvas.FillRect(FBoundsRect);
+    Draw;
+  end;
+end;
+
 procedure TCalendarLite.DateChange;
 begin
   if Assigned(FOnDateChange) then
@@ -1178,6 +1409,14 @@ begin
   FCalDrawer.GotoDay(TMenuItem(Sender).Tag);
 end;
 
+function TCalendarLite.IsSelected(ADate: TDate): Boolean;
+begin
+  if FMultiSelect then
+    Result := FSelDates.IndexOfDate(ADate) > -1
+  else
+    Result := (ADate = FDate);
+end;
+
 procedure TCalendarLite.KeyDown(var Key: Word; Shift: TShiftState);
 
   function Delta(Increase: Boolean): Integer;
@@ -1185,16 +1424,21 @@ procedure TCalendarLite.KeyDown(var Key: Word; Shift: TShiftState);
     if Increase then Result := +1 else Result := -1;
   end;
 
+var
+  sm: TCalSelMode;
+
 begin
+  sm := SelMode(Shift);
+
   case Key of
     VK_UP,
-    VK_DOWN  : Date := IncWeek(FDate, Delta(Key = VK_DOWN));
+    VK_DOWN  : ChangeDateTo(IncWeek(FDate, Delta(Key = VK_DOWN)), sm);
     VK_LEFT,
-    VK_RIGHT : Date := IncDay(FDate, Delta(Key = VK_RIGHT));
+    VK_RIGHT : ChangeDateTo(IncDay(FDate, Delta(Key = VK_RIGHT)), sm);
-    VK_HOME  : Date := StartOfTheMonth(FDate);
+    VK_HOME  : ChangeDateTo(StartOfTheMonth(FDate), sm);
-    VK_END   : Date := EndOfTheMonth(FDate);
+    VK_END   : ChangeDateTo(EndOfTheMonth(FDate), sm);
     VK_PRIOR,
-    VK_NEXT  : if (ssCtrl in Shift) then
+    VK_NEXT  : if not FMultiSelect and (ssCtrl in Shift) then
                  Date := IncYear(FDate, Delta(Key = VK_NEXT)) else
                  Date := IncMonth(FDate, Delta(Key = VK_NEXT));
     else       inherited;
@@ -1214,8 +1458,8 @@ begin
     SetFocus;
 
   case Button of
-    mbLeft  : FCalDrawer.LeftClick;
+    mbLeft  : FCalDrawer.LeftClick(Shift);
-    mbRight : FCalDrawer.RightClick;
+    mbRight : FCalDrawer.RightClick(Shift);
   end;
 end;
 
@@ -1386,10 +1630,38 @@ begin
   end;
 end;
 
+function TCalendarLite.SelectedDates: TCalDateArray;
+begin
+  Result := FSelDates.AsArray;
+end;
+
+function TCalendarLite.SelMode(Shift: TShiftState): TCalSelMode;
+begin
+  Result := smFirstSingle;
+  if not FMultiSelect then
+    exit;
+
+  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);
 begin
   if FDate = AValue then Exit;
   FDate := AValue;
+  FPrevDate := AValue;
+  FSelDates.Clear;
   DateChange;
   Invalidate;
 end;
@@ -1460,6 +1732,18 @@ begin
   Invalidate;
 end;
 
+procedure TCalendarLite.SetMultiSelect(AValue: Boolean);
+var
+  d: TDate;
+begin
+  if AValue = FMultiSelect then
+    exit;
+  FMultiSelect := AValue;
+  FSelDates.Clear;
+  FSelDates.AddDate(FDate);
+  FPrevDate := FDate;
+end;
+
 procedure TCalendarLite.SetStartingDayOfWeek(AValue: TDayOfWeek);
 begin
   if FStartingDayOfWeek = AValue then Exit;