CalLite: Add event OnGetDayText to add additional texts to the days of the calendar (e.g. holiday names, birthdays etc).

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5335 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2016-11-10 09:56:43 +00:00
parent 0500280dad
commit 548fd7a97a
3 changed files with 76 additions and 23 deletions
--- a/components/callite/demo2/umaintestcallite.lfm
+++ b/components/callite/demo2/umaintestcallite.lfm
@ -90,22 +90,22 @@ object Form1: TForm1
      Height = 23
      Top = 87
      Width = 66
-      MaxValue = 430
+      MaxValue = 1000
      MinValue = 120
      OnChange = seWidthChange
      TabOrder = 2
-      Value = 300
+      Value = 400
    end
    object seHeight: TSpinEdit
      Left = 617
      Height = 23
      Top = 120
      Width = 66
-      MaxValue = 250
+      MaxValue = 1000
      MinValue = 120
      OnChange = seHeightChange
      TabOrder = 3
-      Value = 200
+      Value = 300
    end
    object lHeight: TLabel
      Left = 560
@ -432,7 +432,7 @@ object Form1: TForm1
    object CbPrepareCanvas: TCheckBox
      Left = 560
      Height = 19
-      Top = 168
+      Top = 192
      Width = 144
      Caption = 'Override font of 1st day'
      OnChange = CbPrepareCanvasChange
@ -441,7 +441,7 @@ object Form1: TForm1
    object BtnFont: TButton
      Left = 560
      Height = 25
-      Top = 232
+      Top = 272
      Width = 75
      Caption = 'Font...'
      OnClick = BtnFontClick
@ -450,18 +450,38 @@ object Form1: TForm1
    object CbDrawCell: TCheckBox
      Left = 560
      Height = 19
-      Top = 192
+      Top = 216
      Width = 161
      Caption = 'Owner draw (icon, Nov 11)'
      OnChange = CbDrawCellChange
      TabOrder = 9
    end
+    object CbAddHolidayNameToCell: TCheckBox
+      Left = 560
+      Height = 19
+      Top = 168
+      Width = 152
+      Caption = 'Add holiday name to cell'
+      OnChange = CbAddHolidayNameToCellChange
+      TabOrder = 10
+    end
+    object CbShowHints: TCheckBox
+      Left = 560
+      Height = 19
+      Top = 240
+      Width = 92
+      Caption = 'CbShowHints'
+      Checked = True
+      OnChange = CbShowHintsChange
+      State = cbChecked
+      TabOrder = 11
+    end
  end
  object FontDialog: TFontDialog
    MinFontSize = 0
    MaxFontSize = 0
-    left = 662
-    top = 232
+    left = 664
+    top = 272
  end
  object ImageList1: TImageList
    left = 564
--- a/components/callite/demo2/umaintestcallite.pp
+++ b/components/callite/demo2/umaintestcallite.pp
@ -31,6 +31,8 @@ type
    CbText: TColorButton;
    CbPrepareCanvas: TCheckBox;
    CbDrawCell: TCheckBox;
+    CbAddHolidayNameToCell: TCheckBox;
+    CbShowHints: TCheckBox;
    FontDialog: TFontDialog;
    GroupBox1: TGroupBox;
    ImageList1: TImageList;
@ -56,8 +58,10 @@ type
    seWidth: TSpinEdit;
    seHeight: TSpinEdit;
    procedure BtnFontClick(Sender: TObject);
+    procedure CbAddHolidayNameToCellChange(Sender: TObject);
    procedure CbDrawCellChange(Sender: TObject);
    procedure CbPrepareCanvasChange(Sender: TObject);
+    procedure CbShowHintsChange(Sender: TObject);
    procedure ColorButtonChanged(Sender: TObject);
    procedure cbUseHolidaysChange(Sender: TObject);
    procedure cgOptionsItemClick(Sender: TObject; Index: integer);
@ -70,7 +74,8 @@ type
    copyCal, demoCal: TCalendarLite;
    FNoHolidays: boolean;
    procedure RespondToDateChange(Sender: tObject);
