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
2016-11-07 14:44:08 +00:00
parent 7d38a1fa62
commit 4d79b47a51
3 changed files with 129 additions and 33 deletions
--- a/components/callite/demo2/umaintestcallite.lfm
+++ b/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
--- a/components/callite/demo2/umaintestcallite.pp
+++ b/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.

--- a/components/callite/source/calendarlite.pas
+++ b/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);
-  TCalPrepareCanvasStates = set of TCalPrepareCanvasState;
+  TCalCellState = (csSelectedDay, csToday, csOtherMonth);
+  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
+
+    // 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,29 +599,37 @@ 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);

-      { Paint the background of the selected date }
-      if (dt = FOwner.FDate) or
-        (oldBrush.Color <> FCanvas.Brush.Color) or
-        (oldBrush.Style <> FCanvas.brush.Style) or
-        (oldPen.Color <> FCanvas.Pen.Color) or
-        (oldPen.Style <> FCanvas.Pen.Style) or
-        (oldPen.Width <> FCanvas.Pen.Width)
-      then
-        FCanvas.Rectangle(rec);
+      continueDrawing := true;
+      if Assigned(FOwner.FOnDrawCell) then
+        { Custom-draw the cell }
+        FOwner.FOnDrawCell(FOwner, y, m, d, state, rec, FCanvas, continueDrawing);

-      { Paint the frame around the "today" cell }
-      if (dt = todayDate) and (coShowTodayFrame in FOwner.Options) then
+      if continueDrawing then
      begin
-        Inc(rec.Top);
-        Inc(rec.Bottom);
-        FCanvas.Rectangle(rec);
-      end;
+        { Paint the background of the selected date }
+        if (dt = FOwner.FDate) or
+          (oldBrush.Color <> FCanvas.Brush.Color) or
+          (oldBrush.Style <> FCanvas.brush.Style) or
+          (oldPen.Color <> FCanvas.Pen.Color) or
+          (oldPen.Style <> FCanvas.Pen.Style) or
+          (oldPen.Width <> FCanvas.Pen.Width)
+        then
+          FCanvas.Rectangle(rec);

-      { Paint the day number }
-      s := IntToStr(d);
-      FCanvas.TextRect(rec, 0, 0, s, FTStyle);
+        { Paint the frame around the "today" cell }
+        if (dt = todayDate) and (coShowTodayFrame in FOwner.Options) then
+        begin
+          Inc(rec.Top);
+          Inc(rec.Bottom);
+          FCanvas.Rectangle(rec);
+        end;
+
+        { Paint the day number }
+        s := IntToStr(d);
+        FCanvas.TextRect(rec, 0, 0, s, FTStyle);
+      end;

      dt:= dt + 1;
    end;  // for c