pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

CalLite: Add event OnPrepareCanvas to override day formatting.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5321 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-11-06 22:29:40 +00:00
parent 4ac2ecd5ec
commit e36f26bc92
3 changed files with 170 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

28
components/callite/demo2/umaintestcallite.lfm
View File

@ -1,7 +1,7 @@
object Form1: TForm1
Left = 687
Left = 700
Height = 845
Top = 88
Top = 122
Width = 753
Caption = 'Examples of the TCalendaLite component'
ClientHeight = 845
@ -429,5 +429,29 @@ object Form1: TForm1
ParentColor = False
end
end
object CbPrepareCanvas: TCheckBox
Left = 560
Height = 19
Top = 168
Width = 144
Caption = 'Override font of 1st day'
OnChange = CbPrepareCanvasChange
TabOrder = 7
end
object BtnFont: TButton
Left = 560
Height = 25
Top = 232
Width = 75
Caption = 'Font...'
OnClick = BtnFontClick
TabOrder = 8
end
end
object FontDialog: TFontDialog
MinFontSize = 0
MaxFontSize = 0
left = 662
top = 232
end
end

44
components/callite/demo2/umaintestcallite.pp
View File

@ -13,6 +13,7 @@ type
{ TForm1 }
TForm1 = class(TForm)
BtnFont: TButton;
cbUseHolidays: TCheckBox;
cgOptions: TCheckGroup;
CbArrowBorder: TColorButton;
@ -28,6 +29,8 @@ type
CbPastMonth: TColorButton;
CbSelectedDate: TColorButton;
CbText: TColorButton;
CbPrepareCanvas: TCheckBox;
FontDialog: TFontDialog;
GroupBox1: TGroupBox;
Label10: TLabel;
Label11: TLabel;
@ -50,6 +53,8 @@ type
rgStartingDOW: TRadioGroup;
seWidth: TSpinEdit;
seHeight: TSpinEdit;
procedure BtnFontClick(Sender: TObject);
procedure CbPrepareCanvasChange(Sender: TObject);
procedure ColorButtonChanged(Sender: TObject);
procedure cbUseHolidaysChange(Sender: TObject);
procedure cgOptionsItemClick(Sender: TObject; Index: integer);
@ -64,6 +69,8 @@ type
procedure RespondToDateChange(Sender: tObject);
procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer; // wp
var Holidays: THolidays);
procedure PrepareCanvas(Sender: TObject; AYear, AMonth, ADay: Word;
AState: TCalPrepareCanvasStates; ACanvas: TCanvas);
end;
var
@ -74,6 +81,8 @@ implementation
{$R *.lfm}
uses
Controls;
function Easter(year:integer) : TDateTime; // wp
var
@ -117,6 +126,9 @@ begin
demoCal.Height := seHeight.Value;
demoCal.OnGetHolidays := @GetHolidays;
demoCal.OnDateChange:= @RespondToDateChange;
if CbPrepareCanvas.Checked then
demoCal.OnPrepareCanvas := @PrepareCanvas else
demoCal.OnPrepareCanvas := nil;
FNoHolidays:= False;
for opt in demoCal.Options do
if (opt in demoCal.Options) then cgOptions.Checked[integer(opt)] := True;
@ -190,7 +202,7 @@ begin
col := (Sender as TColorButton).ButtonColor;
case (Sender as TColorButton).Name of
'CbArrowBorder': calendar.Colors.ArrowBorderColor := col;
'CbArror': calendar.Colors.ArrowColor := col;
'CbArrow': calendar.Colors.ArrowColor := col;
'CbBackground': calendar.Colors.BackgroundColor := col;
'CbBorder': calendar.Colors.BorderColor := col;
'CbDayLine': calendar.Colors.DayLineColor := col;
@ -220,6 +232,21 @@ begin
else demoCal.Options := demoCal.Options + [opt];
end;
procedure TForm1.BtnFontClick(Sender: TObject);
begin
FontDialog.Font.Assign(demoCal.Font);
if FontDialog.Execute then
demoCal.Font.Assign(FontDialog.Font);
end;
procedure TForm1.CbPrepareCanvasChange(Sender: TObject);
begin
if CbPrepareCanvas.Checked then
demoCal.OnPrepareCanvas := @PrepareCanvas else
demoCal.OnPrepareCanvas := nil;
demoCal.Invalidate;
end;
procedure TForm1.RespondToDateChange(Sender: tObject);
begin
copyCal.Date:= TCalendarLite(Sender).Date;
@ -252,5 +279,20 @@ begin
end;
end;
procedure TForm1.PrepareCanvas(Sender: TObject; AYear,AMonth,ADay: word;
AState: TCalPrepareCanvasStates; ACanvas: TCanvas);
begin
if (ADay = 1) and not (pcsOtherMonth in AState) then
begin
ACanvas.Font.Size := 12;
ACanvas.Font.Style := [fsUnderline, fsItalic, fsBold];
ACanvas.Font.Color := clGreen;
ACanvas.Brush.Color := clSilver;
ACanvas.Brush.Style := bsFDiagonal;
ACanvas.Pen.Color := clSilver;
ACanvas.Pen.Style := psSolid;
end;
end;
end.