You've already forked lazarus-ccr
CalLite: Add properties ButtonHeight and ButtonWidth for the size of the month/year navigation buttons in the top row.
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
@ -2,10 +2,10 @@ object Form1: TForm1
|
||||
Left = 700
|
||||
Height = 845
|
||||
Top = 122
|
||||
Width = 753
|
||||
Width = 851
|
||||
Caption = 'Examples of the TCalendaLite component'
|
||||
ClientHeight = 845
|
||||
ClientWidth = 753
|
||||
ClientWidth = 851
|
||||
Color = clWindow
|
||||
Font.CharSet = ANSI_CHARSET
|
||||
OnCreate = FormCreate
|
||||
@ -14,10 +14,10 @@ object Form1: TForm1
|
||||
Left = 0
|
||||
Height = 448
|
||||
Top = 0
|
||||
Width = 753
|
||||
Width = 851
|
||||
Align = alTop
|
||||
ClientHeight = 448
|
||||
ClientWidth = 753
|
||||
ClientWidth = 851
|
||||
TabOrder = 0
|
||||
object cgOptions: TCheckGroup
|
||||
Left = 24
|
||||
@ -80,13 +80,13 @@ object Form1: TForm1
|
||||
object LWidth: TLabel
|
||||
Left = 560
|
||||
Height = 15
|
||||
Top = 50
|
||||
Top = 52
|
||||
Width = 32
|
||||
Caption = 'Width'
|
||||
ParentColor = False
|
||||
end
|
||||
object seWidth: TSpinEdit
|
||||
Left = 617
|
||||
Left = 608
|
||||
Height = 23
|
||||
Top = 48
|
||||
Width = 66
|
||||
@ -97,9 +97,9 @@ object Form1: TForm1
|
||||
Value = 400
|
||||
end
|
||||
object seHeight: TSpinEdit
|
||||
Left = 617
|
||||
Left = 608
|
||||
Height = 23
|
||||
Top = 81
|
||||
Top = 78
|
||||
Width = 66
|
||||
MaxValue = 1000
|
||||
MinValue = 120
|
||||
@ -492,8 +492,8 @@ object Form1: TForm1
|
||||
Left = 560
|
||||
Height = 152
|
||||
Top = 280
|
||||
Width = 168
|
||||
Columns = 2
|
||||
Width = 274
|
||||
Columns = 3
|
||||
ItemHeight = 0
|
||||
TabOrder = 13
|
||||
end
|
||||
@ -508,6 +508,130 @@ object Form1: TForm1
|
||||
State = cbChecked
|
||||
TabOrder = 14
|
||||
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
|
||||
object Label1: TLabel
|
||||
Left = 15
|
||||
|
||||
@ -6,7 +6,7 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Graphics, ExtCtrls, StdCtrls, Spin, Dialogs,
|
||||
Controls, Menus, CalendarLite;
|
||||
Controls, Menus, Buttons, CalendarLite, LCLVersion;
|
||||
|
||||
type
|
||||
|
||||
@ -52,10 +52,13 @@ type
|
||||
Label7: TLabel;
|
||||
Label8: TLabel;
|
||||
Label9: TLabel;
|
||||
lHeight1: TLabel;
|
||||
LWidth1: TLabel;
|
||||
MenuItem1: TMenuItem;
|
||||
MenuItem2: TMenuItem;
|
||||
MenuItem3: TMenuItem;
|
||||
PopupMenu1: TPopupMenu;
|
||||
seButtonHeight: TSpinEdit;
|
||||
SelDateListbox: TListBox;
|
||||
LTitle: TLabel;
|
||||
LWidth: TLabel;
|
||||
@ -65,6 +68,9 @@ type
|
||||
rgStartingDOW: TRadioGroup;
|
||||
seWidth: TSpinEdit;
|
||||
seHeight: TSpinEdit;
|
||||
seButtonWidth: TSpinEdit;
|
||||
sbResetButtonWidth: TSpeedButton;
|
||||
sbResetButtonHeight: TSpeedButton;
|
||||
procedure BtnFontClick(Sender: TObject);
|
||||
procedure CbAddHolidayNameToCellChange(Sender: TObject);
|
||||
procedure CbDrawCellChange(Sender: TObject);
|
||||
@ -78,8 +84,12 @@ type
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure rgLanguageClick(Sender: TObject);
|
||||
procedure rgStartingDOWClick(Sender: TObject);
|
||||
procedure sbResetButtonHeightClick(Sender: TObject);
|
||||
procedure seButtonHeightChange(Sender: TObject);
|
||||
procedure seHeightChange(Sender: TObject);
|
||||
procedure seButtonWidthChange(Sender: TObject);
|
||||
procedure seWidthChange(Sender: TObject);
|
||||
procedure sbResetButtonWidthClick(Sender: TObject);
|
||||
private
|
||||
copyCal, demoCal: TCalendarLite;
|
||||
FNoHolidays: boolean;
|
||||
@ -220,16 +230,42 @@ begin
|
||||
demoCal.StartingDayOfWeek := TDayOfWeek(rgStartingDOW.ItemIndex + 1);
|
||||
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);
|
||||
begin
|
||||
demoCal.Height := seHeight.Value;
|
||||
end;
|
||||
|
||||
procedure TForm1.seButtonWidthChange(Sender: TObject);
|
||||
begin
|
||||
demoCal.ButtonWidth := seButtonWidth.Value;
|
||||
end;
|
||||
|
||||
procedure TForm1.seWidthChange(Sender: TObject);
|
||||
begin
|
||||
demoCal.Width := seWidth.Value;
|
||||
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);
|
||||
var
|
||||
calendar: TCalendarLite;
|
||||
|
||||
@ -41,8 +41,12 @@ unit CalendarLite;
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Types,
|
||||
ExtCtrls, Menus;
|
||||
Classes, SysUtils, LResources, LCLVersion,
|
||||
Forms, Controls, Graphics, Dialogs, Types, ExtCtrls, Menus;
|
||||
|
||||
{$if lcl_fullversion >= 1080000}
|
||||
{$define lcl_scaling}
|
||||
{$ifend}
|
||||
|
||||
const
|
||||
LastCol = 7;
|
||||
@ -220,6 +224,8 @@ type
|
||||
FLanguage: TLanguage;
|
||||
FDblClickTimer: TTimer;
|
||||
FFormatSettings: TFormatSettings;
|
||||
FButtonHeight: Integer;
|
||||
FButtonWidth: Integer;
|
||||
function GetDayNames: String;
|
||||
function GetDisplayText(aTextIndex: TDisplayText): String;
|
||||
function GetDisplayTexts: String;
|
||||
@ -229,6 +235,8 @@ type
|
||||
procedure PopulateHolidayPopupMenu;
|
||||
procedure PopulateMonthPopupMenu;
|
||||
procedure PopulateYearPopupMenu;
|
||||
procedure SetButtonHeight(const AValue: Integer);
|
||||
procedure SetButtonWidth(const AValue: Integer);
|
||||
procedure SetCustomDayNames(const AValue: String);
|
||||
procedure SetCustomDisplayTexts(const AValue: String);
|
||||
procedure SetCustomMonthNames(const AValue: String);
|
||||
@ -248,6 +256,10 @@ type
|
||||
protected
|
||||
procedure ChangeDateTo(ADate: TDate; ASelMode: TCalSelMode);
|
||||
procedure DateChange; virtual;
|
||||
{$ifdef lcl_scaling}
|
||||
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
||||
const AXProportion, AYProportion: Double); override;
|
||||
{$endif}
|
||||
procedure DblClick; override;
|
||||
class function GetControlClassDefaultSize: TSize; override;
|
||||
procedure InternalClick;
|
||||
@ -328,6 +340,8 @@ type
|
||||
property OnMouseWheelUp;
|
||||
|
||||
// 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 Date: TDateTime read FDate write SetDate;
|
||||
property DayNames: String read FCustomDayNames write SetCustomDayNames;
|
||||
@ -661,7 +675,7 @@ var
|
||||
ch: Integer = 0;
|
||||
sp: Integer = 0;
|
||||
cw: Integer = 0;
|
||||
bit: integer=0;
|
||||
bit: integer = 0;
|
||||
i, cellWidths, totalSpace, cellHeights,
|
||||
adjSpace, borderh, borderv, numRows: integer;
|
||||
sz: TSize;
|
||||
@ -731,7 +745,7 @@ procedure TCalDrawer.DrawArrow(ARect: TRect; AHead: TArrowhead;
|
||||
ADirec: TArrowDirection);
|
||||
var
|
||||
sz: TSize;
|
||||
d, ox, oy, half: integer;
|
||||
dx, dy, ox, oy, halfx, halfy: integer;
|
||||
pts: TArrowPoints;
|
||||
begin
|
||||
FCanvas.Pen.Style := psSolid;
|
||||
@ -740,25 +754,33 @@ begin
|
||||
if (FCanvas.Pen.Color <> FOwner.Colors.ArrowBorderColor) then
|
||||
FCanvas.Pen.Color := FOwner.Colors.ArrowBorderColor;
|
||||
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;
|
||||
if FOwner.ButtonWidth = 0 then
|
||||
dx := Min(sz.cy, sz.cx) div 3
|
||||
else
|
||||
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
|
||||
ahSingle:
|
||||
begin
|
||||
case ADirec of
|
||||
adLeft:
|
||||
begin
|
||||
pts[1]:= Point(ox+d, oy);
|
||||
pts[2]:= Point(ox, oy+half);
|
||||
pts[3]:= Point(ox+d, oy+d);
|
||||
pts[1]:= Point(ox+dx, oy);
|
||||
pts[2]:= Point(ox, oy+halfy);
|
||||
pts[3]:= Point(ox+dx, oy+dy);
|
||||
end;
|
||||
adRight:
|
||||
begin
|
||||
pts[1]:= Point(ox, oy);
|
||||
pts[2]:= Point(ox, oy+d);
|
||||
pts[3]:= Point(ox+d, oy+half);
|
||||
pts[2]:= Point(ox, oy+dy);
|
||||
pts[3]:= Point(ox+dx, oy+halfy);
|
||||
end;
|
||||
end;
|
||||
FCanvas.Polygon(pts);
|
||||
@ -767,24 +789,24 @@ begin
|
||||
case ADirec of
|
||||
adLeft:
|
||||
begin
|
||||
pts[1]:= Point(ox+half-1, oy);
|
||||
pts[2]:= Point(ox-1, oy+half);
|
||||
pts[3]:= Point(ox+half-1, oy+d);
|
||||
pts[1]:= Point(ox+halfx-1, oy);
|
||||
pts[2]:= Point(ox-1, oy+halfy);
|
||||
pts[3]:= Point(ox+halfx-1, oy+dy);
|
||||
FCanvas.Polygon(pts);
|
||||
pts[1]:= Point(ox+d, oy);
|
||||
pts[2]:= Point(ox+half, oy+half);
|
||||
pts[3]:= Point(ox+d, oy+d);
|
||||
pts[1]:= Point(ox+dx, oy);
|
||||
pts[2]:= Point(ox+halfx, oy+halfy);
|
||||
pts[3]:= Point(ox+dx, oy+dy);
|
||||
FCanvas.Polygon(pts);
|
||||
end;
|
||||
adRight:
|
||||
begin
|
||||
pts[1]:= Point(ox, oy);
|
||||
pts[2]:= Point(ox+half, oy+half);
|
||||
pts[3]:= Point(ox, oy+d);
|
||||
pts[2]:= Point(ox+halfx, oy+halfy);
|
||||
pts[3]:= Point(ox, oy+dy);
|
||||
FCanvas.Polygon(pts);
|
||||
pts[1]:= Point(ox+half+1, oy);
|
||||
pts[2]:= Point(ox+d+1, oy+half);
|
||||
pts[3]:= Point(ox+half+1, oy+d);
|
||||
pts[1]:= Point(ox+halfx+1, oy);
|
||||
pts[2]:= Point(ox+dx+1, oy+halfy);
|
||||
pts[3]:= Point(ox+halfx+1, oy+dy);
|
||||
FCanvas.Polygon(pts);
|
||||
end;
|
||||
end;
|
||||
@ -1362,8 +1384,13 @@ begin
|
||||
FStartingDayOfWeek:= dowSunday;
|
||||
with GetControlClassDefaultSize do
|
||||
SetInitialBounds(0, 0, cx, cy);
|
||||
{$ifdef lcl_scaling}
|
||||
Constraints.MinHeight := DefMinHeight;
|
||||
Constraints.MinWidth := DefMinWidth;
|
||||
{$else}
|
||||
Constraints.MinHeight := ScaleX(DefMinHeight, DESIGNTIME_PPI);
|
||||
Constraints.MinWidth := ScaleY(DefMinWidth, DESIGNTIME_PPI);
|
||||
{$endif}
|
||||
Canvas.Brush.Style := bsSolid;
|
||||
TabStop := true;
|
||||
SetDefaultDayNames;
|
||||
@ -1506,10 +1533,28 @@ begin
|
||||
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;
|
||||
begin
|
||||
{$ifdef lcl_scaling}
|
||||
Result.cx := DefCalWidth;
|
||||
Result.cy := DefCalHeight;
|
||||
{$else}
|
||||
Result.cx := ScaleX(DefCalWidth, DESIGNTIME_PPI);
|
||||
Result.cy := ScaleY(DefCalHeight, DESIGNTIME_PPI);
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
function TCalendarLite.GetDayName(ADayOfWeek: TDayOfWeek): String;
|
||||
@ -1830,26 +1875,18 @@ begin
|
||||
Result := FSelDates.AsArray;
|
||||
end;
|
||||
|
||||
function TCalendarLite.SelMode(Shift: TShiftState): TCalSelMode;
|
||||
procedure TCalendarLite.SetButtonHeight(const AValue: Integer);
|
||||
begin
|
||||
Result := smFirstSingle;
|
||||
if not FMultiSelect then
|
||||
exit;
|
||||
if FButtonHeight = AValue then exit;
|
||||
FButtonHeight := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
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;
|
||||
procedure TCalendarLite.SetButtonWidth(const AValue: Integer);
|
||||
begin
|
||||
if FButtonWidth = AValue then exit;
|
||||
FButtonWidth := AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCalendarLite.SetCustomDayNames(const AValue: String);
|
||||
@ -2019,6 +2056,28 @@ begin
|
||||
Invalidate;
|
||||
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);
|
||||
begin
|
||||
if AValue = FMultiSelect then
|
||||
|
||||
Reference in New Issue
Block a user