pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases 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
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.