diff --git a/components/nicechart/demo/Delphi/Project1.res b/components/nicechart/demo/Delphi/Project1.res deleted file mode 100644 index 4f16aba1d..000000000 Binary files a/components/nicechart/demo/Delphi/Project1.res and /dev/null differ diff --git a/components/nicechart/demo/common/Unit1.dfm b/components/nicechart/demo/common/Unit1.dfm index 66cbb8bef..e8ea5f027 100644 --- a/components/nicechart/demo/common/Unit1.dfm +++ b/components/nicechart/demo/common/Unit1.dfm @@ -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 diff --git a/components/nicechart/demo/common/Unit1.lfm b/components/nicechart/demo/common/Unit1.lfm index 09ffb7190..41a3d533e 100644 --- a/components/nicechart/demo/common/Unit1.lfm +++ b/components/nicechart/demo/common/Unit1.lfm @@ -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 diff --git a/components/nicechart/demo/common/Unit1.pas b/components/nicechart/demo/common/Unit1.pas index ecef493d0..3c91bdf44 100644 --- a/components/nicechart/demo/common/Unit1.pas +++ b/components/nicechart/demo/common/Unit1.pas @@ -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; diff --git a/components/nicechart/source/NiceChart.pas b/components/nicechart/source/NiceChart.pas index a8287113f..a20a5e0f0 100644 --- a/components/nicechart/source/NiceChart.pas +++ b/components/nicechart/source/NiceChart.pas @@ -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;