You've already forked lazarus-ccr
579bdde011
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8867 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1805 lines
44 KiB
ObjectPascal
1805 lines
44 KiB
ObjectPascal
{-------------------------------------------------------------------------------
|
|
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is NiceChart.pas released at May 26th, 2007.
|
|
The Initial Developer of the Original Code is Priyatna.
|
|
(Website: http://www.priyatna.org Email: me@priyatna.org)
|
|
All Rights Reserved.
|
|
|
|
Alternatively, the contents of this file may be used under the terms of the
|
|
GNU General Public License Version 2 or later (the "GPL"), in which case
|
|
the provisions of the GPL are applicable instead of those above.
|
|
If you wish to allow use of your version of this file only under the terms
|
|
of the GPL and not to allow others to use your version of this file
|
|
under the MPL, indicate your decision by deleting the provisions above and
|
|
replace them with the notice and other provisions required by the GPL.
|
|
If you do not delete the provisions above, a recipient may use your version
|
|
of this file under either the MPL or the GPL.
|
|
|
|
-------------------------------------------------------------------------------}
|
|
|
|
{$IFDEF FPC}
|
|
{$MODE Delphi}
|
|
{$ENDIF}
|
|
|
|
unit NiceChart;
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF FPC}
|
|
LclIntf, LCLType, LMessages,
|
|
{$ELSE}
|
|
Windows, Messages,
|
|
{$ENDIF}
|
|
Classes, Graphics, Forms, Controls, ExtCtrls, SysUtils,
|
|
BSplines, Math;
|
|
|
|
const
|
|
UndefinedValueChart: Double = MaxDouble;
|
|
|
|
type
|
|
TNiceChart = class;
|
|
|
|
TSeriesKind = (skLine, skSmooth, skBar);
|
|
|
|
TNiceSeries = class(TObject)
|
|
private
|
|
Top: Integer;
|
|
Values: TList;
|
|
Chart: TNiceChart;
|
|
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
|
|
constructor Create(AChart: TNiceChart; AKind: TSeriesKind);
|
|
destructor Destroy; override;
|
|
function AddXY(AX, AY: Double; AHint: string = ''): Integer;
|
|
procedure Remove(Index: Integer);
|
|
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
|
|
MinValue: Double;
|
|
Scale: Double;
|
|
Base: Integer;
|
|
end;
|
|
|
|
TMarkerProc = procedure (ACanvas: TCanvas; X, Y, Size: Integer);
|
|
|
|
TNiceChart = class(TCustomPanel)
|
|
private
|
|
Brushes: array [0..15] of TBitmap;
|
|
Temp: TStringList;
|
|
MarkSize: Integer;
|
|
Marker: TMarkerProc;
|
|
BarCount: Integer;
|
|
BarWidth: Integer;
|
|
DestWidth, DestHeight: Integer;
|
|
YZero: Integer;
|
|
ChartEmpty: Boolean;
|
|
List: TList;
|
|
XAxis: TList;
|
|
YAxis: TList;
|
|
FShowLegend: Boolean;
|
|
FShowTitle: Boolean;
|
|
FShowXAxisLine: Boolean;
|
|
FShowYAxisLine: Boolean;
|
|
FTitle: string;
|
|
FTitleFont: TFont;
|
|
FNormalFont: TFont;
|
|
FUpdating: Boolean;
|
|
RcChart, RcLegend, RcTitle: TRect;
|
|
FXTranslate: TValueTranslator;
|
|
FYTranslate: TValueTranslator;
|
|
FAxisXOnePerValue: Boolean;
|
|
FAxisYTitle: string;
|
|
FAxisXTitle: string;
|
|
FAxisLineWidth: Integer;
|
|
FShowYGrid: Boolean;
|
|
FShowXGrid: Boolean;
|
|
FAxisYScale: Single;
|
|
FAxisXScale: Single;
|
|
FMonochrome: Boolean;
|
|
FGridColor: TColor;
|
|
FSoftColors: Boolean;
|
|
FTickLength: Integer;
|
|
FOuterMargin: Integer;
|
|
FInnerMargin: Integer;
|
|
FSmallMargin: Integer;
|
|
FAxisDefSize: Integer;
|
|
FLegendItemSize: Integer;
|
|
{$IFNDEF FPC}
|
|
FClipRgn: HRGN;
|
|
{$ENDIF}
|
|
procedure InternalClear;
|
|
procedure InternalPaint(ACanvas: TCanvas);
|
|
procedure Calculate(AWidth, AHeight: Integer);
|
|
procedure DoCalculate(ACanvas: TCanvas; 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);
|
|
{$IFDEF FPC}
|
|
procedure WMSize(var Msg: TLMSize); message LM_SIZE;
|
|
procedure WMEraseBkgnd(var Msg: TLMEraseBkgnd); message LM_ERASEBKGND;
|
|
{$ELSE}
|
|
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
|
|
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
|
|
{$ENDIF}
|
|
function GetSeries(Index: Integer): TNiceSeries;
|
|
function GetSeriesCount: Integer;
|
|
procedure DrawLegend(ACanvas: TCanvas);
|
|
procedure DrawTitle(ACanvas: TCanvas);
|
|
procedure SetAxisXTitle(const Value: string);
|
|
procedure SetAxisYTitle(const Value: string);
|
|
procedure BuildYAxis;
|
|
procedure DrawYAxis(ACanvas: TCanvas);
|
|
procedure DrawXAxis(ACanvas: TCanvas);
|
|
procedure DrawChart(ACanvas: TCanvas);
|
|
procedure BuildXAxis;
|
|
procedure ClearAxis;
|
|
procedure AdjustYAxis;
|
|
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);
|
|
procedure SetAxisXScale(const Value: Single);
|
|
procedure SetAxisYScale(const Value: Single);
|
|
procedure SetMonochrome(const Value: Boolean);
|
|
function GetLabel(Value: Double): string;
|
|
procedure SetSoftColors(const Value: Boolean);
|
|
function IsAxisXScaleStored: Boolean;
|
|
function IsAxisXTitleStored: Boolean;
|
|
function IsAxisYScaleStored: Boolean;
|
|
function IsAxisYTitleStored: Boolean;
|
|
function IsTitleStored: Boolean;
|
|
procedure SetAxisLineWidth(const Value: Integer);
|
|
protected
|
|
procedure Paint; override;
|
|
procedure Changed;
|
|
procedure ChartToClient(const AX, AY: Double; var X, Y: Integer);
|
|
procedure CreateHandle; override;
|
|
procedure ClipToRect(ACanvas: TCanvas; const ARect: TRect; AEnable: Boolean);
|
|
{$IFDEF FPC}
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double); override;
|
|
{$ENDIF}
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate;
|
|
function AddSeries(AKind: TSeriesKind): TNiceSeries;
|
|
function ClientToChart(const X, Y: Integer; var AX, AY: Double): Boolean;
|
|
procedure RemoveSeries(ASeries: TNiceSeries);
|
|
procedure Clear;
|
|
property Series[Index: Integer]: TNiceSeries read GetSeries;
|
|
property SeriesCount: Integer read GetSeriesCount;
|
|
{$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}
|
|
function CreateBitmap(AWidth, AHeight: Integer): TBitmap;
|
|
procedure CopyToClipboardAsBitmap;
|
|
published
|
|
property AxisLineWidth: Integer read FAxisLineWidth write SetAxisLineWidth default 3;
|
|
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;
|
|
property AxisYTitle: string read FAxisYTitle write SetAxisYTitle stored IsAxisYTitleStored;
|
|
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;
|
|
property BevelOuter default bvNone;
|
|
property BorderStyle default bsSingle;
|
|
{$IFDEF FPC}
|
|
property BorderSpacing;
|
|
{$ELSE}
|
|
property BevelKind;
|
|
{$ENDIF}
|
|
property OnMouseMove;
|
|
property OnMouseDown;
|
|
property OnMouseUp;
|
|
property PopupMenu;
|
|
end;
|
|
|
|
procedure CalculateAxis(AMin, AMax: Double; Count: Integer;
|
|
out Delta, Lowest: Double);
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
{$R NiceChart.res}
|
|
|
|
{$IFDEF FPC}
|
|
{$R nicechart_images.res}
|
|
{$ENDIF}
|
|
|
|
uses
|
|
ClipBrd;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('priyatna.org', [TNiceChart]);
|
|
end;
|
|
|
|
const
|
|
OUTER_MARGIN = 20;
|
|
INNER_MARGIN = 10;
|
|
SMALL_MARGIN = 2;
|
|
LEGEND_ITEM = 20;
|
|
AXIS_DEFSIZE = 50;
|
|
|
|
Formatter = '0.##';
|
|
|
|
type
|
|
PXYInfo = ^TXYInfo;
|
|
TXYInfo = record
|
|
X, Y: Double;
|
|
Px, Py: Integer;
|
|
Rc: TRect;
|
|
Hint: string;
|
|
end;
|
|
|
|
PAxisInfo = ^TAxisInfo;
|
|
TAxisInfo = record
|
|
Value: Double;
|
|
Px, Py: Integer;
|
|
Caption: string;
|
|
end;
|
|
|
|
|
|
function GetMan10(Value: Double): Double;
|
|
var
|
|
Str: string;
|
|
begin
|
|
Str := UpperCase(Format('%E', [Value]));
|
|
Result := StrToFloat('1E' + Copy(Str, Pos('E', Str) + 1, Length(Str)));
|
|
end;
|
|
|
|
procedure CalculateAxis(AMin, AMax: Double; Count: Integer;
|
|
out Delta, Lowest: Double);
|
|
label
|
|
Retry;
|
|
var
|
|
c, n, m10: Double;
|
|
begin
|
|
c := Max(2, Count-1);
|
|
n := (Abs(AMax - AMin) / c);
|
|
m10 := GetMan10(n);
|
|
Delta := 0;
|
|
while (Delta < n)
|
|
do Delta := Delta + (0.5 * m10);
|
|
if (Delta = 0) then
|
|
begin
|
|
Delta := 1;
|
|
Lowest := AMin - (Count div 2);
|
|
Exit;
|
|
end;
|
|
Retry:
|
|
Lowest := Trunc(AMin / Delta) * Delta;
|
|
if (Lowest > AMin)
|
|
then Lowest := Lowest - Delta;
|
|
if ((Lowest + (Delta * c)) < AMax) then
|
|
begin
|
|
Delta := Delta + (0.5 * m10);
|
|
goto Retry;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TNiceSeries }
|
|
|
|
constructor TNiceSeries.Create(AChart: TNiceChart; AKind: TSeriesKind);
|
|
begin
|
|
inherited Create;
|
|
Chart := AChart;
|
|
Values := TList.Create;
|
|
FCaption := 'Series';
|
|
Spline := TBSpline.Create;
|
|
FKind := AKind;
|
|
FLineWidth := 1;
|
|
end;
|
|
|
|
destructor TNiceSeries.Destroy;
|
|
begin
|
|
Spline.Free;
|
|
InternalClear;
|
|
Values.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TNiceSeries.InternalClear;
|
|
var
|
|
x: Integer;
|
|
begin
|
|
for x := 0 to Values.Count-1 do
|
|
Dispose(PXYInfo(Values[x]));
|
|
Values.Clear;
|
|
end;
|
|
|
|
procedure TNiceSeries.Clear;
|
|
begin
|
|
InternalClear;
|
|
Chart.Changed;
|
|
end;
|
|
|
|
function TNiceSeries.AddXY(AX, AY: Double; AHint: string): Integer;
|
|
var
|
|
Info: PXYInfo;
|
|
begin
|
|
Info := New(PXYInfo);
|
|
Info^.X := AX;
|
|
Info^.Y := AY;
|
|
Info^.Px := 0;
|
|
Info^.Py := 0;
|
|
Info^.Rc := Rect(0, 0, 0, 0);
|
|
Info^.Hint := AHint;
|
|
Result := Values.Add(Info);
|
|
Chart.Changed;
|
|
end;
|
|
|
|
procedure TNiceSeries.Remove(Index: Integer);
|
|
var
|
|
P: PXYInfo;
|
|
begin
|
|
if (Index >= 0) and (Index < Values.Count) then
|
|
begin
|
|
P := Values[Index];
|
|
Values.Remove(P);
|
|
Dispose(P);
|
|
Chart.Changed;
|
|
end;
|
|
end;
|
|
|
|
function TNiceSeries.GetMaxXValue: Double;
|
|
var
|
|
x: Integer;
|
|
begin
|
|
Result := -MaxDouble;
|
|
for x := 0 to Values.Count-1 do
|
|
Result := Max(Result, PXYInfo(Values[x])^.X);
|
|
end;
|
|
|
|
function TNiceSeries.GetMinXValue: Double;
|
|
var
|
|
x: Integer;
|
|
begin
|
|
Result := MaxDouble;
|
|
for x := 0 to Values.Count-1 do
|
|
Result := Min(Result, PXYInfo(Values[x])^.X);
|
|
end;
|
|
|
|
function TNiceSeries.GetMaxYValue: Double;
|
|
var
|
|
x: Integer;
|
|
begin
|
|
Result := -MaxDouble;
|
|
for x := 0 to Values.Count-1 do
|
|
Result := Max(Result, PXYInfo(Values[x])^.Y);
|
|
end;
|
|
|
|
function TNiceSeries.GetMinYValue: Double;
|
|
var
|
|
x: Integer;
|
|
begin
|
|
Result := MaxDouble;
|
|
for x := 0 to Values.Count-1 do
|
|
Result := Min(Result, PXYInfo(Values[x])^.Y);
|
|
end;
|
|
|
|
procedure TNiceSeries.SetCaption(const Value: string);
|
|
begin
|
|
if (FCaption <> Value) then
|
|
begin
|
|
FCaption := Value;
|
|
Chart.Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceSeries.SetKind(const Value: TSeriesKind);
|
|
begin
|
|
if (FKind <> Value) then
|
|
begin
|
|
FKind := Value;
|
|
Chart.Changed;
|
|
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);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ParentColor := False;
|
|
ParentBackground := False;
|
|
ParentFont := False;
|
|
Temp := TStringList.Create;
|
|
Width := 300;
|
|
Height := 200;
|
|
Color := clWhite;
|
|
BevelOuter := bvNone;
|
|
BevelInner := bvNone;
|
|
BorderStyle := bsSingle;
|
|
ControlStyle := ControlStyle + [csNeedsBorderPaint];
|
|
List := TList.Create;
|
|
FShowLegend := True;
|
|
FShowTitle := True;
|
|
FShowXGrid := True;
|
|
FShowYGrid := True;
|
|
FGridColor := clGray;
|
|
FMonochrome := False;
|
|
FTitle := 'Chart Title';
|
|
FTitleFont := TFont.Create;
|
|
FTitleFont.Name := 'Arial';
|
|
FTitleFont.Size := 14;
|
|
FTitleFont.Style := [];
|
|
FTitleFont.OnChange := TitleFontChanged;
|
|
FNormalFont := TFont.Create;
|
|
FNormalFont.Name := 'Arial';
|
|
FAxisLineWidth := 3;
|
|
FAxisXTitle := 'X Axis';
|
|
FAxisYTitle := 'Y Axis';
|
|
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;
|
|
end;
|
|
|
|
destructor TNiceChart.Destroy;
|
|
var
|
|
x: Integer;
|
|
begin
|
|
for x := 0 to 15 do
|
|
begin
|
|
if Assigned(Brushes[x])
|
|
then Brushes[x].Free;
|
|
end;
|
|
InternalClear;
|
|
List.Free;
|
|
FTitleFont.Free;
|
|
FNormalFont.Free;
|
|
XAxis.Free;
|
|
YAxis.Free;
|
|
Temp.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TNiceChart.InternalClear;
|
|
var
|
|
x: Integer;
|
|
begin
|
|
for x := 0 to List.Count-1
|
|
do TNiceSeries(List[x]).Free;
|
|
ClearAxis;
|
|
List.Clear;
|
|
end;
|
|
|
|
procedure TNiceChart.Paint;
|
|
begin
|
|
if HandleAllocated
|
|
then DoPaint;
|
|
end;
|
|
|
|
procedure TNiceChart.DoPaint;
|
|
begin
|
|
InternalPaint(Canvas);
|
|
end;
|
|
|
|
procedure TNiceChart.SetGridColor(const Value: TColor);
|
|
begin
|
|
if FGridColor <> value then
|
|
begin
|
|
FGridColor := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetMonochrome(const Value: Boolean);
|
|
begin
|
|
if (FMonochrome <> Value) then
|
|
begin
|
|
FMonochrome := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetSoftColors(const Value: Boolean);
|
|
begin
|
|
if (FSoftColors <> Value) then
|
|
begin
|
|
FSoftColors := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetShowLegend(const Value: Boolean);
|
|
begin
|
|
if (FShowLegend <> Value) then
|
|
begin
|
|
FShowLegend := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetAxisXOnePerValue(const Value: Boolean);
|
|
begin
|
|
if (FAxisXOnePerValue <> Value) then
|
|
begin
|
|
FAxisXOnePerValue := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetShowTitle(const Value: Boolean);
|
|
begin
|
|
if (FShowTitle <> Value) then
|
|
begin
|
|
FShowTitle := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetTitle(const Value: string);
|
|
begin
|
|
if (FTitle <> Value) then
|
|
begin
|
|
FTitle := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetTitleFont(const Value: TFont);
|
|
begin
|
|
FTitleFont.Assign(Value);
|
|
end;
|
|
|
|
procedure TNiceChart.TitleFontChanged(Sender: TObject);
|
|
begin
|
|
Changed;
|
|
end;
|
|
|
|
procedure TNiceChart.SetAxisXTitle(const Value: string);
|
|
begin
|
|
if (FAxisXTitle <> Value) then
|
|
begin
|
|
FAxisXTitle := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetAxisYTitle(const Value: string);
|
|
begin
|
|
if (FAxisYTitle <> Value) then
|
|
begin
|
|
FAxisYTitle := Value;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
function TNiceChart.IsAxisXScaleStored: Boolean;
|
|
begin
|
|
Result := FAxisXScale <> 1.0;
|
|
end;
|
|
|
|
function TNiceChart.IsAxisXTitleStored: Boolean;
|
|
begin
|
|
Result := FaxisXTitle <> '';
|
|
end;
|
|
|
|
function TNiceChart.IsAxisYScaleStored: Boolean;
|
|
begin
|
|
Result := FAxisYScale <> 1.0;
|
|
end;
|
|
|
|
function TNiceChart.IsAxisYTitleStored: Boolean;
|
|
begin
|
|
Result := FAxisYTitle <> '';
|
|
end;
|
|
|
|
function TNiceChart.IsTitleStored: Boolean;
|
|
begin
|
|
Result := FTitle <> '';
|
|
end;
|
|
|
|
procedure TNiceChart.SetAxisXScale(const Value: Single);
|
|
begin
|
|
if (FAxisXScale <> Value) then
|
|
begin
|
|
FAxisXScale := Value;
|
|
if (FAxisXScale = 0)
|
|
then FAxisXScale := 1;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetAxisLineWidth(const Value: Integer);
|
|
begin
|
|
if (FAxisLineWidth <> Value) then
|
|
begin
|
|
FAxisLineWidth := Value;
|
|
if FAxisLineWidth < 1 then
|
|
FAxisLineWidth := 1;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetAxisYScale(const Value: Single);
|
|
begin
|
|
if (FAxisYScale <> Value) then
|
|
begin
|
|
FAxisYScale := Value;
|
|
if (FAxisYScale = 0)
|
|
then FAxisYScale := 1;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetShowXAxisLine(const Value: Boolean);
|
|
begin
|
|
if (FShowXAxisLine <> Value) then
|
|
begin
|
|
FShowXAxisLine := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetShowXGrid(const Value: Boolean);
|
|
begin
|
|
if (FShowXGrid <> Value) then
|
|
begin
|
|
FShowXGrid := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetShowYAxisLine(const Value: Boolean);
|
|
begin
|
|
if (FShowYAxisLine <> Value) then
|
|
begin
|
|
FShowYAxisLine := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetShowYGrid(const Value: Boolean);
|
|
begin
|
|
if (FShowYGrid <> Value) then
|
|
begin
|
|
FShowYGrid := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.SetTickLength(const Value: Integer);
|
|
begin
|
|
if (FTickLength <> Value) and (Value >= 0) then
|
|
begin
|
|
FTickLength := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.BeginUpdate;
|
|
begin
|
|
FUpdating := True;
|
|
end;
|
|
|
|
procedure TNiceChart.EndUpdate;
|
|
begin
|
|
FUpdating := False;
|
|
Calculate(ClientWidth, ClientHeight);
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TNiceChart.Changed;
|
|
begin
|
|
if not FUpdating then
|
|
begin
|
|
Calculate(ClientWidth, ClientHeight);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.WMSize(var Msg: {$IFDEF FPC}TLMSize{$ELSE}TWMSize{$ENDIF});
|
|
begin
|
|
inherited;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TNiceChart.WMEraseBkgnd(var Msg: {$IFDEF FPC}TLMEraseBkgnd{$ELSE}TWMEraseBkgnd{$ENDIF});
|
|
begin
|
|
Msg.Result := 1;
|
|
end;
|
|
|
|
function TNiceChart.GetSeries(Index: Integer): TNiceSeries;
|
|
begin
|
|
Result := TNiceSeries(List[Index]);
|
|
end;
|
|
|
|
function TNiceChart.AddSeries(AKind: TSeriesKind): TNiceSeries;
|
|
begin
|
|
Result := TNiceSeries.Create(Self, AKind);
|
|
List.Add(Result);
|
|
end;
|
|
|
|
procedure TNiceChart.Clear;
|
|
begin
|
|
InternalClear;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TNiceChart.RemoveSeries(ASeries: TNiceSeries);
|
|
begin
|
|
if Assigned(ASeries) then
|
|
begin
|
|
List.Remove(ASeries);
|
|
ASeries.Free;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
function TNiceChart.GetSeriesCount: Integer;
|
|
begin
|
|
Result := List.Count;
|
|
end;
|
|
|
|
procedure TNiceChart.DrawLegend(ACanvas: TCanvas);
|
|
var
|
|
x, y, l, t: Integer;
|
|
th, g: Integer;
|
|
begin
|
|
with ACanvas do
|
|
begin
|
|
Pen.Width := 1;
|
|
Pen.Style := psSolid;
|
|
Font.Assign(FNormalFont);
|
|
g := TextHeight('Ag');
|
|
th := (FLegendItemSize - g) div 2;
|
|
Brush.Style := bsSolid;
|
|
Brush.Color := clBlack;
|
|
FillRect(Rect(RcLegend.Right, RcLegend.Top + 3, RcLegend.Right + 3, RcLegend.Bottom + 3));
|
|
FillRect(Rect(RcLegend.Left + 3, RcLegend.Bottom, RcLegend.Right + 3, RcLegend.Bottom + 3));
|
|
Brush.Style := bsClear;
|
|
Rectangle(RcLegend);
|
|
Brush.Style := bsClear;
|
|
l := RcLegend.Left + FInnerMargin + FLegendItemSize + FSmallMargin;
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
Temp.Text := Trim(TNiceSeries(List[x]).FCaption);
|
|
t := RcLegend.Top + TNiceSeries(List[x]).Top;
|
|
for y := 0 to Temp.Count-1 do
|
|
begin
|
|
TextOut(l, t + th, Trim(Temp[y]));
|
|
Inc(t, g);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.DrawTitle(ACanvas: TCanvas);
|
|
begin
|
|
with ACanvas do
|
|
begin
|
|
Brush.Style := bsClear;
|
|
Font.Assign(FTitleFont);
|
|
DrawText(Handle, PChar(FTitle), Length(FTitle), RcTitle,
|
|
DT_CENTER or DT_VCENTER or DT_WORDBREAK);
|
|
end;
|
|
end;
|
|
|
|
procedure RotTextOut(ACanvas: TCanvas; x, y, Angle: Integer; Txt: String);
|
|
{$IFNDEF FPC}
|
|
var
|
|
RotFont, OldFont: Integer;
|
|
FBold, FItalic, FUnderline, FStrikeOut: integer;
|
|
{$ENDIF}
|
|
begin
|
|
if (Txt = '')
|
|
then Exit;
|
|
SetBkMode(ACanvas.Handle, TRANSPARENT);
|
|
{$IFDEF FPC}
|
|
ACanvas.Font.Orientation := Angle * 10;
|
|
ACanvas.TextOut(x, y, Txt);
|
|
ACanvas.Font.Orientation := 0;
|
|
{$ELSE}
|
|
if (fsItalic in ACanvas.Font.Style)
|
|
then FItalic := 1
|
|
else FItalic := 0;
|
|
if (fsUnderline in ACanvas.Font.Style)
|
|
then FUnderline := 1
|
|
else FUnderline := 0;
|
|
if (fsStrikeOut in ACanvas.Font.Style)
|
|
then FStrikeOut := 1
|
|
else FStrikeOut := 0;
|
|
if (fsBold in ACanvas.Font.Style)
|
|
then FBold := FW_BOLD
|
|
else FBold := FW_NORMAL;
|
|
RotFont := CreateFont(ACanvas.Font.Height, 0, Angle*10, 0,
|
|
FBold, FItalic, FUnderline, FStrikeOut, 1, 4, $10,
|
|
ANTIALIASED_QUALITY, 4, PChar(ACanvas.Font.Name));
|
|
OldFont := SelectObject(ACanvas.Handle, RotFont);
|
|
TextOut(ACanvas.Handle, x, y, PChar(Txt), Length(Txt));
|
|
SelectObject(ACanvas.Handle, OldFont);
|
|
DeleteObject(RotFont);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TNiceChart.InternalPaint(ACanvas: TCanvas);
|
|
begin
|
|
with ACanvas do
|
|
begin
|
|
Pen.Color := clBlack;
|
|
Pen.Width := 1;
|
|
Brush.Style := bsSolid;
|
|
Brush.Color := Color;
|
|
FillRect(Rect(0, 0, DestWidth, DestHeight));
|
|
end;
|
|
if FShowLegend and (List.Count > 0)
|
|
then DrawLegend(ACanvas);
|
|
if FShowTitle and (FTitle <> '')
|
|
then DrawTitle(ACanvas);
|
|
DrawXAxis(ACanvas);
|
|
DrawYAxis(ACanvas);
|
|
DrawChart(ACanvas);
|
|
end;
|
|
|
|
procedure TNiceChart.Calculate(AWidth, AHeight: Integer);
|
|
var
|
|
bmp: TBitmap;
|
|
begin
|
|
if Canvas.HandleAllocated then
|
|
DoCalculate(Canvas, AWidth, AHeight)
|
|
else
|
|
begin
|
|
// Use an auxiliary bitmap in case of early calls when the Canvas has not handle, yet.
|
|
bmp := TBitmap.Create;
|
|
try
|
|
bmp.Width := AWidth;
|
|
bmp.Height := AHeight;
|
|
DoCalculate(bmp.Canvas, AWidth, AHeight);
|
|
finally
|
|
bmp.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.DoCalculate(ACanvas: TCanvas; 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.006));
|
|
|
|
InflateRect(RcChart, -FOuterMargin, -FOuterMargin);
|
|
|
|
Titled := False;
|
|
if FShowTitle and (FTitle <> '') then
|
|
begin
|
|
ACanvas.Font.Assign(TitleFont);
|
|
w := ACanvas.TextHeight(FTitle);
|
|
RcTitle := Rect(RcChart.Left, RcChart.Top, RcChart.Right, RcChart.Left + w);
|
|
DrawText(ACanvas.Handle, PChar(FTitle), Length(FTitle), RcTitle,
|
|
DT_CENTER or DT_VCENTER or DT_WORDBREAK or DT_CALCRECT);
|
|
RcChart.Top := RcTitle.Bottom + FInnerMargin;
|
|
Titled := True;
|
|
end else
|
|
SetRectEmpty(RcTitle);
|
|
|
|
ACanvas.Font.Assign(FNormalFont);
|
|
h := ACanvas.TextHeight('Ag');
|
|
RcChart.Bottom := RcChart.Bottom - (2 * h) - FInnerMargin - FTickLength - FSmallmargin;
|
|
|
|
BuildYAxis;
|
|
w := 0;
|
|
for x := 0 to YAxis.Count-1 do
|
|
w := Max(w, ACanvas.TextWidth(PAxisInfo(YAxis[x])^.Caption));
|
|
RcChart.Left := RcChart.Left + h + FInnerMargin + w + FTickLength + FSmallMargin;
|
|
RcTitle.Left := RcChart.Left;
|
|
RcTitle.Right := RcChart.Right;
|
|
AdjustYAxis;
|
|
|
|
if FShowLegend and (List.Count > 0) then
|
|
begin
|
|
ACanvas.Font.Assign(FNormalFont);
|
|
w := 0;
|
|
h := FInnerMargin;
|
|
g := ACanvas.TextHeight('Ag');
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
TNiceSeries(List[x]).Top := h;
|
|
Temp.Text := Trim(TNiceSeries(List[x]).FCaption);
|
|
for y := 0 to Temp.Count-1 do
|
|
w := Max(w, ACanvas.TextWidth(Trim(Temp[y])));
|
|
h := h + Max(FLegendItemSize, Temp.Count * g);
|
|
if (x <> List.Count-1)
|
|
then h := h + FSmallMargin;
|
|
end;
|
|
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 * FInnerMargin);
|
|
if Titled
|
|
then RcTitle.Right := RcChart.Right;
|
|
end else
|
|
SetRectEmpty(RcLegend);
|
|
|
|
BuildXAxis;
|
|
|
|
CalculateSeries;
|
|
|
|
end;
|
|
|
|
procedure TNiceChart.ClearAxis;
|
|
var
|
|
x: Integer;
|
|
begin
|
|
for x := 0 to XAxis.Count-1
|
|
do Dispose(PAxisInfo(XAxis[x]));
|
|
XAxis.Clear;
|
|
for x := 0 to YAxis.Count-1
|
|
do Dispose(PAxisInfo(YAxis[x]));
|
|
YAxis.Clear;
|
|
end;
|
|
|
|
type
|
|
PDoubleList = ^TDoubleList;
|
|
TDoubleList = array [0..0] of Double;
|
|
|
|
procedure QuickSortDouble(SortList: PDoubleList; L, R: Integer);
|
|
var
|
|
I, J: Integer;
|
|
P, T: Double;
|
|
begin
|
|
repeat
|
|
I := L;
|
|
J := R;
|
|
P := SortList^[(L + R) shr 1];
|
|
repeat
|
|
while (SortList^[I] < P)
|
|
do Inc(I);
|
|
while (SortList^[J] > P)
|
|
do Dec(J);
|
|
if I <= J then
|
|
begin
|
|
T := SortList^[I];
|
|
SortList^[I] := SortList^[J];
|
|
SortList^[J] := T;
|
|
Inc(I);
|
|
Dec(J);
|
|
end;
|
|
until I > J;
|
|
if L < J
|
|
then QuickSortDouble(SortList, L, J);
|
|
L := I;
|
|
until I >= R;
|
|
end;
|
|
|
|
function TNiceChart.GetLabel(Value: Double): string;
|
|
begin
|
|
if (Value = UndefinedValueChart)
|
|
then Result := '~'
|
|
else Result := FormatFloat(Formatter, Value);
|
|
end;
|
|
|
|
procedure TNiceChart.BuildXAxis;
|
|
var
|
|
x, y, w: Integer;
|
|
mi, ma: Double;
|
|
Cnt, i, n: Integer;
|
|
Delta, Lowest, l: Double;
|
|
P: PAxisInfo;
|
|
tmp: PDoubleList;
|
|
Vals: TList;
|
|
Last: Double;
|
|
Scale: Double;
|
|
dx: Integer;
|
|
|
|
begin
|
|
if (List.Count = 0) or ChartEmpty
|
|
then Exit;
|
|
|
|
BarCount := 0;
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
if (TNiceSeries(List[x]).FKind = skBar)
|
|
then Inc(BarCount);
|
|
end;
|
|
if (BarCount > 0)
|
|
then FAxisXOnePerValue := True;
|
|
|
|
if FAxisXOnePerValue then
|
|
begin
|
|
w := RcChart.Right - RcChart.Left;
|
|
Cnt := 0;
|
|
for x := 0 to List.Count-1
|
|
do Cnt := Cnt + Series[x].Values.Count;
|
|
GetMem(tmp, Cnt * SizeOf(Double));
|
|
i := 0;
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
Vals := TNiceSeries(List[x]).Values;
|
|
for y := 0 to Vals.Count-1 do
|
|
begin
|
|
tmp^[i] := PXYInfo(Vals[y])^.X;
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
QuickSortDouble(tmp, 0, Cnt-1);
|
|
n := 0;
|
|
Last := MaxDouble;
|
|
for x := 0 to Cnt-1 do
|
|
begin
|
|
l := tmp^[x];
|
|
if (l = Last)
|
|
then Continue;
|
|
Inc(n);
|
|
Last := l;
|
|
end;
|
|
if (BarCount > 0) then
|
|
begin
|
|
Scale := w / n;
|
|
dx := Round(Scale / 2);
|
|
BarWidth := Round(Scale);
|
|
end else
|
|
begin
|
|
Scale := w / (n-1);
|
|
dx := 0;
|
|
end;
|
|
Last := MaxDouble;
|
|
i := 0;
|
|
for x := 0 to Cnt-1 do
|
|
begin
|
|
l := tmp^[x];
|
|
if (l = Last)
|
|
then Continue;
|
|
P := New(PAxisInfo);
|
|
P^.Value := l;
|
|
P^.Py := RcChart.Bottom;
|
|
P^.Px := RcChart.Left + dx + Round(i * Scale);
|
|
P^.Caption := GetLabel(l / FAxisXScale);
|
|
XAxis.Add(P);
|
|
Last := l;
|
|
Inc(i);
|
|
end;
|
|
FreeMem(tmp);
|
|
end else
|
|
begin
|
|
w := RcChart.Right - RcChart.Left;
|
|
Cnt := (w div FAxisDefSize) + 1;
|
|
mi := MaxDouble;
|
|
ma := -MaxDouble;
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
mi := Min(mi, Series[x].GetMinXValue);
|
|
ma := Max(ma, Series[x].GetMaxXValue);
|
|
end;
|
|
CalculateAxis(mi, ma, Cnt, Delta, Lowest);
|
|
Scale := w / (Delta * Max(1, Cnt-1));
|
|
for x := 0 to Cnt-1 do
|
|
begin
|
|
l := x * Delta;
|
|
P := New(PAxisInfo);
|
|
P^.Py := RcChart.Bottom;
|
|
P^.Px := RcChart.Left + Round(l * Scale);
|
|
P^.Caption := GetLabel((Lowest + l) / FAxisXScale);
|
|
XAxis.Add(P);
|
|
end;
|
|
FXTranslate.MinValue := Lowest;
|
|
FXTranslate.Scale := Scale;
|
|
FXTranslate.Base := RcChart.Left;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TNiceChart.BuildYAxis;
|
|
var
|
|
x, w: Integer;
|
|
mi, ma: Double;
|
|
Cnt: Integer;
|
|
Delta, Lowest, t: Double;
|
|
P: PAxisInfo;
|
|
Scale: Double;
|
|
begin
|
|
if (List.Count = 0)
|
|
then Exit;
|
|
w := RcChart.Bottom - RcChart.Top;
|
|
Cnt := (w div FAxisDefSize) + 1;
|
|
ChartEmpty := True;
|
|
mi := MaxDouble;
|
|
ma := -MaxDouble;
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
if (Series[x].Values.Count > 0) then
|
|
begin
|
|
mi := Min(mi, Series[x].GetMinYValue);
|
|
ma := Max(ma, Series[x].GetMaxYValue);
|
|
ChartEmpty := False;
|
|
end;
|
|
end;
|
|
if ChartEmpty
|
|
then Exit;
|
|
CalculateAxis(mi, ma, Cnt, Delta, Lowest);
|
|
Scale := w / (Delta * Max(1, Cnt-1));
|
|
for x := 0 to Cnt-1 do
|
|
begin
|
|
t := x * Delta;
|
|
P := New(PAxisInfo);
|
|
P^.Value := Lowest + t;
|
|
P^.Py := Round(t * Scale);
|
|
P^.Caption := GetLabel((Lowest + t) / FAxisYScale);
|
|
YAxis.Add(P);
|
|
end;
|
|
FYTranslate.MinValue := Lowest;
|
|
FYTranslate.Scale := Scale;
|
|
end;
|
|
|
|
procedure TNiceChart.AdjustYAxis;
|
|
var
|
|
x: Integer;
|
|
P: PAxisInfo;
|
|
l: Integer;
|
|
begin
|
|
l := RcChart.Left;
|
|
YZero := -1;
|
|
for x := 0 to YAxis.Count-1 do
|
|
begin
|
|
P := PAxisInfo(YAxis[x]);
|
|
P^.Px := l;
|
|
P^.Py := RcChart.Bottom - P^.Py;
|
|
if (P^.Value = 0)
|
|
then YZero := P^.Py;
|
|
end;
|
|
if (YZero = -1)
|
|
then YZero := RcChart.Bottom;
|
|
FYTranslate.Base := RcChart.Bottom;
|
|
end;
|
|
|
|
procedure TNiceChart.DrawXAxis(ACanvas: TCanvas);
|
|
var
|
|
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 + FInnerMargin + FTickLength + FSmallMargin + 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 + FTickLength + SMALL_MARGIN;
|
|
Last := 0;
|
|
for i := 0 to XAxis.Count-1 do
|
|
begin
|
|
P := PAxisInfo(XAxis[i]);
|
|
Str := P^.Caption;
|
|
w := TextWidth(Str);
|
|
l := P^.Px - (w div 2);
|
|
if (Last < l) then
|
|
begin
|
|
TextOut(l, t, Str);
|
|
Last := l + w;
|
|
end;
|
|
MoveTo(P^.Px, P^.Py);
|
|
LineTo(P^.Px, P^.Py + FTickLength + 1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.DrawYAxis(ACanvas: TCanvas);
|
|
var
|
|
l, t, h, w: 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 := FOuterMargin;
|
|
Font.Assign(FNormalFont);
|
|
Font.Style := [fsBold];
|
|
t := RcChart.Bottom - ((h - TextWidth(FAxisYTitle)) div 2);
|
|
RotTextOut(ACanvas, l, t, 90, FAxisYTitle);
|
|
Font.Assign(FNormalFont);
|
|
Pen.Color := clBlack;
|
|
Pen.Width := 1;
|
|
Pen.Style := psSolid;
|
|
l := RcChart.Left - FTickLength - SMALL_MARGIN;
|
|
for i := 0 to YAxis.Count-1 do
|
|
begin
|
|
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 - FTickLength, P^.Py);
|
|
LineTo(P^.Px, P^.Py);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.DrawChart(ACanvas: TCanvas);
|
|
var
|
|
x: Integer;
|
|
begin
|
|
with ACanvas do
|
|
begin
|
|
Brush.Style := bsClear;
|
|
Pen.Style := psSolid;
|
|
Pen.Width := 1;
|
|
MoveTo(RcChart.Left, RcChart.Top);
|
|
LineTo(RcChart.Right, RcChart.Top);
|
|
LineTo(RcChart.Right, RcChart.Bottom);
|
|
end;
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
if (TNiceSeries(List[x]).FKind = skBar)
|
|
then DrawSeries(ACanvas, x);
|
|
end;
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
if (TNiceSeries(List[x]).FKind <> skBar)
|
|
then DrawSeries(ACanvas, x);
|
|
end;
|
|
end;
|
|
|
|
|
|
//-----------------------------------------------------------------------------//
|
|
|
|
procedure MarkerRectangle(ACanvas: TCanvas; X, Y, Size: Integer);
|
|
begin
|
|
ACanvas.Rectangle(X-Size, Y-Size, X+Size, Y+Size);
|
|
end;
|
|
|
|
procedure MarkerCircle(ACanvas: TCanvas; X, Y, Size: Integer);
|
|
begin
|
|
ACanvas.Ellipse(X-Size, Y-Size, X+Size, Y+Size);
|
|
end;
|
|
|
|
procedure MarkerTriangle1(ACanvas: TCanvas; X, Y, Size: Integer);
|
|
begin
|
|
ACanvas.Polygon([Point(x, y-Size), Point(x+Size, y+Size), Point(x-Size, y+Size)]);
|
|
end;
|
|
|
|
procedure MarkerTriangle2(ACanvas: TCanvas; X, Y, Size: Integer);
|
|
begin
|
|
ACanvas.Polygon([Point(x+Size, y-Size), Point(x-Size, y-Size), Point(x, y+Size)]);
|
|
end;
|
|
|
|
procedure MarkerDiamond(ACanvas: TCanvas; X, Y, Size: Integer);
|
|
begin
|
|
ACanvas.Polygon([Point(x, y-Size), Point(x+Size, y), Point(x, y+Size), Point(x-Size, y)]);
|
|
end;
|
|
|
|
const
|
|
Colors1: array [0..13] of TColor = (
|
|
clRed, clBlue, clGreen, clFuchsia, clNavy, clMaroon, clBlack, clOlive,
|
|
clPurple, clTeal, clGray, clLime, clYellow, clAqua
|
|
);
|
|
Colors2: array [0..13] of TColor = (
|
|
$0066C2FF, $005AFADA, $00F4C84D, $00B54DF4, $00669FFF, $00F44D5A,
|
|
$0066E0FF, $0066FFFF, $00F44DAE, $006863FE, $004DF474, $00F4934D,
|
|
clSilver, clGray
|
|
);
|
|
|
|
Markers: array [0..4] of TMarkerProc = (
|
|
MarkerRectangle, MarkerCircle, MarkerTriangle1, MarkerTriangle2,
|
|
MarkerDiamond);
|
|
|
|
|
|
procedure TNiceChart.AutoColors(ACanvas: TCanvas; Index: Integer; Isbar: Boolean);
|
|
var
|
|
cl: TColor;
|
|
Idx: Integer;
|
|
Bmp: TBitmap;
|
|
begin
|
|
if FMonochrome
|
|
then cl := clBlack else
|
|
if FSoftColors
|
|
then cl := Colors2[Index mod 14]
|
|
else cl := Colors1[Index mod 14];
|
|
Marker := Markers[Index mod 5];
|
|
with ACanvas do
|
|
begin
|
|
Pen.Color := cl;
|
|
Brush.Bitmap := nil;
|
|
Brush.Style := bsSolid;
|
|
if IsBar
|
|
then Brush.Color := cl
|
|
else Brush.Color := clWhite;
|
|
if IsBar and FMonochrome then
|
|
begin
|
|
Idx := Index mod 16;
|
|
if not Assigned(Brushes[Idx]) then
|
|
begin
|
|
Bmp := TBitmap.Create;
|
|
Bmp.LoadFromResourceName(hInstance, Format('brush%.2d', [Idx+1]));
|
|
Brushes[Idx] := Bmp;
|
|
end;
|
|
Brush.Bitmap := Brushes[Idx];
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
//-----------------------------------------------------------------------------//
|
|
|
|
procedure TNiceChart.DrawSeries(ACanvas: TCanvas; Index: Integer);
|
|
var
|
|
x: Integer;
|
|
P: PXYInfo;
|
|
l, t, t2: Integer;
|
|
Sr: TNiceSeries;
|
|
Rc: TRect;
|
|
begin
|
|
Sr := TNiceSeries(List[Index]);
|
|
AutoColors(ACanvas, Index, sr.FKind = skBar);
|
|
with ACanvas do
|
|
begin
|
|
if (sr.FKind = skBar) then
|
|
begin
|
|
ClipToRect(ACanvas, RcChart, true);
|
|
try
|
|
Pen.Width := 1;
|
|
for x := 0 to Sr.Values.Count-1 do
|
|
begin
|
|
P := PXYInfo(Sr.Values[x]);
|
|
Rectangle(P^.Rc);
|
|
end;
|
|
finally
|
|
ClipToRect(ACanvas, RcChart, false);
|
|
end;
|
|
end else
|
|
begin
|
|
ClipToRect(ACanvas, RcChart, true);
|
|
try
|
|
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]);
|
|
if (x = 0)
|
|
then MoveTo(P^.Px, P^.Py)
|
|
else LineTo(P^.Px, P^.Py);
|
|
end;
|
|
end else
|
|
if (sr.FKind = skSmooth) then
|
|
begin
|
|
Pen.Width := sr.LineWidth;
|
|
sr.Spline.Draw(ACanvas);
|
|
end;
|
|
finally
|
|
ClipToRect(ACanvas, RcChart, false);
|
|
end;
|
|
Pen.Width := 1;
|
|
for x := 0 to Sr.Values.Count-1 do
|
|
begin
|
|
P := PXYInfo(Sr.Values[x]);
|
|
if PtInRect(RcChart, Point(P^.Px, P^.Py)) then
|
|
Marker(ACanvas, P^.Px, P^.Py, MarkSize);
|
|
end;
|
|
end;
|
|
if FShowLegend then
|
|
begin
|
|
l := RcLegend.Left + FInnerMargin;
|
|
t := RcLegend.Top + Sr.Top;
|
|
if (sr.FKind = skBar) then
|
|
begin
|
|
Rc := Rect(l, t, l + FLegendItemSize, t + FLegendItemSize);
|
|
InflateRect(Rc, -2, -2);
|
|
Rectangle(Rc);
|
|
end else
|
|
begin
|
|
Pen.Width := sr.LineWidth;
|
|
t2 := t + (FLegendItemSize div 2);
|
|
MoveTo(l, t2);
|
|
LineTo(l + FLegendItemSize, t2);
|
|
Pen.Width := 1;
|
|
Marker(ACanvas, l + (FLegendItemSize div 2), t2, MarkSize);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.CalculateSeries;
|
|
var
|
|
x, y: Integer;
|
|
Values: TList;
|
|
P: PXYInfo;
|
|
S: TBSpline;
|
|
Vertex: TVertex;
|
|
sr: TNiceSeries;
|
|
bw, rw, bi, dx, l: Integer;
|
|
begin
|
|
if (List.Count = 0) or ChartEmpty
|
|
then Exit;
|
|
bi := 0;
|
|
bw := 0;
|
|
if (BarCount > 0)
|
|
then bw := Round(BarWidth / (BarCount + 1));
|
|
for x := 0 to List.Count-1 do
|
|
begin
|
|
sr := TNiceSeries(List[x]);
|
|
s := sr.Spline;
|
|
s.Clear;
|
|
Values := sr.Values;
|
|
case sr.FKind of
|
|
skBar:
|
|
begin
|
|
dx := Round(-(BarWidth / 2) + (bw / 2) + (bi * bw) + (bw * 0.1));
|
|
rw := Round(bw * 0.8);
|
|
for y := 0 to Values.Count-1 do
|
|
begin
|
|
P := PXYInfo(Values[y]);
|
|
ChartToClient(P^.X, P^.Y, P^.Px, P^.Py);
|
|
l := P^.Px + dx;
|
|
if (P^.Y < 0)
|
|
then P^.Rc := Rect(l, YZero, l + rw, P^.Py)
|
|
else P^.Rc := Rect(l, P^.Py, l + rw, YZero);
|
|
end;
|
|
Inc(bi);
|
|
end;
|
|
skLine:
|
|
begin
|
|
for y := 0 to Values.Count-1 do
|
|
begin
|
|
P := PXYInfo(Values[y]);
|
|
ChartToClient(P^.X, P^.Y, P^.Px, P^.Py);
|
|
P^.Rc := Rect(P^.Px-MarkSize, P^.Py-MarkSize, P^.Px+MarkSize, P^.Py+MarkSize);
|
|
end;
|
|
end;
|
|
skSmooth:
|
|
begin
|
|
for y := 0 to Values.Count-1 do
|
|
begin
|
|
P := PXYInfo(Values[y]);
|
|
ChartToClient(P^.X, P^.Y, P^.Px, P^.Py);
|
|
P^.Rc := Rect(P^.Px-MarkSize, P^.Py-MarkSize, P^.Px+MarkSize, P^.Py+MarkSize);
|
|
Vertex.X := P^.Px;
|
|
Vertex.Y := P^.Py;
|
|
s.AddPoint(Vertex);
|
|
end;
|
|
s.Interpolated := True;
|
|
s.Fragments := s.NumberOfPoints * 20;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.ChartToClient(const AX, AY: Double; var X, Y: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FAxisXOnePerValue then
|
|
begin
|
|
for i := 0 to XAxis.Count-1 do
|
|
begin
|
|
if (AX = PAxisInfo(XAxis[i])^.Value) then
|
|
begin
|
|
X := PAxisInfo(XAxis[i])^.Px;
|
|
Break;
|
|
end;
|
|
end;
|
|
end else
|
|
X := FXTranslate.Base + Round((AX - FXTranslate.MinValue) * FXTranslate.Scale);
|
|
Y := FYTranslate.Base - Round((AY - FYTranslate.MinValue) * FYTranslate.Scale);
|
|
end;
|
|
|
|
function TNiceChart.ClientToChart(const X, Y: Integer; var AX, AY: Double): Boolean;
|
|
var
|
|
i: Integer;
|
|
n, d: Integer;
|
|
begin
|
|
Result := PtInRect(RcChart, Point(X, Y));
|
|
if Result then
|
|
begin
|
|
if FAxisXOnePerValue then
|
|
begin
|
|
n := MaxInt;
|
|
for i := 0 to XAxis.Count-1 do
|
|
begin
|
|
d := Abs(X - PAxisInfo(XAxis[i])^.Px);
|
|
if (d < n) then
|
|
begin
|
|
AX := PAxisInfo(XAxis[i])^.Value;
|
|
n := d;
|
|
end;
|
|
end;
|
|
end else
|
|
AX := FXTranslate.MinValue + ((X - FXTranslate.Base) / FXTranslate.Scale);
|
|
AY := FYTranslate.MinValue + ((FYTranslate.Base - Y) / FYTranslate.Scale);
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.CreateHandle;
|
|
begin
|
|
inherited;
|
|
Changed;
|
|
end;
|
|
|
|
function TNiceChart.CreateBitmap(AWidth, AHeight: Integer): TBitmap;
|
|
var
|
|
w, h: Integer;
|
|
begin
|
|
Calculate(AWidth, AHeight);
|
|
if (RcLegend.Bottom > (AHeight - FOuterMargin))
|
|
then h := RcLegend.Bottom + FOuterMargin
|
|
else h := AHeight;
|
|
if ((RcChart.Right - RcChart.Left) < (RcChart.Bottom - RcChart.Top))
|
|
then w := AWidth + ((RcChart.Bottom - RcChart.Top) - (RCChart.Right - RcChart.Left))
|
|
else w := AWidth;
|
|
if (AWidth <> w) or (AHeight <> h)
|
|
then Calculate(w, h);
|
|
Result := TBitmap.Create;
|
|
Result.Width := w;
|
|
Result.Height := h;
|
|
InternalPaint(Result.Canvas);
|
|
Calculate(ClientWidth, ClientHeight);
|
|
end;
|
|
|
|
procedure TNiceChart.CopyToClipboardAsBitmap;
|
|
var
|
|
bmp: TBitmap;
|
|
begin
|
|
bmp := CreateBitmap(ClientWidth, ClientHeight);
|
|
try
|
|
Clipboard.Assign(bmp);
|
|
finally
|
|
bmp.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TNiceChart.ClipToRect(ACanvas: TCanvas; const ARect: TRect; AEnable: Boolean);
|
|
begin
|
|
{$IFDEF FPC}
|
|
if AEnable then
|
|
ACanvas.ClipRect := ARect;
|
|
ACanvas.Clipping := AEnable;
|
|
{$ELSE}
|
|
if AEnable then
|
|
begin
|
|
if FClipRgn <> 0 then
|
|
DeleteObject(FClipRgn);
|
|
FClipRgn := CreateRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
|
|
SelectClipRgn(ACanvas.Handle, FClipRgn);
|
|
end else
|
|
begin
|
|
SelectClipRgn(ACanvas.Handle, HRGN(nil));
|
|
DeleteObject(FClipRgn);
|
|
FClipRgn := 0;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFNDEF FPC}
|
|
function TNiceChart.CreateMetafile: TMetafile;
|
|
const
|
|
InitWidth = 800;
|
|
InitHeight = 600;
|
|
var
|
|
mc: TMetafileCanvas;
|
|
AWidth, AHeight: Integer;
|
|
begin
|
|
AWidth := InitWidth;
|
|
AHeight := InitHeight;
|
|
Calculate(AWidth, AHeight);
|
|
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)
|
|
then Calculate(AWidth, AHeight);
|
|
Result := TMetafile.Create;
|
|
Result.Width := AWidth;
|
|
Result.Height := AHeight;
|
|
mc := TMetafileCanvas.Create(Result, 0);
|
|
InternalPaint(mc);
|
|
mc.Free;
|
|
Calculate(ClientWidth, ClientHeight);
|
|
end;
|
|
|
|
procedure TNiceChart.CopyToClipboard;
|
|
var
|
|
Wmf: TMetafile;
|
|
begin
|
|
Wmf := CreateMetafile;
|
|
Clipboard.Assign(Wmf);
|
|
Wmf.Free;
|
|
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.
|
|
|