diff --git a/components/callite/demo1/main.lfm b/components/callite/demo1/main.lfm
index a82129c6b..e96bf790a 100644
--- a/components/callite/demo1/main.lfm
+++ b/components/callite/demo1/main.lfm
@@ -1,58 +1,13 @@
object Form1: TForm1
Left = 400
- Height = 272
+ Height = 227
Top = 115
Width = 256
Caption = 'Form1'
- ClientHeight = 272
- ClientWidth = 256
Font.Height = -13
Font.Name = 'Tahoma'
KeyPreview = True
OnCreate = FormCreate
- OnResize = FormResize
Position = poScreenCenter
- LCLVersion = '1.6.0.4'
- object edtYear: TEdit
- Left = 122
- Height = 18
- Top = 15
- Width = 38
- Alignment = taCenter
- AutoSize = False
- BorderStyle = bsNone
- OnKeyDown = edtYearKeyDown
- ParentColor = True
- TabOrder = 1
- Text = 'Year'
- end
- object edtMonth: TEdit
- AnchorSideLeft.Side = asrBottom
- AnchorSideTop.Control = edtYear
- AnchorSideRight.Control = edtYear
- Left = 84
- Height = 18
- Top = 15
- Width = 38
- Alignment = taCenter
- Anchors = [akTop, akRight]
- AutoSize = False
- BorderStyle = bsNone
- OnKeyDown = edtMonthKeyDown
- ParentColor = True
- TabOrder = 0
- Text = 'Month'
- end
- object Label1: TLabel
- Left = 5
- Height = 30
- Top = 237
- Width = 246
- Align = alBottom
- BorderSpacing.Around = 5
- Caption = 'Use Up/Down Arrows to change the Month/Year. Press and hold for long jumps.'
- ParentColor = False
- ParentFont = False
- WordWrap = True
- end
+ LCLVersion = '1.7'
end
diff --git a/components/callite/demo1/main.pas b/components/callite/demo1/main.pas
index ad23a421f..957718dd4 100644
--- a/components/callite/demo1/main.pas
+++ b/components/callite/demo1/main.pas
@@ -5,22 +5,14 @@ unit main;
interface
uses
- Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
- LclType, Buttons, StdCtrls, DateUtils, CalendarLite;
+ SysUtils, Forms, Controls, CalendarLite;
type
{ TForm1 }
TForm1 = class(TForm)
- edtYear: TEdit;
- edtMonth: TEdit;
- Label1: TLabel;
- procedure btnCloseClick(Sender: TObject);
- procedure edtYearKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
- procedure edtMonthKeyDown(Sender: TObject; var Key: Word; {%H-}Shift: TShiftState);
procedure FormCreate(Sender: TObject);
- procedure FormResize(Sender: TObject);
private
{ private declarations }
CalendarLite1: TCalendarLite;
@@ -35,14 +27,8 @@ implementation
{$R *.lfm}
-
{ TForm1 }
-var
- AYear: Integer;
- AMonth: Integer;
- MonthsList: TStringList;
-
procedure TForm1.FormCreate(Sender: TObject);
var
I: Integer;
@@ -50,65 +36,15 @@ begin
CalendarLite1 := TCalendarLite.Create(self);
with CalendarLite1 do begin
Parent := self;
- Left := 20;
-// Height := 160;
- Top := 40;
+ Left := 10;
+ Top := 10;
Width := self.Width - 2*Left;
- Height := label1.Top - Top - 20;
- ParentColor := false;
- Date := 41574;
+ Height := self.Height - 2*Top;
+ Date := Now();
DisplayTexts := '"Today is",dd/mm/yyyy,"Holidays during","There are no holidays set for"';
WeekendDays := [dowSaturday];
Anchors := [akLeft, akTop, akRight, akBottom];
end;
-
- MonthsList:= TStringList.Create;
- for I:= 0 to 11 do begin
- MonthsList.Add(AnsiToUTF8(FormatSettings.ShortMonthNames[I+1]));
- end;
-
- AYear:= YearOf(Now);
- AMonth:= MonthOf(Now)-1;
- edtYear.Caption := IntToStr(AYear);
- edtMonth.Caption := MonthsList[AMonth];
-end;
-
-procedure TForm1.FormResize(Sender: TObject);
-begin
- edtMonth.Left := Width div 2 - edtMonth.Width - 2;
- edtYear.Left := Width div 2 + 2;
-end;
-
-procedure TForm1.btnCloseClick(Sender: TObject);
-begin
- FreeAndNil(MonthsList);
- Close;
-end;
-
-procedure TForm1.edtYearKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-begin
- case Key of
- VK_Up : Inc(AYear);
- VK_Down : Dec(AYear);
- end;
- edtYear.Caption := IntToStr(AYear);
- CalendarLite1.Date := RecodeYear(CalendarLite1.Date,AYear);
-end;
-
-procedure TForm1.edtMonthKeyDown(Sender: TObject; var Key: Word;
- Shift: TShiftState);
-begin
- case Key of
- VK_Up : Inc(AMonth);
- VK_Down : Dec(AMonth);
- end;
- case AMonth of
- -1: AMonth := 11;
- 12: AMonth := 0;
- end;
- edtMonth.Text:= MonthsList[AMonth];
- CalendarLite1.Date:= RecodeMonth(CalendarLite1.Date,AMonth+1);
end;
end.
diff --git a/components/callite/demo2/testCalLite.lpi b/components/callite/demo2/testCalLite.lpi
index 14dbc41b3..f0851d414 100644
--- a/components/callite/demo2/testCalLite.lpi
+++ b/components/callite/demo2/testCalLite.lpi
@@ -27,18 +27,15 @@
-
+
-
-
-
-
+
-
+
@@ -51,11 +48,6 @@
-
-
-
-
-
diff --git a/components/callite/demo2/umaintestcallite.lfm b/components/callite/demo2/umaintestcallite.lfm
index 61a5cb5da..db8691171 100644
--- a/components/callite/demo2/umaintestcallite.lfm
+++ b/components/callite/demo2/umaintestcallite.lfm
@@ -9,7 +9,6 @@ object Form1: TForm1
Color = clWindow
Font.CharSet = ANSI_CHARSET
OnCreate = FormCreate
- OnResize = FormResize
LCLVersion = '1.7'
object PSettings: TPanel
Left = 0
@@ -174,4 +173,25 @@ object Form1: TForm1
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
+ end
end
diff --git a/components/callite/demo2/umaintestcallite.pp b/components/callite/demo2/umaintestcallite.pp
index d56c07ff4..f6689f990 100644
--- a/components/callite/demo2/umaintestcallite.pp
+++ b/components/callite/demo2/umaintestcallite.pp
@@ -6,16 +6,16 @@ interface
uses
Classes, SysUtils, Forms, Graphics, ExtCtrls, StdCtrls, Spin, CalendarLite;
-// Easysize;
type
{ TForm1 }
TForm1 = class(TForm)
+ CalendarLite1: TCalendarLite;
cbUseHolidays: TCheckBox;
cgOptions: TCheckGroup;
- //FormResizer1: TFormResizer;
+ Label1: TLabel;
LTitle: TLabel;
LWidth: TLabel;
lHeight: TLabel;
@@ -27,14 +27,13 @@ type
procedure cbUseHolidaysChange(Sender: TObject);
procedure cgOptionsItemClick(Sender: TObject; Index: integer);
procedure FormCreate(Sender: TObject);
- procedure FormResize(Sender: TObject);
procedure rgLanguageClick(Sender: TObject);
procedure rgStartingDOWClick(Sender: TObject);
procedure seHeightChange(Sender: TObject);
procedure seWidthChange(Sender: TObject);
private
copyCal, demoCal: TCalendarLite;
- FnoHolidays: boolean;
+ FNoHolidays: boolean;
procedure RespondToDateChange(Sender: tObject);
procedure GetHolidays(Sender: TObject; AMonth, AYear: Integer; // wp
var Holidays: THolidays);
@@ -48,6 +47,9 @@ implementation
{$R *.lfm}
+uses
+ Dialogs;
+
function Easter(year:integer) : TDateTime; // wp
var
Day, Month : integer;
@@ -82,7 +84,6 @@ end;
procedure TForm1.FormCreate(Sender: TObject);
var opt: TCalOption;
begin
-// FormResizer1.InitializeForm;
demoCal:= TCalendarLite.Create(Self);
demoCal.Parent:= Self;
demoCal.Left:= 10;
@@ -115,11 +116,6 @@ begin
copyCal.Options := copyCal.Options + [coShowBorder,coUseTopRowColors,coDayLine];
end;
-procedure TForm1.FormResize(Sender: TObject);
-begin
-// FormResizer1.ResizeAll;
-end;
-
procedure TForm1.rgLanguageClick(Sender: TObject);
begin
case rgLanguage.ItemIndex of
@@ -129,41 +125,6 @@ begin
3: demoCal.Languages := lgHebrew;
4: demoCal.Languages := lgSpanish;
end;
-
- {
- case rgLanguage.ItemIndex of
- 0: begin
- demoCal.DayNames := EnglishDays;
- demoCal.MonthNames := EnglishMonths;
- demoCal.DisplayTexts := DefaultDisplayText;
- demoCal.BiDiMode:= bdLeftToRight;
- end;
- 1: begin
- demoCal.DayNames := FrenchDays;
- demoCal.MonthNames := FrenchMonths;
- demoCal.DisplayTexts := FrenchTexts;
- demoCal.BiDiMode:= bdLeftToRight;
- end;
- 2: begin
- demoCal.DayNames := GermanDays;
- demoCal.MonthNames := GermanMonths;
- demoCal.DisplayTexts := GermamTexts;
- demoCal.BiDiMode:= bdLeftToRight;
- end;
- 3: begin
- demoCal.DayNames := HebrewDays;
- demoCal.MonthNames := HebrewMonths;
- demoCal.DisplayTexts := HebrewTexts;
- demoCal.BiDiMode:= bdRightToLeft;
- end;
- 4: begin
- demoCal.DayNames := SpanishDays;
- demoCal.MonthNames := SpanishMonths;
- demoCal.DisplayTexts := SpanishTexts;
- demoCal.BiDiMode:= bdLeftToRight;
- end;
- end;
- }
end;
procedure TForm1.rgStartingDOWClick(Sender: TObject);
@@ -183,7 +144,7 @@ end;
procedure TForm1.cbUseHolidaysChange(Sender: TObject);
begin
- FnoHolidays := not FnoHolidays;
+ FNoHolidays := not FNoHolidays;
end;
procedure TForm1.cgOptionsItemClick(Sender: TObject; Index: integer);
diff --git a/components/callite/source/calendarlite.pas b/components/callite/source/calendarlite.pas
index b36bec9f6..52a69e8a2 100644
--- a/components/callite/source/calendarlite.pas
+++ b/components/callite/source/calendarlite.pas
@@ -105,6 +105,7 @@ type
coShowTodayFrame, coShowTodayName, coShowTodayRow,
coShowWeekend, coUseTopRowColors);
TCalOptions = set of TCalOption;
+
TLanguage = (lgEnglish, lgFrench, lgGerman, lgHebrew, lgSpanish); //Ariel Rodriguez 12/09/2013
@@ -124,8 +125,8 @@ type
FThisYear: word;
FTStyle: TTextStyle;
procedure CalcSettings;
- procedure ChangeDateTo(aCell: TSize);
- procedure DrawArrow(aRect: TRect; aHead: TArrowhead; aDirn: TArrowDirection);
+ procedure ChangeDateTo(ACell: TSize);
+ procedure DrawArrow(ARect: TRect; AHead: TArrowhead; ADirec: TArrowDirection);
procedure DrawDayCells;
procedure DrawDayLabels;
procedure DrawTodayRow;
@@ -136,18 +137,14 @@ type
function GetLeftColIndex: Integer;
procedure GetMonthYearRects(var AMonthRect, AYearRect: TRect);
function GetRightColIndex: Integer;
- procedure GotoDay(aDate: word);
+ procedure GotoDay(ADate: word);
procedure GotoMonth(AMonth: word);
procedure GotoToday;
procedure GotoYear(AYear: word);
procedure LeftClick;
- procedure NextMonth;
- procedure NextYear;
- procedure PrevMonth;
- procedure PrevYear;
procedure RightClick;
public
- constructor Create(aCanvas: TCanvas);
+ constructor Create(ACanvas: TCanvas);
procedure Draw;
end;
@@ -181,7 +178,8 @@ type
{ TCalendarLite }
- TCalendarLite = class(TGraphicControl)
+// TCalendarLite = class(TGraphicControl)
+ TCalendarLite = class(TCustomControl)
private
FCalDrawer: TCalDrawer;
FColors: TCalColors;
@@ -215,30 +213,64 @@ type
procedure SetWeekendDays(AValue: TDaysOfWeek);
procedure YearMenuItemClicked(Sender: TObject);
procedure SetLanguage(AValue: TLanguage); //Ariel Rodriguez 12/09/2013
+
protected
-// procedure CreateHandle; override;
class function GetControlClassDefaultSize: TSize; override;
function GetDayName(ADayOfWeek: TDayOfWeek): String;
function GetDisplayText(aTextIndex: TDisplayText): String;
function GetMonthName(AMonth: Integer): String;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
procedure Paint; override;
+
public
constructor Create(anOwner: TComponent); override;
destructor Destroy; override;
+
published
- property Anchors;
property Align;
+ property Anchors;
property BiDiMode;
property BorderSpacing;
property Constraints;
+ property Cursor;
property Font;
+ property Height;
+ property HelpContext;
+ property HelpKeyword;
+ property HelpType;
property Hint;
+ property Left;
+ property Name;
+ property ParentBiDiMode;
property ParentColor;
property ParentFont;
+ property PopupMenu;
property ParentShowHint;
property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Tag;
+ property Top;
property Visible;
+ property Width;
+ property OnChangeBounds;
+ property OnClick;
+ property OnContextPopup;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseEnter;
+ property OnMouseLeave;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnMouseWheel;
+ property OnMouseWheelDown;
+ property OnMouseWheelUp;
// new properties
property Colors: TCalColors read FColors;
property Date: TDateTime read FDate write SetDate;
@@ -267,7 +299,7 @@ procedure Register; //Ariel Rodriguez 12/09/2013
implementation
uses
- LazUTF8, dateutils, math;
+ LCLType, LazUTF8, dateutils, math;
{ Holiday helpers }
@@ -293,10 +325,10 @@ end;
{ TCalDrawer }
-constructor TCalDrawer.Create(aCanvas: TCanvas);
+constructor TCalDrawer.Create(ACanvas: TCanvas);
begin
inherited Create;
- FCanvas:= aCanvas;
+ FCanvas:= ACanvas;
FTStyle:= DefTStyle;
end;
@@ -362,13 +394,13 @@ begin
FRowPositions[TodayRow] := FRowPositions[LastDateRow] + borderv + ch + rem;
end;
-procedure TCalDrawer.ChangeDateTo(aCell: TSize);
+procedure TCalDrawer.ChangeDateTo(ACell: TSize);
var
diff: integer;
newDate: TDateTime;
d, m, y: word;
begin
- diff := aCell.cx + LastCol * (aCell.cy - 2);
+ diff := ACell.cx + LastCol * (ACell.cy - 2);
newDate:= FStartDate + diff - 1;
FOwner.FDate := newDate;
FOwner.DateChange;
@@ -389,7 +421,8 @@ begin
DrawTodayRow;
end;
-procedure TCalDrawer.DrawArrow(aRect: TRect; aHead: TArrowhead; aDirn: TArrowDirection);
+procedure TCalDrawer.DrawArrow(ARect: TRect; AHead: TArrowhead;
+ ADirec: TArrowDirection);
var
sz: TSize;
d, ox, oy, half: integer;
@@ -402,12 +435,12 @@ begin
sz := Size(aRect);
d := Min(sz.cy, sz.cx) div 3;
half := d div 2;
- ox := aRect.Left + (sz.cx - d) div 2;
- oy := aRect.Top + (sz.cy - d) div 2;
- case aHead of
+ ox := ARect.Left + (sz.cx - d) div 2;
+ oy := ARect.Top + (sz.cy - d) div 2;
+ case AHead of
ahSingle:
begin
- case aDirn of
+ case ADirec of
adLeft:
begin
pts[1]:= Point(ox+d, oy);
@@ -424,7 +457,7 @@ begin
FCanvas.Polygon(pts);
end;
ahDouble:
- case aDirn of
+ case ADirec of
adLeft:
begin
pts[1]:= Point(ox+half-1, oy);
@@ -806,11 +839,9 @@ begin
Result := 1;
end;
-procedure TCalDrawer.GotoDay(aDate: word);
+procedure TCalDrawer.GotoDay(ADate: word);
begin
- FOwner.FDate := aDate;
- FOwner.DateChange;
- FOwner.Invalidate;
+ FOwner.Date := ADate;
end;
procedure TCalDrawer.GotoMonth(AMonth: word);
@@ -819,16 +850,12 @@ var
begin
if not TryEncodeDate(FThisYear, AMonth, FThisDay, d) then // Feb 29 in leap year!
d := EncodeDate(FThisYear, AMonth, FThisDay);
- FOwner.FDate := d;
- FOwner.DateChange;
- FOwner.Invalidate;
+ FOwner.Date := d;
end;
procedure TCalDrawer.GotoToday;
begin
- FOwner.FDate:= Date();
- FOwner.DateChange;
- FOwner.Invalidate;
+ FOwner.Date:= Date();
end;
procedure TCalDrawer.GotoYear(AYear: word);
@@ -837,9 +864,7 @@ var
begin
if not TryEncodeDate(AYear, FThisMonth, FThisDay, d) then // Feb 29 in leap year!
d := EncodeDate(AYear, FThisMonth, FThisDay);
- FOwner.FDate := d;
- FOwner.DateChange;
- FOwner.Invalidate;
+ FOwner.Date := d;
end;
procedure TCalDrawer.LeftClick;
@@ -853,8 +878,8 @@ begin
case cell.cy of
TopRow:
case cell.cx of
- 1: PrevYear;
- 2: PrevMonth;
+ 1: FOwner.Date := IncYear(FOwner.Date, -1);
+ 2: FOwner.Date := IncMonth(FOwner.Date, -1);
3..5:
begin
GetMonthYearRects(Rm{%H-}, Ry{%H-});
@@ -869,45 +894,59 @@ begin
FOwner.FPopupMenu.Popup(ppopup.x, ppopup.y);
end;
end;
- 6: NextMonth;
- 7: NextYear;
+ 6: FOwner.Date := IncMonth(FOwner.Date, +1);
+ 7: FOwner.Date := IncYear(FOwner.Date, +1);
end;
+
DayRow: ;
+
FirstDateRow..LastDateRow :
ChangeDateTo(cell);
else
GotoToday;
end;
end;
+ (*
+procedure TCalDrawer.NextDay;
+begin
+ FOwner.Date := IncDay(FOwner.FDate, 1);
+end;
procedure TCalDrawer.NextMonth;
begin
- FOwner.FDate := IncMonth(FOwner.FDate, 1);
- FOwner.DateChange;
- FOwner.Invalidate;
+ FOwner.Date := IncMonth(FOwner.FDate, 1);
+end;
+
+procedure TCalDrawer.NextWeek;
+begin
+ FOwner.Date := IncWeek(FOwner.FDate, 1);
end;
procedure TCalDrawer.NextYear;
begin
- FOwner.FDate := IncYear(FOwner.FDate, 1);
- FOwner.DateChange;
- FOwner.Invalidate;
+ FOwner.Date := IncYear(FOwner.FDate, 1);
+end;
+
+procedure TCalDrawer.PrevDay;
+begin
+ FOwner.Date := IncDay(FOwner.FDate, -1);
end;
procedure TCalDrawer.PrevMonth;
begin
- FOwner.FDate := IncMonth(FOwner.FDate, -1);
- FOwner.DateChange;
- FOwner.Invalidate;
+ FOwner.Date := IncMonth(FOwner.FDate, -1);
+end;
+
+procedure TCalDrawer.PrevWeek;
+begin
+ FOwner.Date := IncWeek(FOwner.FDate, -1);
end;
procedure TCalDrawer.PrevYear;
begin
- FOwner.FDate := IncYear(FOwner.FDate, -1);
- FOwner.DateChange;
- FOwner.Invalidate;
+ FOwner.Date := IncYear(FOwner.FDate, -1);
end;
-
+ *)
procedure TCalDrawer.RightClick;
begin
if Assigned(FOwner.FOnGetHolidays) then
@@ -958,22 +997,23 @@ constructor TCalendarLite.Create(anOwner: TComponent);
begin
inherited Create(anOwner);
FColors := TCalColors.Create(self);
- FDate:= SysUtils.Date;
- Color:= clWhite;
+ FDate := SysUtils.Date;
+ Color := clWhite;
FStartingDayOfWeek:= dowSunday;
with GetControlClassDefaultSize do
SetInitialBounds(0, 0, cx, cy);
Constraints.MinHeight := DefMinHeight;
Constraints.MinWidth := DefMinWidth;
- Canvas.Brush.Style:= bsSolid;
+ Canvas.Brush.Style := bsSolid;
+ TabStop := true;
FDayNames := TStringList.Create;
FMonthNames := TStringList.Create;
FDisplayTexts := TStringList.Create;
FDisplayTexts.StrictDelimiter := True;
- FDisplayTexts.Delimiter:= ',';
+ FDisplayTexts.Delimiter := ',';
SetDefaultDisplayTexts;
FPopupMenu := TPopupMenu.Create(Self);
- FCalDrawer:= TCalDrawer.Create(Canvas);
+ FCalDrawer := TCalDrawer.Create(Canvas);
FCalDrawer.FOwner:= Self;
FWeekendDays := [dowSunday, dowSaturday];
FOptions := [coShowTodayFrame, coBoldHolidays, coShowWeekend, coShowHolidays,
@@ -1043,10 +1083,41 @@ begin
FCalDrawer.GotoDay(TMenuItem(Sender).Tag);
end;
+procedure TCalendarLite.KeyDown(var Key: Word; Shift: TShiftState);
+
+ function Delta(Increase: Boolean): Integer;
+ begin
+ if Increase then Result := +1 else Result := -1;
+ end;
+
+begin
+ case Key of
+ VK_UP,
+ VK_DOWN : Date := IncWeek(FDate, Delta(Key = VK_DOWN));
+ VK_LEFT,
+ VK_RIGHT : Date := IncDay(FDate, Delta(Key = VK_RIGHT));
+ VK_HOME : Date := StartOfTheMonth(FDate);
+ VK_END : Date := EndOfTheMonth(FDate);
+ VK_PRIOR,
+ VK_NEXT : if (ssCtrl in Shift) then
+ Date := IncYear(FDate, Delta(Key = VK_NEXT)) else
+ Date := IncMonth(FDate, Delta(Key = VK_NEXT));
+ else inherited;
+ exit;
+ end;
+
+ Key := 0;
+ inherited;
+end;
+
procedure TCalendarLite.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
+
+ if not Focused and not(csNoFocus in ControlStyle) then
+ SetFocus;
+
case Button of
mbLeft : FCalDrawer.LeftClick;
mbRight : FCalDrawer.RightClick;