CalLite: Add event OnDrawCell to override complete painting of date cells. Add example of its usage to demo2,

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

components/callite/demo2/umaintestcallite.lfm

@@ -447,6 +447,15 @@ object Form1: TForm1
       OnClick = BtnFontClick
       TabOrder = 8
     end
+    object CbDrawCell: TCheckBox
+      Left = 560
+      Height = 19
+      Top = 192
+      Width = 161
+      Caption = 'Owner draw (icon, Nov 11)'
+      OnChange = CbDrawCellChange
+      TabOrder = 9
+    end
   end
   object FontDialog: TFontDialog
     MinFontSize = 0
@@ -454,4 +463,43 @@ object Form1: TForm1
     left = 662
     top = 232
   end
+  object ImageList1: TImageList
+    left = 564
+    top = 334
+    Bitmap = {
+      4C69010000001000000010000000FFFFFF00FFFFFF00FFFFFF0000BBC74800C7
+      D3C7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000BBC74800C7
+      D3C7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000D3DAF630F1
+      F3FF00BBC77CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0000D3DAF630F1
+      F3FF00BBC77CFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0007D2D8FF67F5
+      F6FF06D2D8FEFFFFFF0000BBC74800C7D3C7FFFFFF00FFFFFF0007D2D8FF67F5
+      F6FF06D1D7FEFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF0097BCADFF57C4
+      C3FF83B5A8F7C2C2C2DA07D2D9FF30F1F3FF5CBEC5ECC2C2C2B094B19FFF55BF
+      BCFF78A794E5FFFFFF00FFFFFF00FFFFFF00C2C2C224C2C2C28EEDBB9DFFEFC8
+      AFFFE8B696FFF6F6F6FF07D2D8FF67F5F6FF07D2D7FFECECECFFE5A983FFEAB7
+      98FFDB9569EBC2C2C224FFFFFF00FFFFFF00B1C2C6A1E3E3E3FFEBB999FFEEC3
+      AAFFEBB495FFFFFFFFFF94B3A1FF55BFBCFF86B1A0FFFFFFFFFFE5A37BFFE9B2
+      92FFDE9A72FFB1C2C6A1FFFFFF00FFFFFF00BEC2C3FCFCFCFCFFEEC1A6FFEAB2
+      92FFF1CEBBFFFFFFFFFFE6AA85FFEAB898FFE5A57FFFFFFFFFFFE8AF98FFE39D
+      76FFEABEAFFFB9C2C4F8FFFFFF00FFFFFF00B5C2C5FEFAFAFAFFFFFFFFFFFFFF
+      FFFFFFFFFFFFFFFFFFFFE5A47EFFE9B493FFE3A278FFFFFFFFFFFFFFFFFFFDFD
+      FDFFEAEAEAFF7CC9DBFCFFFFFF00FFFFFF0072CEE3FDD7D9DAFFE3E3E3FFFFFF
+      FFFFFFFFFFFFFCFCFCFFE7B098FFE39E78FFEDC2B2FFFFFFFFFFEEEEEEFFD6D8
+      D9FFB5DEE8FF29C7EBFCFFFFFF00FFFFFF000DC5EFFC84E1F7FFD7DBDCFFECEC
+      ECFFE7E7E7FFDFE2E3FFE3E4E4FFE3E4E4FFE3E3E3FFEBEBEBFFDCDFE0FF9BE1
+      F1FF84E1F7FF0DC5EFFCFFFFFF00FFFFFF002C80E6FE67A0ECFF89DCF4FFC2E3
+      EBFFA4E2F1FF86E2F7FF86E2F7FF86E2F7FF8DE2F6FFA8E3F0FF8CE2F5FF83DC
+      F6FF67A0ECFF2C80E6FEFFFFFF00FFFFFF0014B4EDFC5F8FEAFF5372E5FF6396
+      EBFF71B4F0FF7CCDF4FF83DCF6FF83DCF6FF7CCDF4FF71B4F0FF6396EBFF5372
+      E5FF5F8FEAFF14B4EDFCFFFFFF00FFFFFF000DC5EFF882E1F7FF75BEF1FF659A
+      EBFF577CE6FF4C63E2FF4554E0FF4554E0FF4C63E2FF577CE6FF659AEBFF75BE
+      F1FF82E1F7FF0DC5EFF8FFFFFF00FFFFFF000DC5EFA14FD5F3FF81E1F7FF86E2
+      F7FF86E2F7FF86E2F7FF86E2F7FF86E2F7FF86E2F7FF86E2F7FF86E2F7FF81E1
+      F7FF4FD5F3FF0DC5EFA1FFFFFF00FFFFFF000DC5EF240DC5EF8E0DC5EFF747D3
+      F3FF60D9F4FF73DEF6FF80E1F7FF80E1F7FF73DEF6FF60D9F4FF47D3F3FF0DC5
+      EFF70DC5EF8E0DC5EF24FFFFFF00FFFFFF00FFFFFF00FFFFFF000DC5EF3E0DC5
+      EF7C0DC5EFB00DC5EFDA0DC5EFF50DC5EFF50DC5EFDA0DC5EFB00DC5EF7C0DC5
+      EF3EFFFFFF00FFFFFF00FFFFFF00
+    }
+  end
 end

