paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-14 06:59:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

Grid: fix High-DPI font scaling

Browse Source 
git-svn-id: trunk@62506 -
This commit is contained in:
ondrej 2020-01-07 13:26:46 +00:00
parent fbf5621974
commit f97bf899bb
1 changed files with 70 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
lcl/grids.pas
View File

@ -486,6 +486,8 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
procedure FillTitleDefaultFont; procedure FillTitleDefaultFont;
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual;
function IsDefault: boolean; function IsDefault: boolean;
property Column: TGridColumn read FColumn; property Column: TGridColumn read FColumn;
published published
@ -589,6 +591,8 @@ type
destructor Destroy; override; destructor Destroy; override;
procedure Assign(Source: TPersistent); override; procedure Assign(Source: TPersistent); override;
procedure FillDefaultFont; procedure FillDefaultFont;
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual;
function IsDefault: boolean; virtual; function IsDefault: boolean; virtual;
property Grid: TCustomGrid read GetGrid; property Grid: TCustomGrid read GetGrid;
property DefaultWidth: Integer read GetDefaultWidth; property DefaultWidth: Integer read GetDefaultWidth;
@ -1141,6 +1145,8 @@ type
procedure RowHeightsChanged; virtual; procedure RowHeightsChanged; virtual;
procedure SaveContent(cfg: TXMLConfig); virtual; procedure SaveContent(cfg: TXMLConfig); virtual;
procedure SaveGridOptions(cfg: TXMLConfig); virtual; procedure SaveGridOptions(cfg: TXMLConfig); virtual;
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
procedure ScrollBarRange(Which:Integer; aRange,aPage,aPos: Integer); procedure ScrollBarRange(Which:Integer; aRange,aPage,aPos: Integer);
procedure ScrollBarPosition(Which, Value: integer); procedure ScrollBarPosition(Which, Value: integer);
function ScrollBarIsVisible(Which:Integer): Boolean; function ScrollBarIsVisible(Which:Integer): Boolean;
@ -8488,6 +8494,20 @@ begin
result := FixedCols; result := FixedCols;
end; end;
procedure TCustomGrid.FixDesignFontsPPI(const ADesignTimePPI: Integer);
var
LTitleFontIsDefault: Boolean;
I: Integer;
begin
inherited FixDesignFontsPPI(ADesignTimePPI);
LTitleFontIsDefault := FTitleFontIsDefault;
DoFixDesignFontPPI(TitleFont, ADesignTimePPI);
FTitleFontIsDefault := LTitleFontIsDefault;
for I := 0 to FColumns.Count-1 do
FColumns[I].FixDesignFontsPPI(ADesignTimePPI);
end;
function TCustomGrid.FixedGrid: boolean; function TCustomGrid.FixedGrid: boolean;
begin begin
result := (FixedCols=ColCount) or (FixedRows=RowCount) result := (FixedCols=ColCount) or (FixedRows=RowCount)
@ -9901,6 +9921,18 @@ begin
end; end;
end; end;
procedure TCustomGrid.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
var
LTitleFontIsDefault: Boolean;
I: Integer;
begin
inherited ScaleFontsPPI(AToPPI, AProportion);
LTitleFontIsDefault := FTitleFontIsDefault;
DoScaleFontPPI(TitleFont, AToPPI, AProportion);
FTitleFontIsDefault := LTitleFontIsDefault;
for I := 0 to FColumns.Count-1 do
FColumns[I].ScaleFontsPPI(AToPPI, AProportion);
end;
type type
TWinCtrlAccess=class(TWinControl); TWinCtrlAccess=class(TWinControl);
@ -12105,6 +12137,15 @@ begin
FIsDefaultTitleFont := True; FIsDefaultTitleFont := True;
end; end;
procedure TGridColumnTitle.FixDesignFontsPPI(const ADesignTimePPI: Integer);
var
LIsDefaultTitleFont: Boolean;
begin
LIsDefaultTitleFont := FIsDefaultTitleFont;
FColumn.Grid.DoFixDesignFontPPI(Font, ADesignTimePPI);
FIsDefaultTitleFont := LIsDefaultTitleFont;
end;
function TGridColumnTitle.GetFont: TFont; function TGridColumnTitle.GetFont: TFont;
begin begin
Result := FFont; Result := FFont;
@ -12143,6 +12184,15 @@ begin
result := FLayout <> nil; result := FLayout <> nil;
end; end;
procedure TGridColumnTitle.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
var
LIsDefaultTitleFont: Boolean;
begin
LIsDefaultTitleFont := FIsDefaultTitleFont;
FColumn.Grid.DoScaleFontPPI(Font, AToPPI, AProportion);
FIsDefaultTitleFont := LIsDefaultTitleFont;
end;
procedure TGridColumnTitle.SetAlignment(const AValue: TAlignment); procedure TGridColumnTitle.SetAlignment(const AValue: TAlignment);
begin begin
if Falignment = nil then begin if Falignment = nil then begin
@ -12503,6 +12553,16 @@ begin
result := FWidth <> nil; result := FWidth <> nil;
end; end;
procedure TGridColumn.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
var
LisDefaultFont: Boolean;
begin
LisDefaultFont := FisDefaultFont;
Grid.DoScaleFontPPI(Font, AToPPI, AProportion);
FisDefaultFont := LisDefaultFont;
Title.ScaleFontsPPI(AToPPI, AProportion);
end;
procedure TGridColumn.SetAlignment(const AValue: TAlignment); procedure TGridColumn.SetAlignment(const AValue: TAlignment);
begin begin
if FAlignment = nil then begin if FAlignment = nil then begin
@ -12869,6 +12929,16 @@ begin
end; end;
end; end;
procedure TGridColumn.FixDesignFontsPPI(const ADesignTimePPI: Integer);
var
LisDefaultFont: Boolean;
begin
LisDefaultFont := FisDefaultFont;
Grid.DoFixDesignFontPPI(Font, ADesignTimePPI);
FisDefaultFont := LisDefaultFont;
Title.FixDesignFontsPPI(ADesignTimePPI);
end;
function TGridColumn.IsDefault: boolean; function TGridColumn.IsDefault: boolean;
begin begin
result := FTitle.IsDefault and (FAlignment=nil) and (FColor=nil) result := FTitle.IsDefault and (FAlignment=nil) and (FColor=nil)