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

NiceChart: Add GridColor, Show[X|Y]AxisLine, TickLength, Series.LineWidth, ShowLegend[X|Y]Grid

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8851 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-06-25 11:58:59 +00:00
parent d4aafe8dfc
commit cd9ce49462
5 changed files with 261 additions and 65 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
components/nicechart/demo/Delphi/Project1.res
View File

Binary file not shown.

43
components/nicechart/demo/common/Unit1.dfm
View File

@ -1,24 +1,30 @@
object Form1: TForm1
Left = 169
Top = 68
Width = 782
Height = 597
Caption = 'NiceChart Demo - priyatna.org'
ClientHeight = 558
ClientWidth = 766
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -12
Font.Name = 'Segoe UI'
Font.Style = []
OldCreateOrder = True
Position = poDesktopCenter
OnCreate = FormCreate
OnDestroy = FormDestroy
DesignSize = (
766
558)
PixelsPerInch = 96
TextHeight = 15
object Label1: TLabel
Left = 376
Top = 15
Left = 16
Top = 535
Width = 34
Height = 15
Anchors = [akLeft, akBottom]
Caption = 'Label1'
end
object Button1: TButton
@ -50,4 +56,33 @@ object Form1: TForm1
TabOrder = 2
OnClick = CheckBox1Click
end
object CheckBox2: TCheckBox
Left = 350
Top = 12
Width = 80
Height = 19
Caption = 'Show x grid'
TabOrder = 3
OnClick = CheckBox2Click
end
object CheckBox3: TCheckBox
Left = 443
Top = 12
Width = 80
Height = 19
Caption = 'Show y grid'
Checked = True
State = cbChecked
TabOrder = 4
OnClick = CheckBox3Click
end
object CheckBox4: TCheckBox
Left = 534
Top = 12
Width = 101
Height = 19
Caption = 'Show x axis line'
TabOrder = 5
OnClick = CheckBox4Click
end
end

33
components/nicechart/demo/common/Unit1.lfm
View File

@ -12,9 +12,9 @@ object Form1: TForm1
Position = poDesktopCenter
LCLVersion = '2.3.0.0'
object Label1: TLabel
Left = 352
Left = 16
Height = 15
Top = 14
Top = 573
Width = 34
Caption = 'Label1'
end
@ -47,4 +47,33 @@ object Form1: TForm1
State = cbChecked
TabOrder = 2
end
object CheckBox2: TCheckBox
Left = 350
Height = 19
Top = 12
Width = 80
Caption = 'Show x grid'
OnClick = CheckBox2Click
TabOrder = 3
end
object CheckBox3: TCheckBox
Left = 443
Height = 19
Top = 12
Width = 80
Caption = 'Show y grid'
Checked = True
OnClick = CheckBox3Click
State = cbChecked
TabOrder = 4
end
object CheckBox4: TCheckBox
Left = 534
Height = 19
Top = 12
Width = 101
Caption = 'Show x axis line'
OnClick = CheckBox4Click
TabOrder = 5
end
end

28
components/nicechart/demo/common/Unit1.pas
View File

@ -17,9 +17,15 @@ type
TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
Label1: TLabel;
Button1: TButton;
Button2: TButton;
procedure CheckBox2Click(Sender: TObject);
procedure CheckBox3Click(Sender: TObject);
procedure CheckBox4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
@ -68,14 +74,14 @@ begin
Left := 8;
Top := 40;
Width := Self.ClientWidth - 16;
Height := Self.ClientHeight - 48;
Height := Self.ClientHeight - 70;
Anchors := [akLeft, akTop, akRight, akBottom];
Title := 'Look at me!'#13'I''m a NiceChart!';
AxisXOnePerValue := True;
ShowXGrid := False;
ShowYGrid := False;
GridColor := clSilver;
TickLength := 6;
AxisYScale := 1000;
//Monochrome := True;
OnMouseMove := ChartMouseMove;
end;
Chart.BeginUpdate;
@ -141,6 +147,7 @@ begin
AddXY(2012, 13001566.43);
AddXY(2013, 13251242.29);
AddXY(2014, 13371215.29);
LineWidth := 3;
end;
Chart.EndUpdate;
@ -155,6 +162,21 @@ begin
Chart.AxisLineWidth := 1;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
Chart.ShowXGrid := Checkbox2.Checked;
end;
procedure TForm1.CheckBox3Click(Sender: TObject);
begin
Chart.ShowYGrid := Checkbox3.Checked;
end;
procedure TForm1.CheckBox4Click(Sender: TObject);
begin
Chart.ShowXAxisLine := Checkbox4.Checked;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Chart.Free;

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