components/callite/demo2/umaintestcallite.pp

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, Forms, Graphics, ExtCtrls, StdCtrls, Spin, Dialogs,
-  CalendarLite;
+  Controls, CalendarLite;
 
 type
 
@@ -30,8 +30,10 @@ type
     CbSelectedDate: TColorButton;
     CbText: TColorButton;
     CbPrepareCanvas: TCheckBox;
+    CbDrawCell: TCheckBox;
     FontDialog: TFontDialog;
     GroupBox1: TGroupBox;
+    ImageList1: TImageList;
     Label10: TLabel;
     Label11: TLabel;
     Label12: TLabel;
@@ -54,6 +56,7 @@ type
     seWidth: TSpinEdit;
     seHeight: TSpinEdit;
     procedure BtnFontClick(Sender: TObject);
+    procedure CbDrawCellChange(Sender: TObject);
     procedure CbPrepareCanvasChange(Sender: TObject);
     procedure ColorButtonChanged(Sender: TObject);
     procedure cbUseHolidaysChange(Sender: TObject);
@@ -70,7 +73,10 @@ type
     procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer;  // wp
       var Holidays: THolidays);
     procedure PrepareCanvas(Sender: TObject; AYear, AMonth, ADay: Word;
-      AState: TCalPrepareCanvasStates; ACanvas: TCanvas);
+      AState: TCalCellStates; ACanvas: TCanvas);
+    procedure DrawCell(Sender: TObject; AYear, AMonth, ADay: Word;
+      AState: TCalCellStates; ARect: TRect; ACanvas: TCanvas;
+      var AContinueDrawing: Boolean);
   end;
 
 var
@@ -81,8 +87,6 @@ implementation
 
 {$R *.lfm}
 
-uses
-  Controls;
 
 function Easter(year:integer) : TDateTime;  // wp
 var
@@ -129,6 +133,9 @@ begin
   if CbPrepareCanvas.Checked then
     demoCal.OnPrepareCanvas := @PrepareCanvas else
     demoCal.OnPrepareCanvas := nil;
+  if CbDrawCell.Checked then
+    demoCal.OnDrawCell := @DrawCell else
+    demoCal.OnDrawCell := nil;
   FNoHolidays:= False;
   for opt in demoCal.Options do
    if (opt in demoCal.Options) then cgOptions.Checked[integer(opt)] := True;
@@ -239,6 +246,14 @@ begin
     demoCal.Font.Assign(FontDialog.Font);
 end;
 
+procedure TForm1.CbDrawCellChange(Sender: TObject);
+begin
+  if CbDrawCell.Checked then
+    demoCal.OnDrawCell := @DrawCell else
+    demoCal.OnDrawCell := nil;
+  demoCal.Invalidate;
+end;
+
 procedure TForm1.CbPrepareCanvasChange(Sender: TObject);
 begin
   if CbPrepareCanvas.Checked then
@@ -280,9 +295,9 @@ begin
 end;
 
 procedure TForm1.PrepareCanvas(Sender: TObject; AYear,AMonth,ADay: word;
-  AState: TCalPrepareCanvasStates; ACanvas: TCanvas);
+  AState: TCalCellStates; ACanvas: TCanvas);
 begin
-  if (ADay = 1) and not (pcsOtherMonth in AState) then
+  if (ADay = 1) and not (csOtherMonth in AState) then
   begin
     ACanvas.Font.Size := 12;
     ACanvas.Font.Style := [fsUnderline, fsItalic, fsBold];
@@ -294,5 +309,21 @@ begin
   end;
 end;
 
+procedure TForm1.DrawCell(Sender: TObject; AYear,AMonth,ADay: Word;
+  AState: TCalCellStates; ARect: TRect; ACanvas: TCanvas;
+  var AContinueDrawing: Boolean);
+var
+  bmp: TBitmap;
+begin
+  if (AMonth = 11) and (ADay = 11) and not (csOtherMonth in AState) then begin
+    bmp := TBitmap.Create;
+    ImageList1.GetBitmap(0, bmp);
+    ACanvas.Draw(ARect.Left, (ARect.Top + ARect.Bottom - bmp.Height) div 2, bmp);
+    inc(ARect.Left, bmp.Width + 2);
+    ACanvas.TextOut(ARect.Left, (ARect.Top + ARect.Bottom - ACanvas.TextHeight('Tg')) div 2, intToStr(ADay));
+    AContinueDrawing := false;  // Skips built-in painting of this day cell
+  end;
+end;
+
 end.
 

