paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

CalLite: Add keyboard support. Some refactoring.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5314 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2016-11-04 10:43:52 +00:00
parent f83799d4a3
commit 1d40bd7687
6 changed files with 166 additions and 231 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
components/callite/demo1/main.lfm
View File

@ -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

74
components/callite/demo1/main.pas
View File

@ -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.

14
components/callite/demo2/testCalLite.lpi
View File

@ -27,18 +27,15 @@
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="3">
<RequiredPackages Count="2">
<Item1>
<PackageName Value="callight_pkg"/>
</Item1>
<Item2>
<PackageName Value="RunTimeTypeInfoControls"/>
</Item2>
<Item3>
<PackageName Value="LCL"/>
</Item3>
</Item2>
</RequiredPackages>
<Units Count="3">
<Units Count="2">
<Unit0>
<Filename Value="testCalLite.lpr"/>
<IsPartOfProject Value="True"/>
@ -51,11 +48,6 @@
<ResourceBaseClass Value="Form"/>
<UnitName Value="uMainTestCalLite"/>
</Unit1>
<Unit2>
<Filename Value="calendarlite.pp"/>
<IsPartOfProject Value="True"/>
<UnitName Value="CalendarLite"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>

22
components/callite/demo2/umaintestcallite.lfm
View File

@ -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

53
components/callite/demo2/umaintestcallite.pp
View File

@ -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);

185
components/callite/source/calendarlite.pas
View File

@ -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;