pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

CalLite: Add properties ButtonHeight and ButtonWidth for the size of the month/year navigation buttons in the top row.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6778 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-12-29 20:47:47 +00:00
parent 219cf32bb7
commit e13de9b592
3 changed files with 272 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,10 +2,10 @@ object Form1: TForm1
Left = 700 Left = 700
Height = 845 Height = 845
Top = 122 Top = 122
Width = 753 Width = 851
Caption = 'Examples of the TCalendaLite component' Caption = 'Examples of the TCalendaLite component'
ClientHeight = 845 ClientHeight = 845
ClientWidth = 753 ClientWidth = 851
Color = clWindow Color = clWindow
Font.CharSet = ANSI_CHARSET Font.CharSet = ANSI_CHARSET
OnCreate = FormCreate OnCreate = FormCreate
@ -14,10 +14,10 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 448 Height = 448
Top = 0 Top = 0
Width = 753 Width = 851
Align = alTop Align = alTop
ClientHeight = 448 ClientHeight = 448
ClientWidth = 753 ClientWidth = 851
TabOrder = 0 TabOrder = 0
object cgOptions: TCheckGroup object cgOptions: TCheckGroup
Left = 24 Left = 24
@ -80,13 +80,13 @@ object Form1: TForm1
object LWidth: TLabel object LWidth: TLabel
Left = 560 Left = 560
Height = 15 Height = 15
Top = 50 Top = 52
Width = 32 Width = 32
Caption = 'Width' Caption = 'Width'
ParentColor = False ParentColor = False
end end
object seWidth: TSpinEdit object seWidth: TSpinEdit
Left = 617 Left = 608
Height = 23 Height = 23
Top = 48 Top = 48
Width = 66 Width = 66
@ -97,9 +97,9 @@ object Form1: TForm1
Value = 400 Value = 400
end end
object seHeight: TSpinEdit object seHeight: TSpinEdit
Left = 617 Left = 608
Height = 23 Height = 23
Top = 81 Top = 78
Width = 66 Width = 66
MaxValue = 1000 MaxValue = 1000
MinValue = 120 MinValue = 120
@ -492,8 +492,8 @@ object Form1: TForm1
Left = 560 Left = 560
Height = 152 Height = 152
Top = 280 Top = 280
Width = 168 Width = 274
Columns = 2 Columns = 3
ItemHeight = 0 ItemHeight = 0
TabOrder = 13 TabOrder = 13
end end
@ -508,6 +508,130 @@ object Form1: TForm1
State = cbChecked State = cbChecked
TabOrder = 14 TabOrder = 14
end end
object LWidth1: TLabel
Left = 693
Height = 15
Top = 52
Width = 66
Caption = 'Buttonwidth'
ParentColor = False
end
object seButtonWidth: TSpinEdit
Left = 768
Height = 23
Top = 48
Width = 50
MinValue = 10
OnChange = seButtonWidthChange
TabOrder = 15
Value = 10
end
object lHeight1: TLabel
Left = 693
Height = 15
Top = 81
Width = 70
Caption = 'Buttonheight'
ParentColor = False
end
object seButtonHeight: TSpinEdit
Left = 768
Height = 23
Top = 78
Width = 50
MinValue = 10
OnChange = seButtonHeightChange
TabOrder = 16
Value = 10
end
object sbResetButtonWidth: TSpeedButton
Left = 820
Height = 23
Hint = 'Reset button width'
Top = 48
Width = 23
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000300000
0033000000330000003300000033000000330000000000000000000000000000
0000000000000000000000000000000000000000000000000000B78343F2B782
41FFB68242FFB78242FFB88342FFBA8545FFBB874700BB874700BB874700BB87
4700BB874700BB874700BB874700BB8747000000002400000031B78240FFFDE6
C3FFECBA6DFFEDBC70FFF2D9B5FFAF824AAFBA864600BB874700BB874700BB87
4700BB874700BB874700BB87470000000021AC7C41C1BA8646F9B6803EFFF4DB
B5FFDDA859FFDFAB5EFFC7934CFFA8773DBF00000030000000150000000A0000
000A0000000A0000001500000031A9793FB9BB8747FFBB8747FFB6803EFFF9ED
D9FFEFD9B8FFDCAE6CFFD7A050FFC48E47FFB68041F490663486644724596648
255B6447245990663387B88341F6C29357FFBB8646FFBB874747B88241FFDFC0
91FFC69454FFEDDABCFFE6CBA3FFDCB47BFFCFA060FFC6995FFFC4965EFFC597
5EFFC5975FFFCEA571FFE2C7A0FFC5975DFFBA8645AABB874700BA8545FFB984
42A3B882409FBD8B4EFFD9B98FFFE9D4B7FFECDBBFFFEDDBBFFFEDDBBFFFEDDC
C0FFE7D1B0FFD3B081FFBC8948FFB9854496BB874600BB874700BB874700BB87
4600BA864500B9854433B88241A8B7813FF5B7813EFFB7803EFFB7813EFFB781
3EFFB8823FFFB98442A8BA85450ABB864600BB874700BB874700FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
OnClick = sbResetButtonWidthClick
end
object sbResetButtonHeight: TSpeedButton
Left = 820
Height = 23
Hint = 'Reset button width'
Top = 78
Width = 23
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00000000300000
0033000000330000003300000033000000330000000000000000000000000000
0000000000000000000000000000000000000000000000000000B78343F2B782
41FFB68242FFB78242FFB88342FFBA8545FFBB874700BB874700BB874700BB87
4700BB874700BB874700BB874700BB8747000000002400000031B78240FFFDE6
C3FFECBA6DFFEDBC70FFF2D9B5FFAF824AAFBA864600BB874700BB874700BB87
4700BB874700BB874700BB87470000000021AC7C41C1BA8646F9B6803EFFF4DB
B5FFDDA859FFDFAB5EFFC7934CFFA8773DBF00000030000000150000000A0000
000A0000000A0000001500000031A9793FB9BB8747FFBB8747FFB6803EFFF9ED
D9FFEFD9B8FFDCAE6CFFD7A050FFC48E47FFB68041F490663486644724596648
255B6447245990663387B88341F6C29357FFBB8646FFBB874747B88241FFDFC0
91FFC69454FFEDDABCFFE6CBA3FFDCB47BFFCFA060FFC6995FFFC4965EFFC597
5EFFC5975FFFCEA571FFE2C7A0FFC5975DFFBA8645AABB874700BA8545FFB984
42A3B882409FBD8B4EFFD9B98FFFE9D4B7FFECDBBFFFEDDBBFFFEDDBBFFFEDDC
C0FFE7D1B0FFD3B081FFBC8948FFB9854496BB874600BB874700BB874700BB87
4600BA864500B9854433B88241A8B7813FF5B7813EFFB7803EFFB7813EFFB781
3EFFB8823FFFB98442A8BA85450ABB864600BB874700BB874700FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
OnClick = sbResetButtonHeightClick
end
end end
object Label1: TLabel object Label1: TLabel
Left = 15 Left = 15

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

