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

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

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