From 0d147a94ae9ceb1691e71ec5f60ab4ef04dc125a Mon Sep 17 00:00:00 2001 From: graemeg Date: Sun, 12 Oct 2008 21:55:05 +0000 Subject: * Applied jean-marc's calendar patch. --- examples/gui/calendar/calendartest.lpi | 1 - examples/gui/calendar/calendartest.lpr | 173 ++++++++++++++------------------- src/gui/fpg_popupcalendar.pas | 88 +++++++++++++++-- 3 files changed, 149 insertions(+), 113 deletions(-) diff --git a/examples/gui/calendar/calendartest.lpi b/examples/gui/calendar/calendartest.lpi index 186cec27..7e9271ef 100644 --- a/examples/gui/calendar/calendartest.lpi +++ b/examples/gui/calendar/calendartest.lpi @@ -9,7 +9,6 @@ - diff --git a/examples/gui/calendar/calendartest.lpr b/examples/gui/calendar/calendartest.lpr index 5e5dfeeb..1587d753 100644 --- a/examples/gui/calendar/calendartest.lpr +++ b/examples/gui/calendar/calendartest.lpr @@ -12,43 +12,40 @@ uses {$ENDIF}{$ENDIF} Classes, SysUtils, fpg_base, fpg_main, fpg_form, fpg_popupcalendar, fpg_edit, - fpg_button, fpg_label, fpg_popupwindow, fpg_combobox, fpg_checkbox, dateutils; + fpg_button, fpg_label, fpg_popupwindow, fpg_combobox, fpg_checkbox, + fpg_panel, dateutils; type TMainForm = class(TfpgForm) private - procedure btnDownClicked(Sender: TObject); procedure btnDateFormatClicked(Sender: TObject); procedure btnTodayClicked(Sender: TObject); procedure btnMinDateClicked(Sender: TObject); procedure btnMaxDateClicked(Sender: TObject); procedure cbWHolidayChange(Sender: TObject); procedure cbName1Change(Sender: TObject); - procedure DoDropDown; procedure cbCloseOnSelectChanged(Sender: TObject); + procedure btnClearClicked(Sender: TObject); procedure DrawCalendar(month, year: integer); public {@VFD_HEAD_BEGIN: MainForm} - edtName1: TfpgEdit; - btnName1: TfpgButton; - lblName1: TfpgLabel; - lblName2: TfpgLabel; - cbName1: TfpgComboBox; + btnClear: TfpgButton; lblWHoliday: TfpgLabel; cbWHoliday: TfpgComboBox; + cbName1: TfpgComboBox; cal: TfpgCalendarCombo; btnDateFormat: TfpgButton; edtDateFormat: TfpgEdit; - lblName3: TfpgLabel; lblName4: TfpgLabel; lblName5: TfpgLabel; btnToday: TfpgButton; - lblName6: TfpgLabel; edtMinDate: TfpgEdit; edtMaxDate: TfpgEdit; btnMinDate: TfpgButton; btnMaxDate: TfpgButton; cbCloseOnSelect: TfpgCheckBox; + lblName1: TfpgLabel; + bvlName1: TfpgBevel; {@VFD_HEAD_END: MainForm} FDropDown: TfpgPopupCalendar; procedure AfterCreate; override; @@ -63,6 +60,12 @@ begin cal.CloseOnSelect := TfpgCheckBox(Sender).Checked; end; +procedure TMainForm.btnClearClicked(Sender: TObject); +begin + cbWHoliday.FocusItem := -1; + cal.WeeklyHoliday := -1; +end; + type TStartDay = (wdSun, wdMon, wdTue, wdWed, wdThu, wdFri, wdSat); @@ -125,11 +128,6 @@ begin writeln('-----'); end; -procedure TMainForm.btnDownClicked(Sender: TObject); -begin - DoDropDown; -end; - procedure TMainForm.btnDateFormatClicked(Sender: TObject); begin cal.DateFormat := edtDateFormat.Text; @@ -178,76 +176,36 @@ begin cal.WeekStartDay := cbName1.FocusItem; end; -procedure TMainForm.DoDropDown; -begin - if (not Assigned(FDropDown)) or (not FDropDown.HasHandle) then - begin - FDropDown := TfpgPopupCalendar.Create(nil, edtName1); - FDropDown.ShowAt(self, edtName1.Left, edtName1.Top+edtName1.Height); - FDropDown.PopupFrame:= True; - end - else - begin - FDropDown.Close; - FreeAndNil(FDropDown); - end; -end; - procedure TMainForm.AfterCreate; begin inherited AfterCreate; {@VFD_BODY_BEGIN: MainForm} Name := 'MainForm'; - SetPosition(286, 234, 470, 253); + SetPosition(286, 234, 372, 275); WindowTitle := 'fpGUI Calendar Test'; WindowPosition := wpUser; - edtName1 := TfpgEdit.Create(self); - with edtName1 do + btnClear := TfpgButton.Create(self); + with btnClear do begin - Name := 'edtName1'; - SetPosition(16, 48, 120, 22); - Text := ''; - FontDesc := '#Edit1'; - end; - - btnName1 := TfpgButton.Create(self); - with btnName1 do - begin - Name := 'btnName1'; - SetPosition(136, 48, 19, 22); - Text := ''; + Name := 'btnClear'; + SetPosition(256, 32, 59, 23); + Text := 'Clear'; FontDesc := '#Label1'; - ImageName := 'sys.sb.down'; + Hint := ''; + ImageName := ''; + ShowImage := False; TabOrder := 1; - OnClick := @btnDownClicked; + OnClick := @btnClearClicked; end; - lblName1 := TfpgLabel.Create(self); - with lblName1 do - begin - Name := 'lblName1'; - SetPosition(16, 32, 80, 16); - FontDesc := '#Label1'; - Text := 'Enter a date:'; - end; - - lblName2 := TfpgLabel.Create(self); - with lblName2 do - begin - Name := 'lblName2'; - SetPosition(16, 100, 276, 16); - FontDesc := '#Label2'; - Text := '***** This still needs some testing *****'; - TextColor := clRed; - end; - lblWHoliday := TfpgLabel.Create(self); with lblWHoliday do begin Name := 'lblWHoliday'; - SetPosition(200, 16, 100, 16); - FontDesc := '#Label2'; + SetPosition(24, 36, 100, 16); + FontDesc := '#Label1'; + Hint := ''; Text := 'Weekly holiday'; end; @@ -255,7 +213,7 @@ begin with cbWHoliday do begin Name := 'cbWHoliday'; - SetPosition(300, 16, 120, 23); + SetPosition(132, 32, 120, 23); FontDesc := '#List'; Items.Add('Sun'); Items.Add('Mon'); @@ -264,6 +222,7 @@ begin Items.Add('Thu'); Items.Add('Fri'); Items.Add('Sat'); + TabOrder := 5; OnChange := @cbWHolidayChange; end; @@ -271,7 +230,7 @@ begin with cbName1 do begin Name := 'cbName1'; - SetPosition(132, 144, 120, 23); + SetPosition(132, 64, 120, 23); FontDesc := '#List'; Items.Add('Sun'); Items.Add('Mon'); @@ -281,6 +240,7 @@ begin Items.Add('Fri'); Items.Add('Sat'); TabOrder := 4; + FocusItem := 0; OnChange := @cbName1Change; end; @@ -288,19 +248,23 @@ begin with cal do begin Name := 'cal'; - SetPosition(132, 196, 120, 23); + SetPosition(132, 224, 120, 23); FontDesc := '#List'; TabOrder := 5; - DateFormat := 'dd-mmm-yyyy'; + DateFormat := 'dd mmm yyyy'; + DayColor := clBlue; + HolidayColor := clRed; + SelectedColor:= clYellow; end; btnDateFormat := TfpgButton.Create(self); with btnDateFormat do begin Name := 'btnDateFormat'; - SetPosition(388, 148, 75, 23); + SetPosition(232, 116, 75, 23); Text := 'Set Format'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 6; OnClick := @btnDateFormatClicked; @@ -310,28 +274,19 @@ begin with edtDateFormat do begin Name := 'edtDateFormat'; - SetPosition(288, 148, 92, 22); + SetPosition(132, 116, 92, 22); TabOrder := 7; Text := 'yy-mm-d'; FontDesc := '#Edit1'; end; - lblName3 := TfpgLabel.Create(self); - with lblName3 do - begin - Name := 'lblName3'; - SetPosition(160, 48, 287, 15); - FontDesc := '#Label1'; - Text := '<---- This one is fake. It only used the'; - TextColor := clBlue; - end; - lblName4 := TfpgLabel.Create(self); with lblName4 do begin Name := 'lblName4'; - SetPosition(12, 148, 96, 15); + SetPosition(24, 68, 96, 15); FontDesc := '#Label1'; + Hint := ''; Text := 'Week start day'; end; @@ -339,8 +294,9 @@ begin with lblName5 do begin Name := 'lblName5'; - SetPosition(12, 200, 104, 15); + SetPosition(8, 228, 104, 15); FontDesc := '#Label1'; + Hint := ''; Text := 'Calendar Combo:'; end; @@ -348,28 +304,20 @@ begin with btnToday do begin Name := 'btnToday'; - SetPosition(388, 120, 75, 23); + SetPosition(256, 224, 59, 23); Text := 'Today'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 11; OnClick := @btnTodayClicked; end; - lblName6 := TfpgLabel.Create(self); - with lblName6 do - begin - Name := 'lblName6'; - SetPosition(192, 63, 246, 16); - FontDesc := '#Label1'; - Text := 'calendar window part.'; - end; - edtMinDate := TfpgEdit.Create(self); with edtMinDate do begin Name := 'edtMinDate'; - SetPosition(288, 176, 92, 22); + SetPosition(132, 144, 92, 22); TabOrder := 13; Text := '2005-01-01'; FontDesc := '#Edit1'; @@ -379,7 +327,7 @@ begin with edtMaxDate do begin Name := 'edtMaxDate'; - SetPosition(288, 204, 92, 22); + SetPosition(132, 172, 92, 22); TabOrder := 14; Text := '2009-01-01'; FontDesc := '#Edit1'; @@ -389,9 +337,10 @@ begin with btnMinDate do begin Name := 'btnMinDate'; - SetPosition(388, 176, 75, 23); + SetPosition(232, 144, 75, 23); Text := 'Min Date'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 15; OnClick := @btnMinDateClicked; @@ -401,9 +350,10 @@ begin with btnMaxDate do begin Name := 'btnMaxDate'; - SetPosition(388, 204, 75, 23); + SetPosition(232, 172, 75, 23); Text := 'Max Date'; FontDesc := '#Label1'; + Hint := ''; ImageName := ''; TabOrder := 16; OnClick := @btnMaxDateClicked; @@ -413,14 +363,33 @@ begin with cbCloseOnSelect do begin Name := 'cbCloseOnSelect'; - SetPosition(328, 88, 120, 20); + SetPosition(128, 92, 236, 20); Checked := True; FontDesc := '#Label1'; TabOrder := 17; - Text := 'Close on select'; + Text := 'Close combo on date selection'; OnChange := @cbCloseOnSelectChanged; end; + lblName1 := TfpgLabel.Create(self); + with lblName1 do + begin + Name := 'lblName1'; + SetPosition(8, 8, 144, 16); + FontDesc := '#Label2'; + Hint := ''; + Text := 'Calendar Settings'; + end; + + bvlName1 := TfpgBevel.Create(self); + with bvlName1 do + begin + Name := 'bvlName1'; + SetPosition(8, 204, 350, 2); + Anchors := [anLeft,anRight,anTop]; + Style := bsLowered; + end; + {@VFD_BODY_END: MainForm} end; diff --git a/src/gui/fpg_popupcalendar.pas b/src/gui/fpg_popupcalendar.pas index d837c364..ae18f871 100644 --- a/src/gui/fpg_popupcalendar.pas +++ b/src/gui/fpg_popupcalendar.pas @@ -80,6 +80,9 @@ type FCloseOnSelect: boolean; FThisMonthDays: array[0..6,0..5] of boolean; FWeeklyHoliday: integer; + FDayColor: TfpgColor; + FHolidayColor: TfpgColor; + FSelectedColor: TfpgColor; function GetDateElement(Index: integer): Word; procedure PopulateDays; procedure CalculateMonthOffset; @@ -90,6 +93,9 @@ type procedure SetMinDate(const AValue: TDateTime); procedure SetWeekStartDay(const AValue: integer); procedure SetWeeklyHoliday(const AValue: integer); + procedure SetDayColor(const AValue: TfpgColor); + procedure SetHolidayColor(const AValue: TfpgColor); + procedure SetSelectedColor(const AValue: TfpgColor); procedure SetCloseOnSelect(const AValue: boolean); procedure UpdateCalendar; procedure btnYearUpClicked(Sender: TObject); @@ -120,8 +126,11 @@ type property DateValue: TDateTime read FDate write SetDateValue; property MinDate: TDateTime read FMinDate write SetMinDate; property MaxDate: TDateTime read FMaxDate write SetMaxDate; - property WeekStartDay: integer read FWeekStartDay write SetWeekStartDay; - property WeeklyHoliday: integer read FWeeklyHoliday write SetWeeklyHoliday; + property WeekStartDay: integer read FWeekStartDay write SetWeekStartDay default 0; + property WeeklyHoliday: integer read FWeeklyHoliday write SetWeeklyHoliday default -1; + property DayColor: TfpgColor read FDayColor write SetDayColor; + property HolidayColor: TfpgColor read FHolidayColor write SetHolidayColor; + property SelectedColor: TfpgColor read FSelectedColor write SetSelectedColor; end; @@ -133,6 +142,9 @@ type FMinDate: TDateTime; FWeekStartDay: integer; FWeeklyHoliday: integer; + FDayColor: TfpgColor; + FHolidayColor: TfpgColor; + FSelectedColor: TfpgColor; FCloseOnSelect: boolean; procedure InternalOnValueSet(Sender: TObject; const ADate: TDateTime); procedure SetDateFormat(const AValue: string); @@ -141,6 +153,9 @@ type procedure SetMinDate(const AValue: TDateTime); procedure SetWeekStartDay(const AValue: integer); procedure SetWeeklyHoliday(const AValue: integer); + procedure SetDayColor(const AValue: TfpgColor); + procedure SetHolidayColor(const AValue: TfpgColor); + procedure SetSelectedColor(const AValue: TfpgColor); procedure SetText(const AValue: string); override; function GetText: string; override; procedure SetCloseOnSelect(const AValue: boolean); @@ -156,8 +171,11 @@ type property FontDesc; property MinDate: TDateTime read FMinDate write SetMinDate; property MaxDate: TDateTime read FMaxDate write SetMaxDate; - property WeekStartDay: integer read FWeekStartDay write SetWeekStartDay; - property WeeklyHoliday: integer read FWeeklyHoliday write SetWeeklyHoliday; + property WeekStartDay: integer read FWeekStartDay write SetWeekStartDay default 0; + property WeeklyHoliday: integer read FWeeklyHoliday write SetWeeklyHoliday default -1; + property DayColor: TfpgColor read FDayColor write SetDayColor; + property HolidayColor: TfpgColor read FHolidayColor write SetHolidayColor; + property SelectedColor: TfpgColor read FSelectedColor write SetSelectedColor; property ParentShowHint; property ShowHint; { Clicking on calendar Today button will close the popup calendar by default } @@ -224,22 +242,28 @@ begin FntBold:= fpgApplication.GetFont('arial-9:bold'); if FThisMonthDays[ACol,ARow] then if (ACol = FocusCol) and (ARow = FocusRow) then - Canvas.SetTextColor(clWhite) + Canvas.SetTextColor(FSelectedColor) else - Canvas.SetTextColor(clText1) + Canvas.SetTextColor(FDayColor) else if (ACol = FocusCol) and (ARow = FocusRow) then - Canvas.SetTextColor(clWhite) + Canvas.SetTextColor(FSelectedColor) else Canvas.SetTextColor(clShadow1); if FWeeklyHoliday >= FWeekStartDay then if ACol = FWeeklyHoliday - FWeekStartDay then - Canvas.Font := FntBold + begin + Canvas.Font := FntBold; + Canvas.SetTextColor(FHolidayColor); + end else Canvas.Font := FntNorm else - if ACol = FWeeklyHoliday - FWeekStartDay + 7 then - Canvas.Font := FntBold + if (FWeeklyHoliday > -1) and (ACol = FWeeklyHoliday - FWeekStartDay + 7) then + begin + Canvas.Font := FntBold; + Canvas.SetTextColor(FHolidayColor); + end else Canvas.Font := FntNorm; end; @@ -407,6 +431,24 @@ begin FWeeklyHoliday := AValue; end; +procedure TfpgPopupCalendar.SetDayColor(const AValue: TfpgColor); +begin + if FDayColor <> AValue then + FDayColor := AValue; +end; + +procedure TfpgPopupCalendar.SetHolidayColor(const AValue: TfpgColor); +begin + if FHolidayColor <> AValue then + FHolidayColor := AValue; +end; + +procedure TfpgPopupCalendar.SetSelectedColor(const AValue: TfpgColor); +begin + if FSelectedColor <> AValue then + FSelectedColor := AValue; +end; + procedure TfpgPopupCalendar.SetCloseOnSelect(const AValue: boolean); begin if FCloseOnSelect = AValue then @@ -588,6 +630,10 @@ begin AfterCreate; FDate := Date; FWeekStartDay := 0; + FWeeklyHoliday := -1; + FDayColor := clText1; + FHolidayColor := clText1; + FSelectedColor := clWhite; FMonthOffset := 0; FCloseOnSelect := True; UpdateCalendar; @@ -784,6 +830,24 @@ begin FWeeklyHoliday := AValue; end; +procedure TfpgCalendarCombo.SetSelectedColor(const AValue: TfpgColor); +begin + if FSelectedColor <> AValue then + FSelectedColor := AValue; +end; + +procedure TfpgCalendarCombo.SetDayColor(const AValue: TfpgColor); +begin + if FDayColor <> AValue then + FDayColor := AValue; +end; + +procedure TfpgCalendarCombo.SetHolidayColor(const AValue: TfpgColor); +begin + if FHolidayColor <> AValue then + FHolidayColor := AValue; +end; + procedure TfpgCalendarCombo.SetText(const AValue: string); begin try @@ -818,6 +882,7 @@ begin inherited Create(AOwner); FMinDate := EncodeDate(1900, 01, 01); FMaxDate := EncodeDate(2100, 01, 31); + FWeeklyHoliday := -1; FDate := Now; FCloseOnSelect := True; DateFormat := ShortDateFormat; @@ -875,6 +940,9 @@ begin ddw.DateValue := FDate; ddw.WeekStartDay := FWeekStartDay; ddw.WeeklyHoliday := FWeeklyHoliday; + ddw.DayColor := FDayColor; + ddw.HolidayColor := FHolidayColor; + ddw.SelectedColor := FSelectedColor; ddw.ShowAt(Parent, Left, Top+Height); { I added this call to UpdateCalendar because sometimes after btnTodayClicked event, reopeing the dropdown menu gave an empty calendar } -- cgit v1.2.3-70-g09d2