diff --git a/components/callite/demo2/umaintestcallite.lfm b/components/callite/demo2/umaintestcallite.lfm index 69606c88c..2791fdd82 100644 --- a/components/callite/demo2/umaintestcallite.lfm +++ b/components/callite/demo2/umaintestcallite.lfm @@ -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 diff --git a/components/callite/demo2/umaintestcallite.pp b/components/callite/demo2/umaintestcallite.pp index ee7f6cd6a..6a1a4ca52 100644 --- a/components/callite/demo2/umaintestcallite.pp +++ b/components/callite/demo2/umaintestcallite.pp @@ -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; diff --git a/components/callite/source/calendarlite.pas b/components/callite/source/calendarlite.pas index 49d317231..5154fd608 100644 --- a/components/callite/source/calendarlite.pas +++ b/components/callite/source/calendarlite.pas @@ -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