@ -59,12 +59,14 @@ type
FCaption: string;
Spline: TBSpline;
FKind: TSeriesKind;
FLineWidth: Integer;
procedure SetCaption(const Value: string);
function GetMaxXValue: Double;
function GetMinXValue: Double;
function GetMinYValue: Double;
function GetMaxYValue: Double;
procedure SetKind(const Value: TSeriesKind);
procedure SetLineWidth(const Value: Integer);
protected
procedure InternalClear;
public
@ -75,6 +77,7 @@ type
procedure Clear;
property Caption: string read FCaption write SetCaption;
property Kind: TSeriesKind read FKind write SetKind;
property LineWidth: Integer read FLineWidth write SetLineWidth default 1;
end;
TValueTranslator = record
@ -101,6 +104,8 @@ type
YAxis: TList;
FShowLegend: Boolean;
FShowTitle: Boolean;
FShowXAxisLine: Boolean;
FShowYAxisLine: Boolean;
FTitle: string;
FTitleFont: TFont;
FNormalFont: TFont;
@ -117,13 +122,17 @@ type
FAxisYScale: Single;
FAxisXScale: Single;
FMonochrome: Boolean;
FGridColor: TColor;
FSoftColors: Boolean;
FTickLength: Integer;
procedure InternalClear;
procedure InternalPaint(ACanvas: TCanvas);
procedure Calculate(AWidth, AHeight: Integer);
procedure DoPaint;
procedure SetGridColor(const Value: TColor);
procedure SetShowLegend(const Value: Boolean);
procedure SetShowTitle(const Value: Boolean);
procedure SetTickLength(const Value: Integer);
procedure SetTitle(const Value: string);
procedure SetTitleFont(const Value: TFont);
procedure TitleFontChanged(Sender: TObject);
@ -150,6 +159,8 @@ type
procedure SetAxisXOnePerValue(const Value: Boolean);
procedure SetShowXGrid(const Value: Boolean);
procedure SetShowYGrid(const Value: Boolean);
procedure SetShowXAxisLine(const Value: Boolean);
procedure SetShowYAxisLine(const Value: Boolean);
procedure CalculateSeries;
procedure DrawSeries(ACanvas: TCanvas; Index: Integer);
procedure AutoColors(ACanvas: TCanvas; Index: Integer; IsBar: Boolean);
@ -180,16 +191,18 @@ type
procedure Clear;
property Series[Index: Integer]: TNiceSeries read GetSeries;
property SeriesCount: Integer read GetSeriesCount;
{$IFNDEF FPC} // Lazarus has not metafile...
{$IFNDEF FPC} // Lazarus does not have TMetaFile...
function CreateMetafile: TMetafile;
procedure CopyToClipboard;
{$ENDIF}
published
property AxisLineWidth: Integer read FAxisLineWidth write SetAxisLineWidth default 3;
property ShowLegend: Boolean read FShowLegend write SetShowLegend;
property ShowTitle: Boolean read FShowTitle write SetShowTitle;
property ShowXGrid: Boolean read FShowXGrid write SetShowXGrid;
property ShowYGrid: Boolean read FShowYGrid write SetShowYGrid;
property ShowLegend: Boolean read FShowLegend write SetShowLegend default true;
property ShowTitle: Boolean read FShowTitle write SetShowTitle default true;
property ShowXGrid: Boolean read FShowXGrid write SetShowXGrid default true;
property ShowYGrid: Boolean read FShowYGrid write SetShowYGrid default true;
property ShowXAxisLine: boolean read FShowXAxisLine write SetShowXAxisLine default false;
property ShowYAxisLine: Boolean read FShowYAxisLine write SetShowYAxisLine default false;
property Title: string read FTitle write SetTitle stored IsTitleStored;
property TitleFont: TFont read FTitleFont write SetTitleFont;
property AxisXTitle: string read FAxisXTitle write SetAxisXTitle stored IsAxisXTitleStored;
@ -197,8 +210,10 @@ type
property AxisXOnePerValue: Boolean read FAxisXOnePerValue write SetAxisXOnePerValue default false;
property AxisXScale: Single read FAxisXScale write SetAxisXScale stored IsAxisXScaleStored;
property AxisYScale: Single read FAxisYScale write SetAxisYScale stored IsAxisYScaleStored;
property GridColor: TColor read FGridColor write SetGridColor default clGray;
property Monochrome: Boolean read FMonochrome write SetMonochrome default false;
property SoftColors: Boolean read FSoftColors write SetSoftColors default false;
property TickLength: Integer read FTickLength write SetTickLength default 2;
property Align;
property Anchors;
property BevelInner default bvNone;
@ -311,6 +326,7 @@ begin
FCaption := 'Series';
Spline := TBSpline.Create;
FKind := AKind;
FLineWidth := 1;
end;
destructor TNiceSeries.Destroy;
@ -418,6 +434,16 @@ begin
end;
end;
procedure TNiceSeries.SetLineWidth(const Value: Integer);
begin
if FLineWidth <> Value then
begin
FLineWidth := Value;
Chart.Changed;
end;
end;
{ TNiceChart }
constructor TNiceChart.Create(AOwner: TComponent);
@ -439,6 +465,7 @@ begin
FShowTitle := True;
FShowXGrid := True;
FShowYGrid := True;
FGridColor := clGray;
FMonochrome := False;
FTitle := 'Chart Title';
FTitleFont := TFont.Create;
@ -453,6 +480,7 @@ begin
FAxisYTitle := 'Y Axis';
FAxisXScale := 1;
FAxisYScale := 1;
FTickLength := 2;
XAxis := TList.Create;
YAxis := TList.Create;
FUpdating := False;
@ -498,6 +526,15 @@ begin
InternalPaint(Canvas);
end;
procedure TNiceChart.SetGridColor(const Value: TColor);
begin
if FGridColor <> value then
begin
FGridColor := Value;
DoPaint;
end;
end;
procedure TNiceChart.SetMonochrome(const Value: Boolean);
begin
if (FMonochrome <> Value) then
@ -638,6 +675,15 @@ begin
end;
end;
procedure TNiceChart.SetShowXAxisLine(const Value: Boolean);
begin
if (FShowXAxisLine <> Value) then
begin
FShowXAxisLine := Value;
DoPaint;
end;
end;
procedure TNiceChart.SetShowXGrid(const Value: Boolean);
begin
if (FShowXGrid <> Value) then
@ -647,6 +693,15 @@ begin
end;
end;
procedure TNiceChart.SetShowYAxisLine(const Value: Boolean);
begin
if (FShowYAxisLine <> Value) then
begin
FShowYAxisLine := Value;
DoPaint;
end;
end;
procedure TNiceChart.SetShowYGrid(const Value: Boolean);
begin
if (FShowYGrid <> Value) then
@ -656,6 +711,15 @@ begin
end;
end;
procedure TNiceChart.SetTickLength(const Value: Integer);
begin
if (FTickLength <> Value) and (Value >= 0) then
begin
FTickLength := Value;
DoPaint;
end;
end;
procedure TNiceChart.BeginUpdate;
begin
FUpdating := True;
@ -816,15 +880,13 @@ procedure TNiceChart.Calculate(AWidth, AHeight: Integer);
var
x, w, h, y, g: Integer;
Titled: Boolean;
begin
ClearAxis;
DestWidth := AWidth;
DestHeight := AHeight;
RcChart := Rect(0, 0, DestWidth, DestHeight);
MarkSize := Max(1, Round(DestWidth * 0.004));
MarkSize := Max(1, Round(DestWidth * 0.006));
InflateRect(RcChart, -OUTER_MARGIN, -OUTER_MARGIN);
@ -843,13 +905,13 @@ begin
Canvas.Font.Assign(FNormalFont);
h := Canvas.TextHeight('Ag');
RcChart.Bottom := RcChart.Bottom - (2 * h) - INNER_MARGIN - (2 * SMALL_MARGIN);
RcChart.Bottom := RcChart.Bottom - (2 * h) - INNER_MARGIN - FTickLength - SMALL_MARGIN;
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 + (2 * SMALL_MARGIN);
RcChart.Left := RcChart.Left + h + INNER_MARGIN + w + FTickLength + SMALL_MARGIN;
RcTitle.Left := RcChart.Left;
RcTitle.Right := RcChart.Right;
AdjustYAxis;
@ -1113,32 +1175,69 @@ end;
procedure TNiceChart.DrawXAxis(ACanvas: TCanvas);
var
l, t, w, x: Integer;
l, t, w, i: Integer;
P: PAxisInfo;
Str: string;
Last: Integer;
dummy, origin: Integer;
begin
with ACanvas do
begin
if FShowXGrid then
begin
Pen.Style := psDot;
Pen.Width := 1;
if FMonochrome then
Pen.Color := clBlack
else
Pen.Color := FGridColor;
t := RcChart.Top;
for i := 0 to XAxis.Count-1 do
begin
P := PAxisInfo(XAxis[i]);
if (P^.Px <= RcChart.Left) or (P^.Px >= RcChart.Right) then
Continue;
MoveTo(P^.Px, P^.Py);
LineTo(P^.px, t);
end;
end;
// Drawing the y axis here seems to be misplaced. But otherwise
// it could be overpainted by an x grid line.
if FShowYAxisLine then
begin
ChartToClient(0, 0, origin, dummy);
if (origin > RcChart.Left) and (origin < RcChart.Right) then
begin
Pen.Style := psSolid;
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo(origin, RcChart.Top);
LineTo(origin, RcChart.Bottom);
end;
end;
Pen.Style := psSolid;
Pen.Width := FAxisLineWidth;
Pen.Color := clBlack;
MoveTo(RcChart.Left, RcChart.Bottom);
LineTo(RcChart.Right, RcChart.Bottom);
Font.Assign(FNormalFont);
Font.Style := [fsBold];
w := RcChart.Right - RcChart.Left;
t := RcChart.Bottom + INNER_MARGIN + (2 * SMALL_MARGIN) + TextHeight('Ag');
t := RcChart.Bottom + INNER_MARGIN + FTickLength + SMALL_MARGIN + TextHeight('Ag');
l := RcChart.Left + ((w - TextWidth(FAxisXTitle)) div 2);
TextOut(l, t, FAxisXTitle);
Font.Assign(FNormalFont);
Pen.Color := clBlack;
Pen.Width := 1;
Pen.Style := psSolid;
t := RcChart.Bottom + (2 * SMALL_MARGIN);
t := RcChart.Bottom + FTickLength + SMALL_MARGIN;
Last := 0;
for x := 0 to XAxis.Count-1 do
for i := 0 to XAxis.Count-1 do
begin
P := PAxisInfo(XAxis[x]);
P := PAxisInfo(XAxis[i]);
Str := P^.Caption;
w := TextWidth(Str);
l := P^.Px - (w div 2);
@ -1148,20 +1247,7 @@ begin
Last := l + w;
end;
MoveTo(P^.Px, P^.Py);
LineTo(P^.Px, P^.Py + SMALL_MARGIN + 1);
end;
if FShowXGrid then
begin
Pen.Style := psDot;
Pen.Color := clGray;
t := RcChart.Top;
for x := 1 to XAxis.Count-2 do
begin
P := PAxisInfo(XAxis[x]);
MoveTo(P^.Px, P^.Py);
LineTo(P^.px, t);
end;
Pen.Color := clBlack;
LineTo(P^.Px, P^.Py + FTickLength + 1);
end;
end;
end;
@ -1169,16 +1255,52 @@ end;
procedure TNiceChart.DrawYAxis(ACanvas: TCanvas);
var
l, t, h, w: Integer;
x: Integer;
i: Integer;
Str: string;
P: PAxisInfo;
origin, dummy: Integer;
begin
with ACanvas do
begin
if FShowYGrid then
begin
Pen.Style := psDot;
Pen.Width := 1;
if FMonochrome then
Pen.Color := clBlack
else
Pen.Color := FGridColor;
for i := 0 to YAxis.Count-1 do
begin
P := PAxisInfo(YAxis[i]);
if (P^.Py <= RcChart.Top) or (P^.Py >= RcChart.Bottom) then
Continue;
MoveTo(P^.Px, P^.Py);
LineTo(RcChart.Right, P^.Py);
end;
Pen.Color := clBlack;
end;
// Drawing the x axis here seems to be misplaced. But otherwise
// it could be overpainted by a y grid line.
if FShowXAxisLine then
begin
ChartToClient(0, 0, dummy, origin);
if (origin > RcChart.Top) and (origin < RcChart.Bottom) then
begin
Pen.Style := psSolid;
Pen.Color := clBlack;
Pen.Width := 1;
MoveTo(RcChart.Left, origin);
LineTo(RcChart.Right, origin);
end;
end;
Pen.Style := psSolid;
Pen.Width := FAxisLineWidth;
MoveTo(RcChart.Left, RcChart.Top);
LineTo(RcChart.Left, RcChart.Bottom);
h := RcChart.Bottom - RcChart.Top;
l := OUTER_MARGIN;
Font.Assign(FNormalFont);
@ -1189,38 +1311,18 @@ begin
Pen.Color := clBlack;
Pen.Width := 1;
Pen.Style := psSolid;
l := RcChart.Left - (2 * SMALL_MARGIN);
for x := 0 to YAxis.Count-1 do
l := RcChart.Left - FTickLength - SMALL_MARGIN;
for i := 0 to YAxis.Count-1 do
begin
P := PAxisInfo(YAxis[x]);
P := PAxisInfo(YAxis[i]);
Str := P^.Caption;
w := TextWidth(Str);
h := TextHeight(Str);
t := P^.Py - (h div 2);
TextOut(l - w, t, Str);
MoveTo(P^.Px - SMALL_MARGIN, P^.Py);
MoveTo(P^.Px - FTickLength, P^.Py);
LineTo(P^.Px, P^.Py);
end;
if FShowYGrid then
begin
l := RcChart.Right;
for x := 1 to YAxis.Count-2 do
begin
P := PAxisInfo(YAxis[x]);
if (P^.Value = 0) then
begin
Pen.Style := psSolid;
Pen.Color := clBlack;
end else
begin
Pen.Style := psDot;
Pen.Color := clGray;
end;
MoveTo(P^.Px, P^.Py);
LineTo(l, P^.Py);
end;
Pen.Color := clBlack;
end;
end;
end;
@ -1345,6 +1447,7 @@ begin
begin
if (sr.FKind = skBar) then
begin
Pen.Width := 1;
for x := 0 to Sr.Values.Count-1 do
begin
P := PXYInfo(Sr.Values[x]);
@ -1354,6 +1457,7 @@ begin
begin
if (sr.FKind = skLine) then
begin
Pen.Width := sr.LineWidth;
for x := 0 to Sr.Values.Count-1 do
begin
P := PXYInfo(Sr.Values[x]);
@ -1362,8 +1466,12 @@ begin
else LineTo(P^.Px, P^.Py);
end;
end else
if (sr.FKind = skSmooth)
then sr.Spline.Draw(ACanvas);
if (sr.FKind = skSmooth) then
begin
Pen.Width := sr.LineWidth;
sr.Spline.Draw(ACanvas);
end;
Pen.Width := 1;
for x := 0 to Sr.Values.Count-1 do
begin
P := PXYInfo(Sr.Values[x]);
@ -1381,9 +1489,11 @@ begin
Rectangle(Rc);
end else
begin
Pen.Width := sr.LineWidth;
t2 := t + (LEGEND_ITEM div 2);
MoveTo(l, t2);
LineTo(l + LEGEND_ITEM, t2);
Pen.Width := 1;
Marker(ACanvas, l + (LEGEND_ITEM div 2), t2, MarkSize);
end;
end;