TAChart: Add demo for TUserDrawnSeries

git-svn-id: trunk@57283 -
This commit is contained in:
wp 2018-02-11 20:13:07 +00:00
parent cb73fccb63
commit 90dce10041
5 changed files with 369 additions and 0 deletions

4
.gitattributes vendored
View File

@ -4933,6 +4933,10 @@ components/tachart/demo/tools/main.lfm svneol=native#text/plain
components/tachart/demo/tools/main.pas svneol=native#text/pascal
components/tachart/demo/tools/toolsdemo.lpi svneol=native#text/plain
components/tachart/demo/tools/toolsdemo.lpr svneol=native#text/pascal
components/tachart/demo/userdrawn_series/main.lfm svneol=native#text/plain
components/tachart/demo/userdrawn_series/main.pas svneol=native#text/plain
components/tachart/demo/userdrawn_series/userdrawn_demo.lpi svneol=native#text/plain
components/tachart/demo/userdrawn_series/userdrawn_demo.lpr svneol=native#text/plain
components/tachart/demo/wmf/main.lfm svneol=native#text/plain
components/tachart/demo/wmf/main.pas svneol=native#text/pascal
components/tachart/demo/wmf/wmfdemo.lpi svneol=native#text/plain

View File

@ -0,0 +1,89 @@
object MainForm: TMainForm
Left = 303
Height = 420
Top = 127
Width = 595
Caption = 'Userdrawn series demo'
ClientHeight = 420
ClientWidth = 595
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '1.9.0.0'
object Chart: TChart
Left = 0
Height = 386
Top = 0
Width = 595
AxisList = <
item
Grid.Visible = False
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelFont.Orientation = 900
Title.LabelBrush.Style = bsClear
end
item
Grid.Visible = False
Alignment = calBottom
Marks.LabelBrush.Style = bsClear
Minors = <>
Title.LabelBrush.Style = bsClear
end>
BackColor = clWhite
Foot.Brush.Color = clBtnFace
Foot.Font.Color = clBlue
Foot.Text.Strings = (
'Drag the horizontal line up and down.'
)
Foot.Visible = True
Margins.Left = 8
Margins.Top = 8
Margins.Right = 8
Margins.Bottom = 8
Title.Brush.Color = clBtnFace
Title.Font.Color = clBlue
Title.Text.Strings = (
'TAChart'
)
Toolset = ChartToolset
Align = alClient
object ReferenceLine: TConstantLine
Pen.Color = clBlue
Pen.Style = psDash
Position = 4
end
object Series: TUserDrawnSeries
OnDraw = SeriesDraw
OnGetBounds = SeriesGetBounds
end
end
object Panel: TPanel
Left = 0
Height = 34
Top = 386
Width = 595
Align = alBottom
BevelOuter = bvNone
ClientHeight = 34
ClientWidth = 595
TabOrder = 1
object cbShowDataPoints: TCheckBox
Left = 11
Height = 19
Top = 8
Width = 111
Caption = 'Show data points'
OnChange = cbShowDataPointsChange
TabOrder = 0
end
end
object ChartToolset: TChartToolset
left = 173
top = 119
object DataPointDragTool: TDataPointDragTool
Shift = [ssLeft]
AffectedSeries = '0'
ActiveCursor = crSizeNS
end
end
end

View File

