summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--examples/gui/calendar/calendartest.lpi1
-rw-r--r--examples/gui/calendar/calendartest.lpr173
-rw-r--r--src/gui/fpg_popupcalendar.pas88
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 @@
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
- <IconPath Value="./"/>
<TargetFileExt Value=""/>
</General>
<VersionInfo>
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 }
generated by cgit v1.2.3-70-g09d2 (git 2.47.1) at 2024-12-27 10:57:54 +0000