tvplanit: TVpGanttView supports LCL scaling. Fix font scaling in TVpDayView, TVpWeekView, TVpMonthView, TVpContactGrid and TVpTaskList.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8437 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-09-02 09:39:21 +00:00
parent 6d561ddb92
commit f60702ccb7
11 changed files with 123 additions and 21 deletions

View File

@ -43,7 +43,7 @@ uses
Windows, Messages,
{$ENDIF}
SysUtils, Buttons, Classes, Controls, Forms, Graphics, Menus,
VpConst, VpBase, VpSR, VpMisc, VpBaseDS, VpCanvasUtils, VpException;
VpConst, VpBase, VpSR, VpMisc, VpBaseDS, VpException;
type
TVpCalDisplayOption = (cdoShortNames, cdoShowYear, cdoShowInactive,

View File

@ -295,7 +295,7 @@ const
{$ENDIF}
DROPDOWN_COUNT = 24;
LineEnding2 = LineEnding + LineEnding;

View File

@ -39,7 +39,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ExtCtrls, StdCtrls, Forms, Menus,
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR;
const
MaxColumns = 100; { An arbitrary number representing the maximum number of }
@ -260,6 +260,7 @@ type
function SelectContactByName(const Name: String): Boolean;
{$IF VP_LCL_SCALING = 2}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
{$ELSEIF VP_LCL_SCALING = 1}
procedure ScaleFontsPPI(const AProportion: Double); override;
@ -1933,6 +1934,12 @@ begin
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpContactGrid.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(ContactHeadAttributes.Font, ADesignTimePPI);
end;
procedure TVpContactGrid.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin

View File

@ -72,7 +72,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ExtCtrls, StdCtrls, Buttons, Forms, Menus, ImgList,
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR;
type
TVpLineRec = packed record
@ -472,6 +472,7 @@ type
StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override;
{$IF VP_LCL_SCALING = 2}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
{$ELSE}
{$IF VP_LCL_SCALING = 1}
@ -2749,6 +2750,15 @@ begin
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpDayView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(AllDayEventAttributes.Font, ADesignTimePPI);
DoFixDesignFontPPI(HeadAttributes.Font, ADesignTimePPI);
DoFixDesignFontPPI(RowHeadAttributes.HourFont, ADesignTimePPI);
DoFixDesignFontPPI(RowHeadAttributes.MinuteFont, ADesignTimePPI);
end;
procedure TVpDayView.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin

View File

@ -328,14 +328,14 @@ object DlgEventEdit: TDlgEventEdit
AnchorSideTop.Control = StartDate
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = StartDate
Left = 78
Left = 105
Height = 15
Top = 105
Width = 54
Width = 27
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Start time:'
Caption = 'Start:'
Color = clDefault
ParentColor = False
end
@ -344,14 +344,14 @@ object DlgEventEdit: TDlgEventEdit
AnchorSideTop.Control = EndDate
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = EndDate
Left = 82
Left = 109
Height = 15
Top = 136
Width = 50
Width = 23
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'End time:'
Caption = 'End:'
Color = clDefault
ParentColor = False
end

View File

@ -9,8 +9,8 @@
{"hash":160085834,"name":"tdlgeventedit.locationlbl.caption","sourcebytes":[76,111,99,97,116,105,111,110,58],"value":"Location:"},
{"hash":180232266,"name":"tdlgeventedit.categorylbl.caption","sourcebytes":[67,97,116,101,103,111,114,121,58],"value":"Category:"},
{"hash":56787604,"name":"tdlgeventedit.cballday.caption","sourcebytes":[65,108,108,32,68,97,121,32,69,118,101,110,116],"value":"All Day Event"},
{"hash":102787866,"name":"tdlgeventedit.starttimelbl.caption","sourcebytes":[83,116,97,114,116,32,116,105,109,101,58],"value":"Start time:"},
{"hash":108711882,"name":"tdlgeventedit.endtimelbl.caption","sourcebytes":[69,110,100,32,116,105,109,101,58],"value":"End time:"},
{"hash":95062394,"name":"tdlgeventedit.starttimelbl.caption","sourcebytes":[83,116,97,114,116,58],"value":"Start:"},
{"hash":312442,"name":"tdlgeventedit.endtimelbl.caption","sourcebytes":[69,110,100,58],"value":"End:"},
{"hash":54683424,"name":"tdlgeventedit.startdate.text","sourcebytes":[48,49,46,48,49,46,50,48,48,48],"value":"01.01.2000"},
{"hash":264355450,"name":"tdlgeventedit.recurringlbl.caption","sourcebytes":[65,112,112,111,105,110,116,109,101,110,116,32,82,101,99,117,114,114,101,110,99,101,58],"value":"Appointment Recurrence:"},
{"hash":36863562,"name":"tdlgeventedit.intervallbl.caption","sourcebytes":[73,110,116,101,114,118,97,108,32,40,100,97,121,115,41,58],"value":"Interval (days):"},

View File

@ -214,6 +214,12 @@ type
procedure WMHScroll(var Msg: TLMHScroll); message LM_HSCROLL;
procedure WMVScroll(var Msg: TLMVScroll); message LM_VSCROLL;
{ LCL scaling }
{$IF VP_LCL_SCALING <> 0}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
{$IFEND}
{ Hints }
procedure ShowHintWindow(APoint: TPoint; AEvent: TVpEvent);
procedure HideHintWindow;
@ -244,6 +250,15 @@ type
StartLine, StopLine: Integer; UseGran: TVpGranularity;
DisplayOnly: Boolean); override;
{$IF VP_LCL_SCALING = 2}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
{$ELSE}
{$IF VP_LCL_SCALING = 1}
procedure ScaleFontsPPI(const AProportion: Double); override;
{$ENDIF}
{$ENDIF}
// Methods to be called by painter
function CalcVisibleCols(AWidth: Integer): Integer;
function CalcVisibleRows(AHeight: Integer): Integer;
@ -476,7 +491,6 @@ const
DATE_FORMAT = 'ddddd';
var
timeFmt: String;
timeStr: String;
startDateStr, endDateStr: string;
s: String;
begin
@ -548,7 +562,8 @@ end;
function TVpGanttView.CalcVisibleCols(AWidth: Integer): Integer;
var
d, m: Integer; // "d" = result of div, "m" = result of mod
d: Integer = 0; // Result of div
m: Integer = 0; // Result of mod
begin
DivMod(AWidth - FixedColWidth, ColWidth, d, m);
if m <> 0 then
@ -559,7 +574,8 @@ end;
function TVpGanttView.CalcVisibleRows(AHeight: Integer): Integer;
var
d, m: Integer; // "d" = result of div, "m" = result of mod
d: Integer = 0; // Result of div
m: Integer = 0; // Result of mod
begin
DivMod(AHeight - TotalColHeaderHeight, FRowHeight, d, m);
if m <> 0 then
@ -677,6 +693,17 @@ begin
end;
end;
procedure TVpGanttView.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited;
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
ColWidth := round(ColWidth * AXProportion);
FixedColWidth := round(FixedColWidth * AXProportion);
end;
end;
function TVpGanttView.DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean;
begin
Result := inherited DoMouseWheelDown(Shift, MousePos);
@ -1276,6 +1303,33 @@ begin
end;
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpGanttView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(ColHeaderAttributes.MonthFont, ADesignTimePPI);
DoFixDesignFontPPI(ColHeaderAttributes.DayFont, ADesignTimePPI);
DoFixDesignFontPPI(RowHeaderAttributes.EventFont, ADesignTimePPI);
end;
procedure TVpGanttView.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin
inherited;
DoScaleFontPPI(ColHeaderAttributes.MonthFont, AToPPI, AProportion);
DoScaleFontPPI(ColHeaderAttributes.DayFont, AToPPI, AProportion);
DoScaleFontPPI(RowHeaderAttributes.EventFont, AToPPI, AProportion);
end;
{$ELSEIF VP_LCL_SCALING = 1}
procedure TVpGantView.ScaleFontsPPI(const AProportion: Double);
begin
inherited;
DoScaleFontPPI(ColHeaderAttributes.MonthFont, AProportion);
DoScaleFontPPI(ColHeaderAttributes.DayFont, AProportion);
DoScaleFontPPI(RowHeadAttributes.EventFont, AProportion);
end;
{$ENDIF}
procedure TVpGanttView.ScrollDateIntoView(ADate: TDateTime);
begin
if (FStartDate = 0) or (FStartDate = NO_DATE) then
@ -1323,7 +1377,8 @@ end;
procedure TVpGanttView.SetActiveCol(AValue: Integer);
var
R, eventRect, dayRect: TRect;
R: TRect = (Left:0; Top:0; Right:0; Bottom:0);
eventRect, dayRect: TRect;
dt: TDateTime;
event: TVpEvent;
begin
@ -1383,7 +1438,8 @@ end;
procedure TVpGanttView.SetActiveRow(AValue: Integer);
var
R, eventRect, dayRect: TRect;
R: TRect = (Left:0; Top:0; Right:0; Bottom:0);
eventRect, dayRect: TRect;
event: TVpEvent;
dt: TDateTime;
begin