@ -6,7 +6,7 @@ interface
uses uses
Classes, SysUtils, Forms, Graphics, ExtCtrls, StdCtrls, Spin, Dialogs, Classes, SysUtils, Forms, Graphics, ExtCtrls, StdCtrls, Spin, Dialogs,
Controls, Menus, CalendarLite; Controls, Menus, Buttons, CalendarLite, LCLVersion;
type type
@ -52,10 +52,13 @@ type
Label7: TLabel; Label7: TLabel;
Label8: TLabel; Label8: TLabel;
Label9: TLabel; Label9: TLabel;
lHeight1: TLabel;
LWidth1: TLabel;
MenuItem1: TMenuItem; MenuItem1: TMenuItem;
MenuItem2: TMenuItem; MenuItem2: TMenuItem;
MenuItem3: TMenuItem; MenuItem3: TMenuItem;
PopupMenu1: TPopupMenu; PopupMenu1: TPopupMenu;
seButtonHeight: TSpinEdit;
SelDateListbox: TListBox; SelDateListbox: TListBox;
LTitle: TLabel; LTitle: TLabel;
LWidth: TLabel; LWidth: TLabel;
@ -65,6 +68,9 @@ type
rgStartingDOW: TRadioGroup; rgStartingDOW: TRadioGroup;
seWidth: TSpinEdit; seWidth: TSpinEdit;
seHeight: TSpinEdit; seHeight: TSpinEdit;
seButtonWidth: TSpinEdit;
sbResetButtonWidth: TSpeedButton;
sbResetButtonHeight: TSpeedButton;
procedure BtnFontClick(Sender: TObject); procedure BtnFontClick(Sender: TObject);
procedure CbAddHolidayNameToCellChange(Sender: TObject); procedure CbAddHolidayNameToCellChange(Sender: TObject);
procedure CbDrawCellChange(Sender: TObject); procedure CbDrawCellChange(Sender: TObject);
@ -78,8 +84,12 @@ type
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure rgLanguageClick(Sender: TObject); procedure rgLanguageClick(Sender: TObject);
procedure rgStartingDOWClick(Sender: TObject); procedure rgStartingDOWClick(Sender: TObject);
procedure sbResetButtonHeightClick(Sender: TObject);
procedure seButtonHeightChange(Sender: TObject);
procedure seHeightChange(Sender: TObject); procedure seHeightChange(Sender: TObject);
procedure seButtonWidthChange(Sender: TObject);
procedure seWidthChange(Sender: TObject); procedure seWidthChange(Sender: TObject);
procedure sbResetButtonWidthClick(Sender: TObject);
private private
copyCal, demoCal: TCalendarLite; copyCal, demoCal: TCalendarLite;
FNoHolidays: boolean; FNoHolidays: boolean;
@ -220,16 +230,42 @@ begin
demoCal.StartingDayOfWeek := TDayOfWeek(rgStartingDOW.ItemIndex + 1); demoCal.StartingDayOfWeek := TDayOfWeek(rgStartingDOW.ItemIndex + 1);
end; end;
procedure TForm1.sbResetButtonHeightClick(Sender: TObject);
begin
demoCal.ButtonHeight := 0;
seButtonHeight.OnChange := nil;
seButtonHeight.Value := 10;
seButtonHeight.OnChange := @seButtonHeightChange;
end;
procedure TForm1.seButtonHeightChange(Sender: TObject);
begin
demoCal.ButtonHeight := seButtonHeight.Value;
end;
procedure TForm1.seHeightChange(Sender: TObject); procedure TForm1.seHeightChange(Sender: TObject);
begin begin
demoCal.Height := seHeight.Value; demoCal.Height := seHeight.Value;
end; end;
procedure TForm1.seButtonWidthChange(Sender: TObject);
begin
demoCal.ButtonWidth := seButtonWidth.Value;
end;
procedure TForm1.seWidthChange(Sender: TObject); procedure TForm1.seWidthChange(Sender: TObject);
begin begin
demoCal.Width := seWidth.Value; demoCal.Width := seWidth.Value;
end; end;
procedure TForm1.sbResetButtonWidthClick(Sender: TObject);
begin
demoCal.ButtonWidth := 0;
seButtonWidth.OnChange := nil;
seButtonWidth.Value := 10;
seButtonWidth.OnChange := @seButtonWidthChange;
end;
procedure TForm1.ColorButtonChanged(Sender: TObject); procedure TForm1.ColorButtonChanged(Sender: TObject);
var var
calendar: TCalendarLite; calendar: TCalendarLite;

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