-    procedure GetHint(Sender: TObject; AYear, AMonth, ADay: Word; out AHintText: String);
+    procedure GetDayText(Sender: TObject; AYear, AMonth, ADay: Word; var AText: String);
+    procedure GetHintText(Sender: TObject; AYear, AMonth, ADay: Word; var AText: String);
    procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer;  // wp
      var Holidays: THolidays);
    procedure PrepareCanvas(Sender: TObject; ACanvas: TCanvas;
@ -132,7 +137,7 @@ begin
  demoCal.Height := seHeight.Value;
  demoCal.OnGetHolidays := @GetHolidays;
  demoCal.OnDateChange:= @RespondToDateChange;
-  demoCal.OnHint := @GetHint;
+  demoCal.OnHint := @GetHintText;
  demoCal.ShowHint := true;
  demoCal.Hint := 'Calendar';
  if CbPrepareCanvas.Checked then
@ -244,6 +249,14 @@ begin
  else demoCal.Options := demoCal.Options + [opt];
 end;

+procedure TForm1.CbAddHolidayNameToCellChange(Sender: TObject);
+begin
+  if CbAddHolidayNameToCell.Checked then
+    demoCal.OnGetDayText := @GetDayText else
+    demoCal.OnGetDayText := nil;
+  demoCal.Invalidate;
+end;
+
 procedure TForm1.BtnFontClick(Sender: TObject);
 begin
  FontDialog.Font.Assign(demoCal.Font);
@ -267,26 +280,42 @@ begin
  demoCal.Invalidate;
 end;

+procedure TForm1.CbShowHintsChange(Sender: TObject);
+begin
+  demoCal.ShowHint := CbShowHints.Checked;
+end;
+
 procedure TForm1.RespondToDateChange(Sender: tObject);
 begin
  copyCal.Date:= TCalendarLite(Sender).Date;
 end;

-procedure TForm1.GetHint(Sender: TObject; AYear, AMonth, ADay: Word;
-  out AHintText: String);
+procedure TForm1.GetDayText(Sender: TObject; AYear, AMonth, ADay: Word;
+  var AText: String);
+var
+  s: String;
+begin
+  GetHintText(Sender, AYear, AMonth, ADay, s);
+  if s <> '' then
+    AText := IntToStr(ADay) + LineEnding + s;
+end;
+
+procedure TForm1.GetHintText(Sender: TObject; AYear, AMonth, ADay: Word;
+  var AText: String);
 var
  dt, e: TDate;
 begin
+  AText := '';
  case AMonth of
-    1: if ADay = 1 then AHintText := 'New Year';
-   12: if ADay = 25 then AHintText := 'Christmas';
+    1: if ADay = 1 then AText := 'New Year';
+   12: if ADay = 25 then AText := 'Christmas';
   else
       e := Easter(AYear);
       dt := EncodeDate(AYear, AMonth, ADay);
       if (dt = e) then
-         AHintText := 'Easter'
+         AText := 'Easter'
       else if (dt = e + 49) then
-         AHintText := 'Whit Sunday';
+         AText := 'Whit Sunday';
  end;
 end;

--- a/components/callite/source/calendarlite.pas
+++ b/components/callite/source/calendarlite.pas
@ -57,9 +57,9 @@ const
  DefMinWidth = 120;
  DefaultDisplayText = 'Today is,dd/mm/yyyy,Holidays during,There are no holidays set for';
  DefTStyle: TTextStyle = (Alignment  : taCenter; Layout     : tlCenter;
-                           SingleLine : True;     Clipping   : True;
+                           SingleLine : False;    Clipping   : True;
                           ExpandTabs : False;    ShowPrefix : False;
-                           Wordbreak  : False;    Opaque     : False;
+                           Wordbreak  : True;     Opaque     : False;
                           SystemFont : False;    RightToLeft: False;
                           EndEllipsis: False);

@ -110,8 +110,8 @@ type
    AYear, AMonth, ADay: Word; AState: TCalCellStates; var ARect: TRect;
    var AContinueDrawing: Boolean) of object;

-  TCalHintEvent = procedure (Sender: TObject; AYear, AMonth, ADay: Word;
-    out AHintText: String) of object;
+  TCalGetDayTextEvent = procedure (Sender: TObject; AYear, AMonth, ADay: Word;
+    var AText: String) of object;

  TCalOption = (coBoldDayNames, coBoldHolidays, coBoldToday, coBoldTopRow,
                coBoldWeekend, coDayLine, coShowBorder, coShowHolidays,
@ -201,9 +201,10 @@ type
    FDisplayTexts: TStringList;
    FMonthNames: TStringList;
    FOnDateChange: TNotifyEvent;
+    FOnGetDayText: TCalGetDayTextEvent;
    FOnDrawCell: TCalDrawCellEvent;
    FOnGetHolidays: TGetHolidaysEvent;
-    FOnHint: TCalHintEvent;
+    FOnHint: TCalGetDayTextEvent;
    FOnPrepareCanvas: TCalPrepareCanvasEvent;
    FOptions: TCalOptions;
    FPopupMenu: TPopupMenu;
@ -316,8 +317,9 @@ type
    // new event properties
    property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange;
    property OnDrawCell: TCalDrawCellEvent read FOnDrawCell write FOnDrawCell;
+    property OnGetDayText: TCalGetDayTextEvent read FOnGetDayText write FOnGetDayText;
    property OnGetHolidays: TGetHolidaysEvent read FOnGetHolidays write FOnGetHolidays;
-    property OnHint: TCalHintEvent read FOnHint write FOnHint;
+    property OnHint: TCalGetDayTextEvent read FOnHint write FOnHint;
    property OnPrepareCanvas: TCalPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
  end;

@ -643,6 +645,8 @@ begin

        { Paint the day number }
        s := IntToStr(d);
+        if Assigned(FOwner.FOnGetDayText) then
+          FOwner.FOnGetDayText(FOwner, y, m, d, s);
        FCanvas.TextRect(rec, 0, 0, s, FTStyle);
      end;