CalLite: Add colors to demo2. Fix positioning issue for bold TodayRow.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5320 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2016-11-06 17:28:04 +00:00
parent 0dd55ed594
commit 4ac2ecd5ec
3 changed files with 364 additions and 57 deletions

View File

@ -1,29 +1,29 @@
object Form1: TForm1
Left = 536
Left = 687
Height = 845
Top = 72
Width = 648
Top = 88
Width = 753
Caption = 'Examples of the TCalendaLite component'
ClientHeight = 845
ClientWidth = 648
ClientWidth = 753
Color = clWindow
Font.CharSet = ANSI_CHARSET
OnCreate = FormCreate
LCLVersion = '1.7'
object PSettings: TPanel
Left = 0
Height = 376
Height = 408
Top = 0
Width = 648
Width = 753
Align = alTop
ClientHeight = 376
ClientWidth = 648
ClientHeight = 408
ClientWidth = 753
TabOrder = 0
object cgOptions: TCheckGroup
Left = 24
Height = 296
Height = 352
Top = 40
Width = 185
Width = 160
AutoFill = True
Caption = 'Set calendar Options'
ChildSizing.LeftRightSpacing = 6
@ -34,8 +34,8 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 276
ClientWidth = 181
ClientHeight = 332
ClientWidth = 156
Items.Strings = (
'coBoldDayNames'
'coBoldHolidays'
@ -58,9 +58,9 @@ object Form1: TForm1
}
end
object cbUseHolidays: TCheckBox
Left = 239
Left = 560
Height = 19
Top = 40
Top = 48
Width = 169
Caption = 'Ignore OnGetHolidays event'
OnChange = cbUseHolidaysChange
@ -78,17 +78,17 @@ object Form1: TForm1
ParentFont = False
end
object LWidth: TLabel
Left = 239
Left = 560
Height = 15
Top = 81
Top = 89
Width = 32
Caption = 'Width'
ParentColor = False
end
object seWidth: TSpinEdit
Left = 296
Left = 617
Height = 23
Top = 79
Top = 87
Width = 66
MaxValue = 430
MinValue = 120
@ -97,9 +97,9 @@ object Form1: TForm1
Value = 300
end
object seHeight: TSpinEdit
Left = 296
Left = 617
Height = 23
Top = 112
Top = 120
Width = 66
MaxValue = 250
MinValue = 120
@ -108,18 +108,18 @@ object Form1: TForm1
Value = 200
end
object lHeight: TLabel
Left = 239
Left = 560
Height = 15
Top = 112
Top = 120
Width = 36
Caption = 'Height'
ParentColor = False
end
object rgLanguage: TRadioGroup
Left = 239
Height = 160
Top = 176
Width = 180
Left = 200
Height = 144
Top = 248
Width = 160
AutoFill = True
Caption = 'Language to use'
ChildSizing.LeftRightSpacing = 6
@ -130,8 +130,8 @@ object Form1: TForm1
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 140
ClientWidth = 176
ClientHeight = 124
ClientWidth = 156
ItemIndex = 0
Items.Strings = (
'English (default)'
@ -144,10 +144,10 @@ object Form1: TForm1
TabOrder = 4
end
object rgStartingDOW: TRadioGroup
Left = 440
Left = 200
Height = 192
Top = 40
Width = 176
Width = 160
AutoFill = True
Caption = 'Starting day of the week'
ChildSizing.LeftRightSpacing = 6
@ -159,7 +159,7 @@ object Form1: TForm1
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 172
ClientWidth = 172
ClientWidth = 156
Items.Strings = (
'Sunday'
'Monday'
@ -172,26 +172,262 @@ object Form1: TForm1
OnClick = rgStartingDOWClick
TabOrder = 5
end
end
object CalendarLite1: TCalendarLite
Left = 132
Height = 160
Top = 489
Width = 210
Constraints.MinHeight = 120
Constraints.MinWidth = 120
ParentColor = False
TabOrder = 1
Date = 42678
DisplayTexts = '"Today is",dd/mm/yyyy,"Holidays during","There are no holidays set for"'
WeekendDays = [dowSunday, dowSaturday]
end
object Label1: TLabel
Left = 76
Height = 15
Top = 425
Width = 34
Caption = 'Label1'
ParentColor = False
object GroupBox1: TGroupBox
Left = 376
Height = 352
Top = 40
Width = 160
Caption = 'Colors'
ClientHeight = 332
ClientWidth = 156
TabOrder = 6
object CbArrowBorder: TColorButton
Left = 16
Height = 25
Top = 8
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object CbArrow: TColorButton
Left = 16
Height = 25
Top = 32
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object Label2: TLabel
Left = 49
Height = 15
Top = 13
Width = 67
Caption = 'ArrowBorder'
ParentColor = False
end
object Label3: TLabel
Left = 49
Height = 15
Top = 37
Width = 32
Caption = 'Arrow'
ParentColor = False
end
object CbBackground: TColorButton
Left = 16
Height = 25
Top = 56
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object CbBorder: TColorButton
Left = 16
Height = 25
Top = 80
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object Label4: TLabel
Left = 49
Height = 15
Top = 61
Width = 64
Caption = 'Background'
ParentColor = False
end
object Label5: TLabel
Left = 49
Height = 15
Top = 85
Width = 35
Caption = 'Border'
ParentColor = False
end
object CbDayLine: TColorButton
Left = 16
Height = 25
Top = 104
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object CbHolidays: TColorButton
Left = 16
Height = 25
Top = 128
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object Label6: TLabel
Left = 49
Height = 15
Top = 109
Width = 42
Caption = 'Day line'
ParentColor = False
end
object Label7: TLabel
Left = 49
Height = 15
Top = 133
Width = 46
Caption = 'Holidays'
ParentColor = False
end
object CbPastMonth: TColorButton
Left = 16
Height = 25
Top = 152
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object CbSelectedDate: TColorButton
Left = 16
Height = 25
Top = 176
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object Label8: TLabel
Left = 49
Height = 15
Top = 157
Width = 88
Caption = 'Past/next month'
ParentColor = False
end
object Label9: TLabel
Left = 49
Height = 15
Top = 181
Width = 70
Caption = 'Selected date'
ParentColor = False
end
object CbText: TColorButton
Left = 16
Height = 25
Top = 200
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object CbTodayFrame: TColorButton
Left = 16
Height = 25
Top = 224
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object Label10: TLabel
Left = 49
Height = 15
Top = 205
Width = 21
Caption = 'Text'
ParentColor = False
end
object Label11: TLabel
Left = 49
Height = 15
Top = 229
Width = 66
Caption = 'Today frame'
ParentColor = False
end
object CbTopRow: TColorButton
Left = 16
Height = 25
Top = 248
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object CbTopRowText: TColorButton
Left = 16
Height = 25
Top = 272
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object Label12: TLabel
Left = 49
Height = 15
Top = 253
Width = 43
Caption = 'Top row'
ParentColor = False
end
object Label13: TLabel
Left = 49
Height = 15
Top = 277
Width = 65
Caption = 'Top row text'
ParentColor = False
end
object CbWeekend: TColorButton
Left = 16
Height = 25
Top = 296
Width = 26
BorderWidth = 2
ButtonColorSize = 16
ButtonColor = clBlack
Flat = True
OnColorChanged = ColorButtonChanged
end
object Label14: TLabel
Left = 49
Height = 15
Top = 301
Width = 49
Caption = 'Weekend'
ParentColor = False
end
end
end
end

View File

@ -5,17 +5,43 @@ unit uMainTestCalLite;
interface
uses
Classes, SysUtils, Forms, Graphics, ExtCtrls, StdCtrls, Spin, CalendarLite;
Classes, SysUtils, Forms, Graphics, ExtCtrls, StdCtrls, Spin, Dialogs,
CalendarLite;
type
{ TForm1 }
TForm1 = class(TForm)
CalendarLite1: TCalendarLite;
cbUseHolidays: TCheckBox;
cgOptions: TCheckGroup;
Label1: TLabel;
CbArrowBorder: TColorButton;
CbTodayFrame: TColorButton;
CbTopRow: TColorButton;
CbTopRowText: TColorButton;
CbWeekend: TColorButton;
CbArrow: TColorButton;
CbBackground: TColorButton;
CbBorder: TColorButton;
CbDayLine: TColorButton;
CbHolidays: TColorButton;
CbPastMonth: TColorButton;
CbSelectedDate: TColorButton;
CbText: TColorButton;
GroupBox1: TGroupBox;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Label14: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
LTitle: TLabel;
LWidth: TLabel;
lHeight: TLabel;
@ -24,6 +50,7 @@ type
rgStartingDOW: TRadioGroup;
seWidth: TSpinEdit;
seHeight: TSpinEdit;
procedure ColorButtonChanged(Sender: TObject);
procedure cbUseHolidaysChange(Sender: TObject);
procedure cgOptionsItemClick(Sender: TObject; Index: integer);
procedure FormCreate(Sender: TObject);
@ -47,8 +74,6 @@ implementation
{$R *.lfm}
uses
Dialogs;
function Easter(year:integer) : TDateTime; // wp
var
@ -114,6 +139,20 @@ begin
copyCal.StartingDayOfWeek:= dowSaturday;
copyCal.OnGetHolidays := @GetHolidays;
copyCal.Options := copyCal.Options + [coShowBorder,coUseTopRowColors,coDayLine];
CbArrowBorder.ButtonColor := demoCal.Colors.ArrowBorderColor;
CbArrow.ButtonColor := demoCal.Colors.ArrowColor;
CbBackground.ButtonColor := demoCal.Colors.BackgroundColor;
CbBorder.ButtonColor := demoCal.Colors.BorderColor;
CbDayLine.ButtonColor := demoCal.Colors.DayLineColor;
CbHolidays.Buttoncolor := demoCal.colors.HolidayColor;
CbPastMonth.ButtonColor := demoCal.Colors.PastMonthColor;
CbSelectedDate.ButtonColor := demoCal.Colors.SelectedDateColor;
CbText.ButtonColor := demoCal.Colors.TextColor;
CbTodayFrame.ButtonColor := demoCal.Colors.TodayFrameColor;
CbTopRow.ButtonColor := demoCal.Colors.TopRowColor;
CbTopRowText.ButtonColor := democal.Colors.TopRowTextColor;
CbWeekend.ButtonColor := demoCal.Colors.WeekendColor;
end;
procedure TForm1.rgLanguageClick(Sender: TObject);
@ -142,6 +181,31 @@ begin
demoCal.Width := seWidth.Value;
end;
procedure TForm1.ColorButtonChanged(Sender: TObject);
var
calendar: TCalendarLite;
col: TColor;
begin
calendar := demoCal;
col := (Sender as TColorButton).ButtonColor;
case (Sender as TColorButton).Name of
'CbArrowBorder': calendar.Colors.ArrowBorderColor := col;
'CbArror': calendar.Colors.ArrowColor := col;
'CbBackground': calendar.Colors.BackgroundColor := col;
'CbBorder': calendar.Colors.BorderColor := col;
'CbDayLine': calendar.Colors.DayLineColor := col;
'CbHolidays': calendar.Colors.HolidayColor := col;
'CbPastMonth': calendar.Colors.PastMonthColor := col;
'CbSelectedDate': calendar.Colors.SelectedDateColor := col;
'CbText': calendar.Colors.TextColor := col;
'CbTodayFrame': calendar.Colors.TodayFrameColor := col;
'CbTopRow': calendar.Colors.TopRowColor := col;
'CbTopRowText': calendar.Colors.TopRowTextColor := col;
'CbWeekend': calendar.Colors.WeekendColor := col;
end;
calendar.Invalidate;
end;
procedure TForm1.cbUseHolidaysChange(Sender: TObject);
begin
FNoHolidays := not FNoHolidays;

View File

@ -100,6 +100,9 @@ type
TGetHolidaysEvent = procedure (Sender: TObject; AMonth, AYear: Integer;
var Holidays: THolidays) of object;
TFormatEvent = procedure (Sender: TObject; ADate: TDate;
AFont: TFont; ABkColor: TColor) of object;
TCalOption = (coBoldDayNames, coBoldHolidays, coBoldToday, coBoldTopRow,
coBoldWeekend, coDayLine, coShowBorder, coShowHolidays,
coShowTodayFrame, coShowTodayName, coShowTodayRow,
@ -612,6 +615,10 @@ begin
if (FCanvas.Font.Color <> FOwner.Colors.TextColor) then
FCanvas.Font.Color:= FOwner.Colors.TextColor;
if coBoldToday in FOwner.Options then
FCanvas.Font.Style := [fsBold] else
FCanvas.Font.Style := [];
s:= FOwner.GetDisplayText(dtToday);
if (coShowTodayName in FOwner.Options) then
s := Format('%s %s',[s, FOwner.GetDayName(TDayOfWeek(DayOfWeek(Date())))]);