diff --git a/components/callite/demo2/umaintestcallite.lfm b/components/callite/demo2/umaintestcallite.lfm index b6cc494dc..0ed125da5 100644 --- 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 diff --git a/components/callite/demo2/umaintestcallite.pp b/components/callite/demo2/umaintestcallite.pp index 252ae3f56..dbf7320e7 100644 --- 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. diff --git a/components/callite/source/calendarlite.pas b/components/callite/source/calendarlite.pas index 66fab09c1..53fb3e628 100644 --- 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