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

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5335 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-11-10 09:56:43 +00:00
parent 0500280dad
commit 548fd7a97a
3 changed files with 76 additions and 23 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -90,22 +90,22 @@ object Form1: TForm1
Height = 23 Height = 23
Top = 87 Top = 87
Width = 66 Width = 66
MaxValue = 430 MaxValue = 1000
MinValue = 120 MinValue = 120
OnChange = seWidthChange OnChange = seWidthChange
TabOrder = 2 TabOrder = 2
Value = 300 Value = 400
end end
object seHeight: TSpinEdit object seHeight: TSpinEdit
Left = 617 Left = 617
Height = 23 Height = 23
Top = 120 Top = 120
Width = 66 Width = 66
MaxValue = 250 MaxValue = 1000
MinValue = 120 MinValue = 120
OnChange = seHeightChange OnChange = seHeightChange
TabOrder = 3 TabOrder = 3
Value = 200 Value = 300
end end
object lHeight: TLabel object lHeight: TLabel
Left = 560 Left = 560
@ -432,7 +432,7 @@ object Form1: TForm1
object CbPrepareCanvas: TCheckBox object CbPrepareCanvas: TCheckBox
Left = 560 Left = 560
Height = 19 Height = 19
Top = 168 Top = 192
Width = 144 Width = 144
Caption = 'Override font of 1st day' Caption = 'Override font of 1st day'
OnChange = CbPrepareCanvasChange OnChange = CbPrepareCanvasChange
@ -441,7 +441,7 @@ object Form1: TForm1
object BtnFont: TButton object BtnFont: TButton
Left = 560 Left = 560
Height = 25 Height = 25
Top = 232 Top = 272
Width = 75 Width = 75
Caption = 'Font...' Caption = 'Font...'
OnClick = BtnFontClick OnClick = BtnFontClick
@ -450,18 +450,38 @@ object Form1: TForm1
object CbDrawCell: TCheckBox object CbDrawCell: TCheckBox
Left = 560 Left = 560
Height = 19 Height = 19
Top = 192 Top = 216
Width = 161 Width = 161
Caption = 'Owner draw (icon, Nov 11)' Caption = 'Owner draw (icon, Nov 11)'
OnChange = CbDrawCellChange OnChange = CbDrawCellChange
TabOrder = 9 TabOrder = 9
end 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 end
object FontDialog: TFontDialog object FontDialog: TFontDialog
MinFontSize = 0 MinFontSize = 0
MaxFontSize = 0 MaxFontSize = 0
left = 662 left = 664
top = 232 top = 272
end end
object ImageList1: TImageList object ImageList1: TImageList
left = 564 left = 564

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