@ -41,8 +41,12 @@ unit CalendarLite;
interface interface
uses uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Types, Classes, SysUtils, LResources, LCLVersion,
ExtCtrls, Menus; Forms, Controls, Graphics, Dialogs, Types, ExtCtrls, Menus;
{$if lcl_fullversion >= 1080000}
{$define lcl_scaling}
{$ifend}
const const
LastCol = 7; LastCol = 7;
@ -220,6 +224,8 @@ type
FLanguage: TLanguage; FLanguage: TLanguage;
FDblClickTimer: TTimer; FDblClickTimer: TTimer;
FFormatSettings: TFormatSettings; FFormatSettings: TFormatSettings;
FButtonHeight: Integer;
FButtonWidth: Integer;
function GetDayNames: String; function GetDayNames: String;
function GetDisplayText(aTextIndex: TDisplayText): String; function GetDisplayText(aTextIndex: TDisplayText): String;
function GetDisplayTexts: String; function GetDisplayTexts: String;
@ -229,6 +235,8 @@ type
procedure PopulateHolidayPopupMenu; procedure PopulateHolidayPopupMenu;
procedure PopulateMonthPopupMenu; procedure PopulateMonthPopupMenu;
procedure PopulateYearPopupMenu; procedure PopulateYearPopupMenu;
procedure SetButtonHeight(const AValue: Integer);
procedure SetButtonWidth(const AValue: Integer);
procedure SetCustomDayNames(const AValue: String); procedure SetCustomDayNames(const AValue: String);
procedure SetCustomDisplayTexts(const AValue: String); procedure SetCustomDisplayTexts(const AValue: String);
procedure SetCustomMonthNames(const AValue: String); procedure SetCustomMonthNames(const AValue: String);
@ -248,6 +256,10 @@ type
protected protected
procedure ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode); procedure ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
procedure DateChange; virtual; procedure DateChange; virtual;
{$ifdef lcl_scaling}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{$endif}
procedure DblClick; override; procedure DblClick; override;
class function GetControlClassDefaultSize: TSize; override; class function GetControlClassDefaultSize: TSize; override;
procedure InternalClick; procedure InternalClick;
@ -328,6 +340,8 @@ type
property OnMouseWheelUp; property OnMouseWheelUp;
// new properties // new properties
property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default 0;
property ButtonHeight: Integer read FButtonHeight write SetButtonHeight default 0;
property Colors: TCalColors read FColors write FColors; property Colors: TCalColors read FColors write FColors;
property Date: TDateTime read FDate write SetDate; property Date: TDateTime read FDate write SetDate;
property DayNames: String read FCustomDayNames write SetCustomDayNames; property DayNames: String read FCustomDayNames write SetCustomDayNames;
@ -661,7 +675,7 @@ var
ch: Integer = 0; ch: Integer = 0;
sp: Integer = 0; sp: Integer = 0;
cw: Integer = 0; cw: Integer = 0;
bit: integer=0; bit: integer = 0;
i, cellWidths, totalSpace, cellHeights, i, cellWidths, totalSpace, cellHeights,
adjSpace, borderh, borderv, numRows: integer; adjSpace, borderh, borderv, numRows: integer;
sz: TSize; sz: TSize;
@ -731,7 +745,7 @@ procedure TCalDrawer.DrawArrow(ARect: TRect; AHead: TArrowhead;
ADirec: TArrowDirection); ADirec: TArrowDirection);
var var
sz: TSize; sz: TSize;
d, ox, oy, half: integer; dx, dy, ox, oy, halfx, halfy: integer;
pts: TArrowPoints; pts: TArrowPoints;
begin begin
FCanvas.Pen.Style := psSolid; FCanvas.Pen.Style := psSolid;
@ -740,25 +754,33 @@ begin
if (FCanvas.Pen.Color <> FOwner.Colors.ArrowBorderColor) then if (FCanvas.Pen.Color <> FOwner.Colors.ArrowBorderColor) then
FCanvas.Pen.Color := FOwner.Colors.ArrowBorderColor; FCanvas.Pen.Color := FOwner.Colors.ArrowBorderColor;
sz := Size(aRect); sz := Size(aRect);
d := Min(sz.cy, sz.cx) div 3; if FOwner.ButtonWidth = 0 then
half := d div 2; dx := Min(sz.cy, sz.cx) div 3
ox := ARect.Left + (sz.cx - d) div 2; else
oy := ARect.Top + (sz.cy - d) div 2; dx := FOwner.ButtonWidth;
if FOwner.ButtonHeight = 0 then
dy := Min(sz.cy, sz.cx) div 3
else
dy := FOwner.ButtonHeight;
halfx := dx div 2;
halfy := dy div 2;
ox := ARect.Left + (sz.cx - dx) div 2;
oy := ARect.Top + (sz.cy - dy) div 2;
case AHead of case AHead of
ahSingle: ahSingle:
begin begin
case ADirec of case ADirec of
adLeft: adLeft:
begin begin
pts[1]:= Point(ox+d, oy); pts[1]:= Point(ox+dx, oy);
pts[2]:= Point(ox, oy+half); pts[2]:= Point(ox, oy+halfy);
pts[3]:= Point(ox+d, oy+d); pts[3]:= Point(ox+dx, oy+dy);
end; end;
adRight: adRight:
begin begin
pts[1]:= Point(ox, oy); pts[1]:= Point(ox, oy);
pts[2]:= Point(ox, oy+d); pts[2]:= Point(ox, oy+dy);
pts[3]:= Point(ox+d, oy+half); pts[3]:= Point(ox+dx, oy+halfy);
end; end;
end; end;
FCanvas.Polygon(pts); FCanvas.Polygon(pts);
@ -767,24 +789,24 @@ begin
case ADirec of case ADirec of
adLeft: adLeft:
begin begin
pts[1]:= Point(ox+half-1, oy); pts[1]:= Point(ox+halfx-1, oy);
pts[2]:= Point(ox-1, oy+half); pts[2]:= Point(ox-1, oy+halfy);
pts[3]:= Point(ox+half-1, oy+d); pts[3]:= Point(ox+halfx-1, oy+dy);
FCanvas.Polygon(pts); FCanvas.Polygon(pts);
pts[1]:= Point(ox+d, oy); pts[1]:= Point(ox+dx, oy);
pts[2]:= Point(ox+half, oy+half); pts[2]:= Point(ox+halfx, oy+halfy);
pts[3]:= Point(ox+d, oy+d); pts[3]:= Point(ox+dx, oy+dy);
FCanvas.Polygon(pts); FCanvas.Polygon(pts);
end; end;
adRight: adRight:
begin begin
pts[1]:= Point(ox, oy); pts[1]:= Point(ox, oy);
pts[2]:= Point(ox+half, oy+half); pts[2]:= Point(ox+halfx, oy+halfy);
pts[3]:= Point(ox, oy+d); pts[3]:= Point(ox, oy+dy);
FCanvas.Polygon(pts); FCanvas.Polygon(pts);
pts[1]:= Point(ox+half+1, oy); pts[1]:= Point(ox+halfx+1, oy);
pts[2]:= Point(ox+d+1, oy+half); pts[2]:= Point(ox+dx+1, oy+halfy);
pts[3]:= Point(ox+half+1, oy+d); pts[3]:= Point(ox+halfx+1, oy+dy);
FCanvas.Polygon(pts); FCanvas.Polygon(pts);
end; end;
end; end;
@ -1362,8 +1384,13 @@ begin
FStartingDayOfWeek:= dowSunday; FStartingDayOfWeek:= dowSunday;
with GetControlClassDefaultSize do with GetControlClassDefaultSize do
SetInitialBounds(0, 0, cx, cy); SetInitialBounds(0, 0, cx, cy);
{$ifdef lcl_scaling}
Constraints.MinHeight := DefMinHeight;
Constraints.MinWidth := DefMinWidth;
{$else}
Constraints.MinHeight := ScaleX(DefMinHeight, DESIGNTIME_PPI); Constraints.MinHeight := ScaleX(DefMinHeight, DESIGNTIME_PPI);
Constraints.MinWidth := ScaleY(DefMinWidth, DESIGNTIME_PPI); Constraints.MinWidth := ScaleY(DefMinWidth, DESIGNTIME_PPI);
{$endif}
Canvas.Brush.Style := bsSolid; Canvas.Brush.Style := bsSolid;
TabStop := true; TabStop := true;
SetDefaultDayNames; SetDefaultDayNames;
@ -1506,10 +1533,28 @@ begin
end; end;
end; end;
{$ifdef lcl_scaling}
procedure TCalendarLite.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited;
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
FButtonWidth := round(FButtonWidth * AXProportion);
FButtonHeight := round(FButtonHeight * AYProportion);
end;
end;
{$endif}
class function TCalendarLite.GetControlClassDefaultSize: TSize; class function TCalendarLite.GetControlClassDefaultSize: TSize;
begin begin
{$ifdef lcl_scaling}
Result.cx := DefCalWidth;
Result.cy := DefCalHeight;
{$else}
Result.cx := ScaleX(DefCalWidth, DESIGNTIME_PPI); Result.cx := ScaleX(DefCalWidth, DESIGNTIME_PPI);
Result.cy := ScaleY(DefCalHeight, DESIGNTIME_PPI); Result.cy := ScaleY(DefCalHeight, DESIGNTIME_PPI);
{$endif}
end; end;
function TCalendarLite.GetDayName(ADayOfWeek: TDayOfWeek): String; function TCalendarLite.GetDayName(ADayOfWeek: TDayOfWeek): String;
@ -1830,26 +1875,18 @@ begin
Result := FSelDates.AsArray; Result := FSelDates.AsArray;
end; end;
function TCalendarLite.SelMode(Shift: TShiftState): TCalSelMode; procedure TCalendarLite.SetButtonHeight(const AValue: Integer);
begin begin
Result := smFirstSingle; if FButtonHeight = AValue then exit;
if not FMultiSelect then FButtonHeight := AValue;
exit; Invalidate;
end;
if (ssDouble in Shift) then begin procedure TCalendarLite.SetButtonWidth(const AValue: Integer);
Result := smFirstWeek; begin
if (ssCtrl in Shift) and (FPrevDate > 0) then if FButtonWidth = AValue then exit;
Result := smNextWeek FButtonWidth := AValue;
else if (ssShift in Shift) and (FPrevDate > 0) then Invalidate;
Result := smNextWeekRange
end else
if (ssShift in Shift) then begin
Result := smFirstRange;
if (ssCtrl in Shift) and (FPrevDate > 0) then
Result := smNextRange;
end else
if (ssCtrl in Shift) and (FPrevDate > 0) then
Result := smNextSingle;
end; end;
procedure TCalendarLite.SetCustomDayNames(const AValue: String); procedure TCalendarLite.SetCustomDayNames(const AValue: String);
@ -2019,6 +2056,28 @@ begin
Invalidate; Invalidate;
end; end;
function TCalendarLite.SelMode(Shift: TShiftState): TCalSelMode;
begin
Result := smFirstSingle;
if not FMultiSelect then
exit;
if (ssDouble in Shift) then begin
Result := smFirstWeek;
if (ssCtrl in Shift) and (FPrevDate > 0) then
Result := smNextWeek
else if (ssShift in Shift) and (FPrevDate > 0) then
Result := smNextWeekRange
end else
if (ssShift in Shift) then begin
Result := smFirstRange;
if (ssCtrl in Shift) and (FPrevDate > 0) then
Result := smNextRange;
end else
if (ssCtrl in Shift) and (FPrevDate > 0) then
Result := smNextSingle;
end;
procedure TCalendarLite.SetMultiSelect(AValue: Boolean); procedure TCalendarLite.SetMultiSelect(AValue: Boolean);
begin begin
if AValue = FMultiSelect then if AValue = FMultiSelect then