components/callite/source/calendarlite.pas

@@ -100,11 +100,15 @@ type
   TGetHolidaysEvent = procedure (Sender: TObject; AMonth, AYear: Integer;
     var Holidays: THolidays) of object;
 
-  TCalPrepareCanvasState = (pcsSelectedDay, pcsToday, pcsOtherMonth);
+  TCalCellState = (csSelectedDay, csToday, csOtherMonth);
-  TCalPrepareCanvasStates = set of TCalPrepareCanvasState;
+  TCalCellStates = set of TCalCellState;
 
   TCalPrepareCanvasEvent = procedure (Sender: TObject; AYear, AMonth, ADay: Word;
-    AState: TCalPrepareCanvasStates; ACanvas: TCanvas) of object;
+    AState: TCalCellStates; ACanvas: TCanvas) of object;
+
+  TCalDrawCellEvent = procedure (Sender: TObject; AYear, AMonth, ADay: Word;
+    AState: TCalCellStates; ARect: TRect; ACanvas: TCanvas;
+    var AContinueDrawing: Boolean) of object;
 
   TCalOption = (coBoldDayNames, coBoldHolidays, coBoldToday, coBoldTopRow,
                 coBoldWeekend, coDayLine, coShowBorder, coShowHolidays,
@@ -194,6 +198,7 @@ type
     FDisplayTexts: TStringList;
     FMonthNames: TStringList;
     FOnDateChange: TNotifyEvent;
+    FOnDrawCell: TCalDrawCellEvent;
     FOnGetHolidays: TGetHolidaysEvent;
     FOnPrepareCanvas: TCalPrepareCanvasEvent;
     FOptions: TCalOptions;
@@ -278,6 +283,7 @@ type
     property OnMouseWheel;
     property OnMouseWheelDown;
     property OnMouseWheelUp;
+
     // new properties
     property Colors: TCalColors read FColors;
     property Date: TDateTime read FDate write SetDate;
@@ -292,8 +298,10 @@ type
       write SetWeekendDays default [dowSunday];
     property Languages: TLanguage read FLanguage
       write SetLanguage default lgEnglish; //Ariel Rodriguez 12/09/2013
+
     // new event properties
     property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange;
+    property OnDrawCell: TCalDrawCellEvent read FOnDrawCell write FOnDrawCell;
     property OnGetHolidays: TGetHolidaysEvent read FOnGetHolidays write FOnGetHolidays;
     property OnPrepareCanvas: TCalPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
   end;
@@ -506,7 +514,8 @@ var
   dt, todayDate: TDateTime;
   oldBrush: TBrush;
   oldPen: TPen;
-  state: TCalPrepareCanvasStates;
+  state: TCalCellStates;
+  continueDrawing: Boolean;
 begin
   todayDate := Date;
   dow := DayOfWeek(FOwner.FDate);
@@ -566,13 +575,13 @@ begin
       begin
         { color of days from previous and next months }
         FCanvas.Font.Color:= FOwner.Colors.PastMonthColor;
-        Include(state, pcsOtherMonth);
+        Include(state, csOtherMonth);
       end;
 
       { Set default background color }
       if (dt = FOwner.FDate) then begin
         FCanvas.Brush.Color:= FOwner.FColors.SelectedDateColor;
-        Include(state, pcsSelectedDay);
+        Include(state, csSelectedDay);
       end else
         FCanvas.Brush.Color:= FOwner.Colors.BackgroundColor;
 
@@ -582,7 +591,7 @@ begin
         FCanvas.Pen.Color := FOwner.Colors.TodayFrameColor;
         FCanvas.Pen.Width := 2;
         FCanvas.Pen.Style := psSolid;
-        Include(state, pcsToday);
+        Include(state, csToday);
       end else
         FCanvas.Pen.Style := psClear;
 
@@ -590,8 +599,15 @@ begin
       oldPen.Assign(FCanvas.Pen);
       oldBrush.Assign(FCanvas.Brush);
       if Assigned(FOwner.FOnPrepareCanvas) then
-        FOwner.FOnPrepareCanvas(Self, y, m, d, state, FCanvas);
+        FOwner.FOnPrepareCanvas(FOwner, y, m, d, state, FCanvas);
 
+      continueDrawing := true;
+      if Assigned(FOwner.FOnDrawCell) then
+        { Custom-draw the cell }
+        FOwner.FOnDrawCell(FOwner, y, m, d, state, rec, FCanvas, continueDrawing);
+
+      if continueDrawing then
+      begin
         { Paint the background of the selected date }
         if (dt = FOwner.FDate) or
           (oldBrush.Color <> FCanvas.Brush.Color) or
@@ -613,6 +629,7 @@ begin
         { Paint the day number }
         s := IntToStr(d);
         FCanvas.TextRect(rec, 0, 0, s, FTStyle);
+      end;
 
       dt:= dt + 1;
     end;  // for c