diff --git a/components/callite/demo2/umaintestcallite.lfm b/components/callite/demo2/umaintestcallite.lfm index db8691171..92931add7 100644 --- a/components/callite/demo2/umaintestcallite.lfm +++ b/components/callite/demo2/umaintestcallite.lfm @@ -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 diff --git a/components/callite/demo2/umaintestcallite.pp b/components/callite/demo2/umaintestcallite.pp index f6689f990..71ab497e3 100644 --- a/components/callite/demo2/umaintestcallite.pp +++ b/components/callite/demo2/umaintestcallite.pp @@ -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; diff --git a/components/callite/source/calendarlite.pas b/components/callite/source/calendarlite.pas index 52a69e8a2..f73d3f262 100644 --- a/components/callite/source/calendarlite.pas +++ b/components/callite/source/calendarlite.pas @@ -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())))]);