View File

@ -40,7 +40,7 @@ uses
Windows, Consts, Messages,
{$ENDIF}
SysUtils, Buttons, Classes, Controls, StdCtrls, ExtCtrls, Forms, Graphics, Menus,
VpBase, VpData, VpConst, VpCanvasUtils;
VpBase, VpData, VpConst;
type
TDayList = array[1..12] of Word;

View File

@ -43,7 +43,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ComCtrls, ExtCtrls, Buttons, Forms, Menus,
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR;
type
TVpMonthdayRec = packed record
@ -305,6 +305,7 @@ type
DisplayOnly: Boolean); override;
{$IF VP_LCL_SCALING = 2}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
{$ELSEIF VP_LCL_SCALING = 1}
procedure ScaleFontsPPI(const AProportion: Double); override;
@ -1582,6 +1583,17 @@ begin
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpMonthView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(DayHeadAttributes.Font, ADesignTimePPI);
DoFixDesignFontPPI(EventFont, ADesignTimePPI);
DoFixDesignFontPPI(HeadAttributes.Font, ADesignTimePPI);
DoFixDesignFontPPI(HolidayAttributes.Font, ADesignTimePPI);
DoFixDesignFontPPI(TodayAttributes.Font, ADesignTimePPI);
DoFixDesignFontPPI(WeekendAttributes.Font, ADesignTimePPI);
end;
procedure TVpMonthView.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin

