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

NiceChart: Add high-dpi support.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8858 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-06-26 18:06:47 +00:00
parent c67979a1f9
commit 1ee5951023
2 changed files with 83 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
components/nicechart/packages/Lazarus/nicechartlaz.lpk
View File

@ -10,27 +10,28 @@
<PathDelim Value="\"/>
<SearchPaths>
<OtherUnitFiles Value="..\..\source"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Description Value="Light-weight chart component with basic functionality (bar series, line series, smooth spline series)"/>
<License Value="MPL"/>
<Version Major="2"/>
<Files>
<Item>
<Files Count="2">
<Item1>
<Filename Value="..\..\source\BSplines.pas"/>
<UnitName Value="BSplines"/>
</Item>
<Item>
</Item1>
<Item2>
<Filename Value="..\..\source\NiceChart.pas"/>
<HasRegisterProc Value="True"/>
<UnitName Value="NiceChart"/>
</Item>
</Item2>
</Files>
<RequiredPkgs>
<Item>
<CompatibilityMode Value="True"/>
<RequiredPkgs Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item>
</Item1>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)"/>

97
components/nicechart/source/NiceChart.pas
View File

@ -125,6 +125,11 @@ type
FGridColor: TColor;
FSoftColors: Boolean;
FTickLength: Integer;
FOuterMargin: Integer;
FInnerMargin: Integer;
FSmallMargin: Integer;
FAxisDefSize: Integer;
FLegendItemSize: Integer;
procedure InternalClear;
procedure InternalPaint(ACanvas: TCanvas);
procedure Calculate(AWidth, AHeight: Integer);
@ -180,6 +185,9 @@ type
procedure Changed;
procedure ChartToClient(const AX, AY: Double; var X, Y: Integer);
procedure CreateHandle; override;
{$IFDEF FPC}
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override;
{$ENDIF}
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -191,7 +199,11 @@ type
procedure Clear;
property Series[Index: Integer]: TNiceSeries read GetSeries;
property SeriesCount: Integer read GetSeriesCount;
{$IFNDEF FPC} // Lazarus does not have TMetaFile...
{$IFDEF FPC}
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); override;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); override;
{$ELSE}
// Lazarus does not have TMetaFile...
function CreateMetafile: TMetafile;
procedure CopyToClipboard;
{$ENDIF}
@ -481,6 +493,11 @@ begin
FAxisXScale := 1;
FAxisYScale := 1;
FTickLength := 2;
FOuterMargin := OUTER_MARGIN;
FInnerMargin := INNER_MARGIN;
FSmallMargin := SMALL_MARGIN;
FAxisDefSize := AXIS_DEFSIZE;
FLegendItemSize := LEGEND_ITEM;
XAxis := TList.Create;
YAxis := TList.Create;
FUpdating := False;
@ -795,7 +812,7 @@ begin
Pen.Style := psSolid;
Font.Assign(FNormalFont);
g := TextHeight('Ag');
th := (LEGEND_ITEM - g) div 2;
th := (FLegendItemSize - g) div 2;
Brush.Style := bsSolid;
Brush.Color := clBlack;
FillRect(Rect(RcLegend.Right, RcLegend.Top + 3, RcLegend.Right + 3, RcLegend.Bottom + 3));
@ -803,7 +820,7 @@ begin
Brush.Style := bsClear;
Rectangle(RcLegend);
Brush.Style := bsClear;
l := RcLegend.Left + INNER_MARGIN + LEGEND_ITEM + SMALL_MARGIN;
l := RcLegend.Left + FInnerMargin + FLegendItemSize + FSmallMargin;
for x := 0 to List.Count-1 do
begin
Temp.Text := Trim(TNiceSeries(List[x]).FCaption);
@ -896,7 +913,7 @@ begin
RcChart := Rect(0, 0, DestWidth, DestHeight);
MarkSize := Max(1, Round(DestWidth * 0.006));
InflateRect(RcChart, -OUTER_MARGIN, -OUTER_MARGIN);
InflateRect(RcChart, -FOuterMargin, -FOuterMargin);
Titled := False;
if FShowTitle and (FTitle <> '') then
@ -906,20 +923,20 @@ begin
RcTitle := Rect(RcChart.Left, RcChart.Top, RcChart.Right, RcChart.Left + w);
DrawText(Canvas.Handle, PChar(FTitle), Length(FTitle), RcTitle,
DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_CALCRECT);
RcChart.Top := RcTitle.Bottom + INNER_MARGIN;
RcChart.Top := RcTitle.Bottom + FInnerMargin;
Titled := True;
end else
SetRectEmpty(RcTitle);
Canvas.Font.Assign(FNormalFont);
h := Canvas.TextHeight('Ag');
RcChart.Bottom := RcChart.Bottom - (2 * h) - INNER_MARGIN - FTickLength - SMALL_MARGIN;
RcChart.Bottom := RcChart.Bottom - (2 * h) - FInnerMargin - FTickLength - FSmallmargin;
BuildYAxis;
w := 0;
for x := 0 to YAxis.Count-1
do w := Max(w, Canvas.TextWidth(PAxisInfo(YAxis[x])^.Caption));
RcChart.Left := RcChart.Left + h + INNER_MARGIN + w + FTickLength + SMALL_MARGIN;
RcChart.Left := RcChart.Left + h + FInnerMargin + w + FTickLength + FSmallMargin;
RcTitle.Left := RcChart.Left;
RcTitle.Right := RcChart.Right;
AdjustYAxis;
@ -928,7 +945,7 @@ begin
begin
Canvas.Font.Assign(FNormalFont);
w := 0;
h := INNER_MARGIN;
h := FInnerMargin;
g := Canvas.TextHeight('Ag');
for x := 0 to List.Count-1 do
begin
@ -936,14 +953,14 @@ begin
Temp.Text := Trim(TNiceSeries(List[x]).FCaption);
for y := 0 to Temp.Count-1
do w := Max(w, Canvas.TextWidth(Trim(Temp[y])));
h := h + Max(LEGEND_ITEM, Temp.Count * g);
h := h + Max(FLegendItemSize, Temp.Count * g);
if (x <> List.Count-1)
then h := h + SMALL_MARGIN;
then h := h + FSmallMargin;
end;
w := w + (2 * INNER_MARGIN) + LEGEND_ITEM + SMALL_MARGIN;
h := h + INNER_MARGIN;
w := w + (2 * FInnerMargin) + FLegendItemSize + FSmallMargin;
h := h + FInnerMargin;
RcLegend := Rect(RcChart.Right - w, RcChart.Top, RcChart.Right, RcChart.Top + h);
RcChart.Right := RcLegend.Left - (2 * INNER_MARGIN);
RcChart.Right := RcLegend.Left - (2 * FInnerMargin);
if Titled
then RcTitle.Right := RcChart.Right;
end else
@ -1091,7 +1108,7 @@ begin
end else
begin
w := RcChart.Right - RcChart.Left;
Cnt := (w div AXIS_DEFSIZE) + 1;
Cnt := (w div FAxisDefSize) + 1;
mi := MaxDouble;
ma := -MaxDouble;
for x := 0 to List.Count-1 do
@ -1129,7 +1146,7 @@ begin
if (List.Count = 0)
then Exit;
w := RcChart.Bottom - RcChart.Top;
Cnt := (w div AXIS_DEFSIZE) + 1;
Cnt := (w div FAxisDefSize) + 1;
ChartEmpty := True;
mi := MaxDouble;
ma := -MaxDouble;
@ -1233,7 +1250,7 @@ begin
Font.Assign(FNormalFont);
Font.Style := [fsBold];
w := RcChart.Right - RcChart.Left;
t := RcChart.Bottom + INNER_MARGIN + FTickLength + SMALL_MARGIN + TextHeight('Ag');
t := RcChart.Bottom + FInnerMargin + FTickLength + FSmallMargin + TextHeight('Ag');
l := RcChart.Left + ((w - TextWidth(FAxisXTitle)) div 2);
TextOut(l, t, FAxisXTitle);
Font.Assign(FNormalFont);
@ -1309,7 +1326,7 @@ begin
LineTo(RcChart.Left, RcChart.Bottom);
h := RcChart.Bottom - RcChart.Top;
l := OUTER_MARGIN;
l := FOuterMargin;
Font.Assign(FNormalFont);
Font.Style := [fsBold];
t := RcChart.Bottom - ((h - TextWidth(FAxisYTitle)) div 2);
@ -1487,21 +1504,21 @@ begin
end;
if FShowLegend then
begin
l := RcLegend.Left + INNER_MARGIN;
l := RcLegend.Left + FInnerMargin;
t := RcLegend.Top + Sr.Top;
if (sr.FKind = skBar) then
begin
Rc := Rect(l, t, l + LEGEND_ITEM, t + LEGEND_ITEM);
Rc := Rect(l, t, l + FLegendItemSize, t + FLegendItemSize);
InflateRect(Rc, -2, -2);
Rectangle(Rc);
end else
begin
Pen.Width := sr.LineWidth;
t2 := t + (LEGEND_ITEM div 2);
t2 := t + (FLegendItemSize div 2);
MoveTo(l, t2);
LineTo(l + LEGEND_ITEM, t2);
LineTo(l + FLegendItemSize, t2);
Pen.Width := 1;
Marker(ACanvas, l + (LEGEND_ITEM div 2), t2, MarkSize);
Marker(ACanvas, l + (FLegendItemSize div 2), t2, MarkSize);
end;
end;
end;
@ -1635,8 +1652,8 @@ begin
AWidth := InitWidth;
AHeight := InitHeight;
Calculate(AWidth, AHeight);
if (RcLegend.Bottom > (AHeight - OUTER_MARGIN))
then AHeight := RcLegend.Bottom + OUTER_MARGIN;
if (RcLegend.Bottom > (AHeight - FOuterMargin))
then AHeight := RcLegend.Bottom + FOuterMargin;
if ((RcChart.Right - RcChart.Left) < (RcChart.Bottom - RcChart.Top))
then AWidth := AWidth + ((RcChart.Bottom - RcChart.Top) - (RCChart.Right - RcChart.Left));
if (AWidth <> InitWidth) or (AHeight <> InitHeight)
@ -1660,5 +1677,37 @@ begin
end;
{$ENDIF}
{$IFDEF FPC}
// Handle Lazarus' High-DPI scaling
procedure TNiceChart.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double);
begin
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
FOuterMargin := Round(FOuterMargin * AXProportion);
FInnerMargin := Round(FInnerMargin * AXProportion);
FSmallMargin := Round(FSmallMargin * AXProportion);
FAxisDefSize := Round(FAxisDefSize * AXProportion);
FLegendItemSize := Round(FLegendItemSize * AXProportion);
end;
end;
procedure TNiceChart.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
inherited;
DoFixDesignFontPPI(FTitleFont, ADesignTimePPI);
DoFixDesignFontPPI(FNormalFont, ADesignTimePPI);
end;
procedure TNiceChart.ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double);
begin
inherited;
DoScaleFontPPI(FTitleFont, AToPPI, AProportion);
DoScaleFontPPI(FNormalFont, AToPPI, AProportion);
end;
{$ENDIF}
end.