@ -0,0 +1,173 @@
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
TAGraph, TASeries, TAChartUtils, TATools, Types;
type
{ TMainForm }
TMainForm = class(TForm)
Chart: TChart;
ReferenceLine: TConstantLine;
Series: TUserDrawnSeries;
ChartToolset: TChartToolset;
DataPointDragTool: TDataPointDragTool;
cbShowDataPoints: TCheckBox;
Panel: TPanel;
procedure SeriesDraw(ACanvas: TCanvas; const ARect: TRect);
procedure SeriesGetBounds(var ABounds: TDoubleRect);
procedure cbShowDataPointsChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
Pen: TPen;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
uses
Math, TAGeometry;
const
COLOR_ABOVE = clRed;
COLOR_BELOW = clGreen;
RADIUS = 4;
type
TDataRec = record
x, y: Double;
end;
var
Data: array of TDataRec;
Extent: TDoubleRect;
function Intersect(p1, p2: TPoint; y: Integer): Integer;
begin
if p1.x = p2.x then
Result := p1.x
else
Result := round((p2.x - p1.x) / (p2.y - p1.y) * (y - p1.y) + p1.x);
end;
{ TMainForm }
procedure TMainForm.SeriesDraw(ACanvas: TCanvas;
const ARect: TRect);
procedure DrawCircle(p: TPoint; AColor: TColor; R: Integer);
begin
Chart.Drawer.SetBrushParams(bsSolid, AColor);
Chart.Drawer.Ellipse(P.x - R, P.y - R, P.x + R, P.y + R);
end;
function GetColor(y, yref: Integer): TColor;
begin
if y > yref then Result := COLOR_BELOW else Result := COLOR_ABOVE;
end;
var
i: Integer;
gp: TDoublePoint;
p1, p2, p3: TPoint;
yref: Integer;
x: Integer;
showDataPoints: Boolean;
begin
showDataPoints := cbShowDataPoints.Checked;
Chart.Drawer.Pen := Pen;
yref := Chart.YGraphToImage(ReferenceLine.Position);
i := 0;
gp := DoublePoint(Data[i].X, Data[i].Y);
p1 := Chart.GraphToImage(gp);
if showDataPoints then begin
Chart.Drawer.SetPenParams(psSolid, GetColor(p1.y, yref));
DrawCircle(p2, GetColor(p2.y, yref), RADIUS);
end;
for i:=0 to High(Data)-1 do begin
gp := DoublePoint(Data[i].X, Data[i].Y);
p2 := Chart.GraphToImage(gp);
if (p2.y - yref) * (p1.y - yref) < 0 then begin
p3 := Point(Intersect(p1, p2, yref), yref);
Chart.Drawer.SetPenParams(psSolid, GetColor(p1.y, yref));
Chart.Drawer.Line(p1, p3);
Chart.Drawer.SetPenParams(psSolid, GetColor(p2.y, yref));
Chart.Drawer.Line(p3, p2);
end else begin
Chart.Drawer.SetPenParams(psSolid, GetColor(p2.y, yref));
Chart.Drawer.Line(p1, p2);
end;
if showDataPoints then
DrawCircle(p2, GetColor(p2.y, yref), RADIUS);
p1 := p2;
end;
end;
procedure TMainForm.SeriesGetBounds(var ABounds: TDoubleRect);
begin
ABounds := Extent;
end;
procedure TMainForm.cbShowDataPointsChange(Sender: TObject);
begin
Chart.Invalidate;
end;
procedure TMainForm.FormCreate(Sender: TObject);
const
N = 20;
XMIN = -10;
XMAX = +10;
var
i: Integer;
x, y: Double;
begin
Chart.DoubleBuffered := true;
Pen := TPen.Create;
Pen.Width := 3;
SetLength(Data, N);
for i:=0 to N-1 do begin
Data[i].x := XMIN + (XMAX - XMIN) / (N - 1) * i;
// Data[i].y := sin(Data[i].x);
Data[i].y := (Random * 2 - 1) * 100;
end;
Extent.a.x := Data[0].x;
Extent.a.y := Data[0].y;
Extent.b.x := Data[0].x;
Extent.b.y := Data[0].y;
for i:= 1 to High(Data) do begin
Extent.a.x := Min(Extent.a.x, Data[i].x);
Extent.b.x := Max(Extent.b.x, Data[i].x);
Extent.a.y := Min(Extent.a.y, Data[i].y);
Extent.b.y := Max(Extent.b.y, Data[i].y);
end;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
Pen.Free;
end;
end.

View File

@ -0,0 +1,81 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="userdrawn_demo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0"/>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="TAChartLazarusPkg"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="userdrawn_demo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="userdrawn_demo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,22 @@
program userdrawn_demo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, main, tachartlazaruspkg
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Scaled := True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.