@ -31,6 +31,8 @@ type
CbText: TColorButton; CbText: TColorButton;
CbPrepareCanvas: TCheckBox; CbPrepareCanvas: TCheckBox;
CbDrawCell: TCheckBox; CbDrawCell: TCheckBox;
CbAddHolidayNameToCell: TCheckBox;
CbShowHints: TCheckBox;
FontDialog: TFontDialog; FontDialog: TFontDialog;
GroupBox1: TGroupBox; GroupBox1: TGroupBox;
ImageList1: TImageList; ImageList1: TImageList;
@ -56,8 +58,10 @@ type
seWidth: TSpinEdit; seWidth: TSpinEdit;
seHeight: TSpinEdit; seHeight: TSpinEdit;
procedure BtnFontClick(Sender: TObject); procedure BtnFontClick(Sender: TObject);
procedure CbAddHolidayNameToCellChange(Sender: TObject);
procedure CbDrawCellChange(Sender: TObject); procedure CbDrawCellChange(Sender: TObject);
procedure CbPrepareCanvasChange(Sender: TObject); procedure CbPrepareCanvasChange(Sender: TObject);
procedure CbShowHintsChange(Sender: TObject);
procedure ColorButtonChanged(Sender: TObject); procedure ColorButtonChanged(Sender: TObject);
procedure cbUseHolidaysChange(Sender: TObject); procedure cbUseHolidaysChange(Sender: TObject);
procedure cgOptionsItemClick(Sender: TObject; Index: integer); procedure cgOptionsItemClick(Sender: TObject; Index: integer);
@ -70,7 +74,8 @@ type
copyCal, demoCal: TCalendarLite; copyCal, demoCal: TCalendarLite;
FNoHolidays: boolean; FNoHolidays: boolean;
procedure RespondToDateChange(Sender: tObject); 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 procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer; // wp
var Holidays: THolidays); var Holidays: THolidays);
procedure PrepareCanvas(Sender: TObject; ACanvas: TCanvas; procedure PrepareCanvas(Sender: TObject; ACanvas: TCanvas;
@ -132,7 +137,7 @@ begin
demoCal.Height := seHeight.Value; demoCal.Height := seHeight.Value;
demoCal.OnGetHolidays := @GetHolidays; demoCal.OnGetHolidays := @GetHolidays;
demoCal.OnDateChange:= @RespondToDateChange; demoCal.OnDateChange:= @RespondToDateChange;
demoCal.OnHint := @GetHint; demoCal.OnHint := @GetHintText;
demoCal.ShowHint := true; demoCal.ShowHint := true;
demoCal.Hint := 'Calendar'; demoCal.Hint := 'Calendar';
if CbPrepareCanvas.Checked then if CbPrepareCanvas.Checked then
@ -244,6 +249,14 @@ begin
else demoCal.Options := demoCal.Options + [opt]; else demoCal.Options := demoCal.Options + [opt];
end; 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); procedure TForm1.BtnFontClick(Sender: TObject);
begin begin
FontDialog.Font.Assign(demoCal.Font); FontDialog.Font.Assign(demoCal.Font);
@ -267,26 +280,42 @@ begin
demoCal.Invalidate; demoCal.Invalidate;
end; end;
procedure TForm1.CbShowHintsChange(Sender: TObject);
begin
demoCal.ShowHint := CbShowHints.Checked;
end;
procedure TForm1.RespondToDateChange(Sender: tObject); procedure TForm1.RespondToDateChange(Sender: tObject);
begin begin
copyCal.Date:= TCalendarLite(Sender).Date; copyCal.Date:= TCalendarLite(Sender).Date;
end; end;
procedure TForm1.GetHint(Sender: TObject; AYear, AMonth, ADay: Word; procedure TForm1.GetDayText(Sender: TObject; AYear, AMonth, ADay: Word;
out AHintText: String); 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 var
dt, e: TDate; dt, e: TDate;
begin begin
AText := '';
case AMonth of case AMonth of
1: if ADay = 1 then AHintText := 'New Year'; 1: if ADay = 1 then AText := 'New Year';
12: if ADay = 25 then AHintText := 'Christmas'; 12: if ADay = 25 then AText := 'Christmas';
else else
e := Easter(AYear); e := Easter(AYear);
dt := EncodeDate(AYear, AMonth, ADay); dt := EncodeDate(AYear, AMonth, ADay);
if (dt = e) then if (dt = e) then
AHintText := 'Easter' AText := 'Easter'
else if (dt = e + 49) then else if (dt = e + 49) then
AHintText := 'Whit Sunday'; AText := 'Whit Sunday';
end; end;
end; end;

16
components/callite/source/calendarlite.pas
View File

@ -57,9 +57,9 @@ const
DefMinWidth = 120; DefMinWidth = 120;
DefaultDisplayText = 'Today is,dd/mm/yyyy,Holidays during,There are no holidays set for'; DefaultDisplayText = 'Today is,dd/mm/yyyy,Holidays during,There are no holidays set for';
DefTStyle: TTextStyle = (Alignment : taCenter; Layout : tlCenter; DefTStyle: TTextStyle = (Alignment : taCenter; Layout : tlCenter;
SingleLine : True; Clipping : True; SingleLine : False; Clipping : True;
ExpandTabs : False; ShowPrefix : False; ExpandTabs : False; ShowPrefix : False;
Wordbreak : False; Opaque : False; Wordbreak : True; Opaque : False;
SystemFont : False; RightToLeft: False; SystemFont : False; RightToLeft: False;
EndEllipsis: False); EndEllipsis: False);
@ -110,8 +110,8 @@ type
AYear, AMonth, ADay: Word; AState: TCalCellStates; var ARect: TRect; AYear, AMonth, ADay: Word; AState: TCalCellStates; var ARect: TRect;
var AContinueDrawing: Boolean) of object; var AContinueDrawing: Boolean) of object;
TCalHintEvent = procedure (Sender: TObject; AYear, AMonth, ADay: Word; TCalGetDayTextEvent = procedure (Sender: TObject; AYear, AMonth, ADay: Word;
out AHintText: String) of object; var AText: String) of object;
TCalOption = (coBoldDayNames, coBoldHolidays, coBoldToday, coBoldTopRow, TCalOption = (coBoldDayNames, coBoldHolidays, coBoldToday, coBoldTopRow,
coBoldWeekend, coDayLine, coShowBorder, coShowHolidays, coBoldWeekend, coDayLine, coShowBorder, coShowHolidays,
@ -201,9 +201,10 @@ type
FDisplayTexts: TStringList; FDisplayTexts: TStringList;
FMonthNames: TStringList; FMonthNames: TStringList;
FOnDateChange: TNotifyEvent; FOnDateChange: TNotifyEvent;
FOnGetDayText: TCalGetDayTextEvent;
FOnDrawCell: TCalDrawCellEvent; FOnDrawCell: TCalDrawCellEvent;
FOnGetHolidays: TGetHolidaysEvent; FOnGetHolidays: TGetHolidaysEvent;
FOnHint: TCalHintEvent; FOnHint: TCalGetDayTextEvent;
FOnPrepareCanvas: TCalPrepareCanvasEvent; FOnPrepareCanvas: TCalPrepareCanvasEvent;
FOptions: TCalOptions; FOptions: TCalOptions;
FPopupMenu: TPopupMenu; FPopupMenu: TPopupMenu;
@ -316,8 +317,9 @@ type
// new event properties // new event properties
property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange; property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange;
property OnDrawCell: TCalDrawCellEvent read FOnDrawCell write FOnDrawCell; property OnDrawCell: TCalDrawCellEvent read FOnDrawCell write FOnDrawCell;
property OnGetDayText: TCalGetDayTextEvent read FOnGetDayText write FOnGetDayText;
property OnGetHolidays: TGetHolidaysEvent read FOnGetHolidays write FOnGetHolidays; 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; property OnPrepareCanvas: TCalPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
end; end;
@ -643,6 +645,8 @@ begin
{ Paint the day number } { Paint the day number }
s := IntToStr(d); s := IntToStr(d);
if Assigned(FOwner.FOnGetDayText) then
FOwner.FOnGetDayText(FOwner, y, m, d, s);
FCanvas.TextRect(rec, 0, 0, s, FTStyle); FCanvas.TextRect(rec, 0, 0, s, FTStyle);
end; end;