View File

@ -39,7 +39,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ExtCtrls, StdCtrls, Menus,
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils;
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR;
type
TVpTaskRec = packed record
@ -233,6 +233,7 @@ type
StartLine, StopLine: Integer; UseGran: TVpGranularity; DisplayOnly: Boolean); override;
{$IF VP_LCL_SCALING = 2}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
{$ELSEIF VP_LCL_SCALING = 1}
procedure ScaleFontsPPI(const AProportion: Double); override;
@ -1350,6 +1351,12 @@ begin
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpTaskList.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(TaskHeadAttributes.Font, ADesignTimePPI);
end;
procedure TVpTaskList.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin

View File

@ -60,7 +60,7 @@ uses
Windows, Messages,
{$ENDIF}
Classes, Graphics, Controls, ComCtrls, ExtCtrls, StdCtrls, Buttons, Forms, Menus,
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpCanvasUtils, VpDayView;
VpConst, VpBase, VpBaseDS, VpMisc, VpData, VpSR, VpDayView;
type
TVpWeekdayRec = packed record
@ -301,6 +301,7 @@ type
DisplayOnly: Boolean); override;
{$IF VP_LCL_SCALING = 2}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
{$ELSEIF VP_LCL_SCALING = 1}
procedure ScaleFontsPPI(const AProportion: Double); override;
@ -1928,6 +1929,15 @@ begin
end;
{$IF VP_LCL_SCALING = 2}
procedure TVpWeekView.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(AllDayEventAttributes.Font, ADesignTimePPI);
DoFixDesignFontPPI(DayHeadAttributes.Font, ADesignTimePPI);
DoFixDesignFontPPI(EventFont, ADesignTimePPI);
DoFixDesignFontPPI(HeadAttributes.Font, ADesignTimePPI);
end;
procedure TVpWeekView.ScaleFontsPPI(const AToPPI: Integer;
const AProportion: Double);
begin