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;