mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-31 03:12:32 +02:00
: TAChart: Add TStateSeries as new series type and demo project for it.
This commit is contained in:
wp_xyz
parent
4162ac50d8
commit
fa64a17035
@ -58,6 +58,7 @@
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
<UseExternalDbgSyms Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
|
||||
200
components/tachart/demo/stateseries/main.lfm
Normal file
200
components/tachart/demo/stateseries/main.lfm
Normal file
@ -0,0 +1,200 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 314
|
||||
Height = 292
|
||||
Top = 130
|
||||
Width = 690
|
||||
Caption = 'StateSeries Demo'
|
||||
ClientHeight = 292
|
||||
ClientWidth = 690
|
||||
LCLVersion = '4.99.0.0'
|
||||
OnCreate = FormCreate
|
||||
object Chart: TChart
|
||||
Left = 6
|
||||
Height = 221
|
||||
Top = 6
|
||||
Width = 678
|
||||
AxisList = <
|
||||
item
|
||||
Grid.Color = clSilver
|
||||
Marks.Alignment = taCenter
|
||||
Marks.Distance = 8
|
||||
Marks.LabelBrush.Style = bsClear
|
||||
Minors = <>
|
||||
Title.LabelFont.Orientation = 900
|
||||
Title.LabelBrush.Style = bsClear
|
||||
end
|
||||
item
|
||||
Grid.Color = clSilver
|
||||
Alignment = calBottom
|
||||
Marks.Alignment = taCenter
|
||||
Marks.Format = '%2:s'
|
||||
Marks.LabelBrush.Style = bsClear
|
||||
Marks.Source = DateTimeIntervalChartSource
|
||||
Marks.Style = smsLabel
|
||||
Minors = <>
|
||||
Title.LabelBrush.Style = bsClear
|
||||
OnGetMarkText = Chart1AxisList1GetMarkText
|
||||
end>
|
||||
Title.Text.Strings = (
|
||||
'TAChart'
|
||||
)
|
||||
Toolset = ChartToolset
|
||||
Align = alClient
|
||||
BorderSpacing.Around = 6
|
||||
object MachineA_Series: TStateSeries
|
||||
Title = 'Machine A'
|
||||
Brush.Color = clRed
|
||||
end
|
||||
object MachineB_Series: TStateSeries
|
||||
Title = 'Machine B'
|
||||
Brush.Color = clRed
|
||||
end
|
||||
object MachineC_Series: TStateSeries
|
||||
Title = 'Machine C'
|
||||
Brush.Color = clRed
|
||||
end
|
||||
end
|
||||
object FlowPanel1: TFlowPanel
|
||||
Left = 6
|
||||
Height = 44
|
||||
Top = 242
|
||||
Width = 678
|
||||
Align = alBottom
|
||||
AutoSize = True
|
||||
BevelOuter = bvNone
|
||||
BorderSpacing.Around = 6
|
||||
ControlList = <
|
||||
item
|
||||
Control = cbSeriesMarks
|
||||
WrapAfter = waAuto
|
||||
Index = 0
|
||||
end
|
||||
item
|
||||
Control = cbShowPopupHints
|
||||
WrapAfter = waAuto
|
||||
Index = 1
|
||||
end
|
||||
item
|
||||
Control = cbRotated
|
||||
WrapAfter = waForce
|
||||
Index = 2
|
||||
end
|
||||
item
|
||||
Control = Panel1
|
||||
WrapAfter = waAuto
|
||||
Index = 3
|
||||
end>
|
||||
FlowLayout = tlTop
|
||||
FlowStyle = fsLeftRightTopBottom
|
||||
TabOrder = 1
|
||||
object cbSeriesMarks: TCheckBox
|
||||
Left = 0
|
||||
Height = 19
|
||||
Top = 0
|
||||
Width = 114
|
||||
Anchors = []
|
||||
BorderSpacing.Right = 16
|
||||
Caption = 'Show series marks'
|
||||
Checked = True
|
||||
State = cbChecked
|
||||
TabOrder = 0
|
||||
OnChange = cbSeriesMarksChange
|
||||
end
|
||||
object cbShowPopupHints: TCheckBox
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
Left = 130
|
||||
Height = 19
|
||||
Top = 0
|
||||
Width = 114
|
||||
Anchors = []
|
||||
BorderSpacing.Right = 16
|
||||
Caption = 'Show popup hints'
|
||||
TabOrder = 1
|
||||
OnChange = cbShowPopupHintsChange
|
||||
end
|
||||
object cbRotated: TCheckBox
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 260
|
||||
Height = 19
|
||||
Top = 0
|
||||
Width = 59
|
||||
Anchors = []
|
||||
BorderSpacing.Right = 16
|
||||
Caption = 'Rotated'
|
||||
TabOrder = 2
|
||||
OnChange = cbRotatedChange
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 25
|
||||
Top = 19
|
||||
Width = 226
|
||||
Anchors = []
|
||||
AutoSize = True
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 25
|
||||
ClientWidth = 226
|
||||
TabOrder = 3
|
||||
object Label1: TLabel
|
||||
AnchorSideLeft.Control = Panel1
|
||||
AnchorSideTop.Control = TrackBar1
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 0
|
||||
Height = 15
|
||||
Top = 5
|
||||
Width = 54
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'Bar height'
|
||||
end
|
||||
object TrackBar1: TTrackBar
|
||||
AnchorSideLeft.Control = Label1
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = Panel1
|
||||
Left = 62
|
||||
Height = 25
|
||||
Top = 0
|
||||
Width = 164
|
||||
Frequency = 10
|
||||
Max = 100
|
||||
Position = 70
|
||||
OnChange = TrackBar1Change
|
||||
TabOrder = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
object Bevel1: TBevel
|
||||
Left = 0
|
||||
Height = 3
|
||||
Top = 233
|
||||
Width = 690
|
||||
Align = alBottom
|
||||
Shape = bsBottomLine
|
||||
end
|
||||
object DateTimeIntervalChartSource: TDateTimeIntervalChartSource
|
||||
Params.MaxLength = 100
|
||||
Left = 134
|
||||
Top = 46
|
||||
end
|
||||
object MachineLabelsChartSource: TListChartSource
|
||||
Left = 312
|
||||
Top = 44
|
||||
end
|
||||
object ChartToolset: TChartToolset
|
||||
Left = 453
|
||||
Top = 46
|
||||
object DataPointHintTool: TDataPointHintTool
|
||||
Enabled = False
|
||||
end
|
||||
object ChartToolsetZoomDragTool1: TZoomDragTool
|
||||
Shift = [ssLeft]
|
||||
Brush.Style = bsClear
|
||||
end
|
||||
object ChartToolsetPanDragTool1: TPanDragTool
|
||||
Shift = [ssRight]
|
||||
end
|
||||
object ChartToolsetDataPointDragTool1: TDataPointDragTool
|
||||
Shift = [ssCtrl, ssLeft]
|
||||
KeepDistance = True
|
||||
end
|
||||
end
|
||||
end
|
||||
280
components/tachart/demo/stateseries/main.pas
Normal file
280
components/tachart/demo/stateseries/main.pas
Normal file
@ -0,0 +1,280 @@
|
||||
unit Main;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
ComCtrls, SysUtils, Classes,
|
||||
Graphics, Forms, Controls, StdCtrls, ExtCtrls, Dialogs, LCLVersion,
|
||||
TAGraph, TAIntervalSources, TACustomSeries, TASeries, TASources, TAChartUtils,
|
||||
TATextElements, TATools, TAStateSeries, TAChartAxisUtils;
|
||||
|
||||
type
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
TMainForm = class(TForm)
|
||||
Bevel1: TBevel;
|
||||
Chart: TChart;
|
||||
FlowPanel1: TFlowPanel;
|
||||
Label1: TLabel;
|
||||
MachineA_Series: TStateSeries;
|
||||
MachineB_Series: TStateSeries;
|
||||
MachineC_Series: TStateSeries;
|
||||
ChartToolset: TChartToolset;
|
||||
cbSeriesMarks: TCheckBox;
|
||||
cbShowPopupHints: TCheckBox;
|
||||
ChartToolsetDataPointDragTool1: TDataPointDragTool;
|
||||
ChartToolsetPanDragTool1: TPanDragTool;
|
||||
ChartToolsetZoomDragTool1: TZoomDragTool;
|
||||
cbRotated: TCheckBox;
|
||||
DataPointHintTool: TDataPointHintTool;
|
||||
DateTimeIntervalChartSource: TDateTimeIntervalChartSource;
|
||||
MachineLabelsChartSource: TListChartSource;
|
||||
Panel1: TPanel;
|
||||
TrackBar1: TTrackBar;
|
||||
procedure cbRotatedChange(Sender: TObject);
|
||||
procedure cbSeriesMarksChange(Sender: TObject);
|
||||
procedure cbShowPopupHintsChange(Sender: TObject);
|
||||
procedure Chart1AxisList1GetMarkText(Sender: TObject; var AText: String;
|
||||
AMark: Double);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure TrackBar1Change(Sender: TObject);
|
||||
private
|
||||
procedure GetMarkTextHandler(ASeries: TChartSeries;
|
||||
APointIndex, {%H-}AXIndex, {%H-}AYIndex: Integer; var AFormattedMark: String);
|
||||
procedure PrepareMarks(ASeries: TStateSeries);
|
||||
procedure SetupNormalAxes;
|
||||
procedure SetupRotatedAxes;
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
MainForm: TMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
const
|
||||
clRepair = $4040FF; // red
|
||||
clProduction = $00C800; // green
|
||||
clDevelopment = $FF8080; // blue
|
||||
clMaintainance = clYellow; // yellow
|
||||
|
||||
idxMachineA = 0;
|
||||
idxMachineB = 1;
|
||||
idxMachineC = 2;
|
||||
|
||||
procedure TMainForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FormatSettings.Decimalseparator := '.';
|
||||
|
||||
// Provide y axis labels
|
||||
MachineLabelsChartSource.Add(idxMachineA, idxMachineA, 'Machine'+LineEnding+'A');
|
||||
MachineLabelsChartSource.Add(idxMachineB, idxMachineB, 'Machine'+LineEnding+'B');
|
||||
MachineLabelsChartSource.Add(idxMachineC, idxMachineC, 'Machine'+LineEnding+'C');
|
||||
SetupNormalAxes;
|
||||
|
||||
DateTimeIntervalChartSource.DateTimeStepFormat.HourFormat := 'hh:nn';
|
||||
DateTimeIntervalChartSource.SuppressPrevUnit := false;
|
||||
|
||||
// Create the series and add their values
|
||||
MachineA_Series.AddXY(EncodeTime( 5, 0, 0, 0), EncodeTime( 9, 0, 0, 0), idxMachineA, 'Production', clProduction);
|
||||
MachineA_Series.AddXY(EncodeTime(10,30, 0, 0), EncodeTime(12,10, 0, 0), idxMachineA, 'Repair', clRepair);
|
||||
MachineA_Series.AddXY(EncodeTime(12,30, 0, 0), EncodeTime(18, 0, 0, 0), idxMachineA, 'Development', clDevelopment);
|
||||
MachineA_Series.AddXY(EncodeTime(20, 0, 0, 0), EncodeTime(23, 0, 0, 0), idxMachineA, 'Maintainance', clMaintainance);
|
||||
PrepareMarks(MachineA_Series);
|
||||
|
||||
MachineB_Series.AddXY(EncodeTime( 0, 0, 0, 0), EncodeTime( 8, 0, 0, 0), idxMachineB, 'Repair', clRepair);
|
||||
MachineB_Series.AddXY(EncodeTime( 9, 0, 0, 0), EncodeTime(12,55, 0, 0), idxMachineB, 'Production', clProduction);
|
||||
MachineB_Series.AddXY(EncodeTime(13, 0, 0, 0), EncodeTime(17,25, 0, 0), idxMachineB, 'Production', clProduction);
|
||||
MachineB_Series.AddXY(EncodeTime(19, 0, 0, 0), EncodeTime(21,42, 0, 0), idxMachineB, 'Development', clDevelopment);
|
||||
PrepareMarks(MachineB_Series);
|
||||
|
||||
MachineC_Series.AddXY(EncodeTime( 0, 0, 0, 0), EncodeTime( 6, 0, 0, 0), idxMachineC, 'Production', clProduction);
|
||||
MachineC_Series.AddXY(EncodeTime( 6,10, 0, 0), EncodeTime( 8,45, 0, 0), idxMachineC, 'Production', clProduction);
|
||||
MachineC_Series.AddXY(EncodeTime( 9, 0, 0, 0), EncodeTime(12, 0, 0, 0), idxMachineC, 'Production', clProduction);
|
||||
MachineC_Series.AddXY(EncodeTime(13, 0, 0, 0), EncodeTime(18,55, 0, 0), idxMachineC, 'Production', clProduction);
|
||||
MachineC_Series.AddXY(EncodeTime(19, 0, 0, 0), EncodeTime(23,50, 0, 0), idxMachineC, 'Maintainance', clMaintainance);
|
||||
PrepareMarks(MachineC_Series);
|
||||
end;
|
||||
|
||||
procedure TMainForm.TrackBar1Change(Sender: TObject);
|
||||
begin
|
||||
MachineA_Series.BarHeightPercent := Trackbar1.Position;
|
||||
MachineB_Series.BarHeightPercent := Trackbar1.Position;
|
||||
MachineC_Series.BarHeightPercent := Trackbar1.Position;
|
||||
end;
|
||||
|
||||
// Show/hide series marks
|
||||
procedure TMainForm.cbSeriesMarksChange(Sender: TObject);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to Chart.SeriesCount-1 do
|
||||
if Chart.Series[i] is TStateSeries then
|
||||
with TStateSeries(Chart.Series[i]) do
|
||||
if cbSeriesMarks.Checked then
|
||||
Marks.Style := smsLabel
|
||||
else
|
||||
Marks.Style := smsNone;
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetupRotatedAxes;
|
||||
begin
|
||||
// Bottom axis marks
|
||||
Chart.BottomAxis.Marks.Source := MachineLabelsChartSource;
|
||||
Chart.BottomAxis.Marks.Style := smsLabel;
|
||||
Chart.BottomAxis.OnGetMarkText := nil;
|
||||
Chart.BottomAxis.TickLength := 0;
|
||||
|
||||
// Left axis marks
|
||||
Chart.LeftAxis.Marks.Source := DateTimeIntervalChartSource;
|
||||
Chart.LeftAxis.Marks.Style := smsLabel;
|
||||
Chart.LeftAxis.OnGetMarkText := @Chart1AxisList1GetMarkText;
|
||||
Chart.LeftAxis.TickLength := 4;
|
||||
|
||||
// Nicer grid for the x axis
|
||||
Chart.BottomAxis.Grid.Visible := false;
|
||||
Chart.LeftAxis.Grid.Visible := true;
|
||||
if Chart.BottomAxis.Minors.Count = 0 then
|
||||
with Chart.BottomAxis.Minors.Add do
|
||||
begin
|
||||
Intervals.Count := 1;
|
||||
Grid.Color := clSilver;
|
||||
Grid.Style := psSolid;
|
||||
end;
|
||||
Chart.BottomAxis.Minors[0].Visible := true;
|
||||
if Chart.LeftAxis.Minors.Count > 0 then
|
||||
Chart.LeftAxis.Minors[0].Visible := false;
|
||||
|
||||
// Show a full day on the y axis
|
||||
Chart.LeftAxis.Range.Max := 1.0;
|
||||
Chart.LeftAxis.Range.Min := 0.0;
|
||||
Chart.LeftAxis.Range.UseMax := true;
|
||||
Chart.LeftAxis.Range.UseMin := true;
|
||||
Chart.BottomAxis.Range.UseMin := false;
|
||||
Chart.BottomAxis.Range.UseMax := false;
|
||||
|
||||
// Restore left axis direction
|
||||
Chart.LeftAxis.Inverted := false;
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetupNormalAxes;
|
||||
begin
|
||||
// Left axis marks
|
||||
Chart.LeftAxis.Marks.Source := MachineLabelsChartSource;
|
||||
Chart.LeftAxis.Marks.Style := smsLabel;
|
||||
Chart.LeftAxis.OnGetMarkText := nil;
|
||||
Chart.LeftAxis.TickLength := 0;
|
||||
|
||||
// Bottom axis marks
|
||||
Chart.BottomAxis.Marks.Source := DateTimeIntervalChartSource;
|
||||
Chart.BottomAxis.Marks.Style := smsLabel;
|
||||
Chart.BottomAxis.OnGetMarkText := @Chart1AxisList1GetMarkText;
|
||||
Chart.BottomAxis.TickLength := 4;
|
||||
|
||||
// Nicer grid for the y axis
|
||||
Chart.LeftAxis.Grid.Visible := false;
|
||||
Chart.BottomAxis.Grid.Visible := true;
|
||||
if Chart.LeftAxis.Minors.Count = 0 then
|
||||
with Chart.LeftAxis.Minors.Add do
|
||||
begin
|
||||
Intervals.Count := 1;
|
||||
Grid.Color := clSilver;
|
||||
Grid.Style := psSolid;
|
||||
end;
|
||||
Chart.LeftAxis.Minors[0].Visible := true;
|
||||
if Chart.BottomAxis.Minors.Count > 0 then
|
||||
Chart.BottomAxis.Minors[0].Visible := false;
|
||||
|
||||
// Show a full day on the x axis
|
||||
Chart.BottomAxis.Range.Max := 1.0;
|
||||
Chart.BottomAxis.Range.Min := 0.0;
|
||||
Chart.BottomAxis.Range.UseMax := true;
|
||||
Chart.BottomAxis.Range.UseMin := true;
|
||||
Chart.LeftAxis.Range.UseMin := false;
|
||||
Chart.LeftAxis.Range.UseMax := false;
|
||||
|
||||
// For top-to-bottom order of the machines (or use negative idxMachineXXXX values)
|
||||
Chart.LeftAxis.Inverted := true;
|
||||
Chart.BottomAxis.Inverted := false;
|
||||
end;
|
||||
|
||||
procedure TMainForm.cbRotatedChange(Sender: TObject);
|
||||
var
|
||||
w, h, i: Integer;
|
||||
begin
|
||||
w := Width;
|
||||
h := Height;
|
||||
SetBounds(Left, Top, h, w);
|
||||
for i := 0 to Chart.SeriesCount-1 do
|
||||
if Chart.Series[i] is TStateSeries then
|
||||
with TStateSeries(Chart.Series[i]) do
|
||||
if cbRotated.Checked then
|
||||
begin
|
||||
AxisIndexX := 0;
|
||||
AxisIndexY := 1;
|
||||
end else
|
||||
begin
|
||||
AxisIndexX := 1;
|
||||
AxisIndexY := 0;
|
||||
end;
|
||||
|
||||
if cbRotated.Checked then
|
||||
SetupRotatedAxes
|
||||
else
|
||||
SetupNormalAxes;
|
||||
end;
|
||||
|
||||
// Show/hide mouse-over popup hints
|
||||
procedure TMainForm.cbShowPopupHintsChange(Sender: TObject);
|
||||
begin
|
||||
DatapointHintTool.Enabled := cbShowPopupHints.Checked;
|
||||
end;
|
||||
|
||||
// Display the last time tick on the x axis as '24:00' rather than '0:00'
|
||||
procedure TMainForm.Chart1AxisList1GetMarkText(Sender: TObject; var AText: String;
|
||||
AMark: Double);
|
||||
begin
|
||||
if AMark = 1.0 then AText := '24:00';
|
||||
end;
|
||||
|
||||
// Compose the label text from the Label value and the duration of each
|
||||
// data point.
|
||||
procedure TMainForm.GetMarkTextHandler(ASeries: TChartSeries;
|
||||
APointIndex, AXIndex, AYIndex: Integer; var AFormattedMark: String);
|
||||
var
|
||||
txt: String;
|
||||
t1, t2: TDateTime;
|
||||
begin
|
||||
with ASeries.Source[APointIndex]^ do
|
||||
begin
|
||||
txt := Text;
|
||||
t1 := GetX(0);
|
||||
t2 := GetX(1);
|
||||
end;
|
||||
AFormattedMark := Format('%s'+LineEnding+'%s', [txt, FormatDateTime('[hh]:nn', t2-t1, [fdoInterval])]);
|
||||
end;
|
||||
|
||||
// Prepare the marks for the series and for the popup hints:
|
||||
// no border, no background, centered, user-defined text (see GetMarkTextHandler)
|
||||
procedure TMainForm.PrepareMarks(ASeries: TStateSeries);
|
||||
begin
|
||||
ASeries.Marks.Style := smsLabel;
|
||||
ASeries.Marks.Frame.Visible := false;
|
||||
ASeries.Marks.LabelBrush.Style := bsClear;
|
||||
ASeries.Marks.LinkPen.Visible := false;
|
||||
ASeries.Marks.Distance := 0;
|
||||
ASeries.Marks.Alignment := taCenter;
|
||||
ASeries.Marks.Attachment := maCenter;
|
||||
ASeries.MarkPositions := lmpInside;
|
||||
ASeries.OnGetMarkText := @GetMarkTextHandler;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
79
components/tachart/demo/stateseries/stateseries_demo.lpi
Normal file
79
components/tachart/demo/stateseries/stateseries_demo.lpi
Normal file
@ -0,0 +1,79 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="stateseries_demo"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="TAChartLazarusPkg"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="stateseries_demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="MainForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Main"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="stateseries_demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
27
components/tachart/demo/stateseries/stateseries_demo.lpr
Normal file
27
components/tachart/demo/stateseries/stateseries_demo.lpr
Normal file
@ -0,0 +1,27 @@
|
||||
program stateseries_demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
{$IFDEF HASAMIGA}
|
||||
athreads,
|
||||
{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, tachartlazaruspkg, Main;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource := True;
|
||||
Application.Scaled := True;
|
||||
{$PUSH}{$WARN 5044 OFF}
|
||||
Application.MainFormOnTaskbar := True;
|
||||
{$POP}
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
@ -68,6 +68,9 @@
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf3"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
|
||||
@ -10,7 +10,7 @@ msgstr ""
|
||||
"Content-Type: text/plain; charset=UTF-8\n"
|
||||
"Content-Transfer-Encoding: 8bit\n"
|
||||
"Plural-Forms: nplurals=2; plural=(n != 1);\n"
|
||||
"X-Generator: Poedit 3.1\n"
|
||||
"X-Generator: Poedit 3.5\n"
|
||||
"X-Poedit-SourceCharset: UTF-8\n"
|
||||
|
||||
#: tachartstrconsts.descolor
|
||||
@ -366,9 +366,9 @@ msgid "The %0:s.DataPoints string \"%1:s\" is not a valid number."
|
||||
msgstr "Der %0:s.DataPoints-String \"%1:s\" ist keine gültige Zahl."
|
||||
|
||||
#: tachartstrconsts.rslistsourcestringformaterror
|
||||
#, object-pascal-format, fuzzy, badformat
|
||||
#, object-pascal-format
|
||||
msgid "The data value count in the %0:s.DataPoints string \"%1:s\" differs from what is expected from XCount and YCount."
|
||||
msgstr "Die Anzahl der Datenwerte im %s.DataPoints-String \"%s\" entspricht nicht der, die aufgrund von XCount und YCount erwartet wird."
|
||||
msgstr "Die Anzahl der Datenwerte im %0:s.DataPoints-String \"%1:s\" entspricht nicht der, die aufgrund von XCount und YCount erwartet wird."
|
||||
|
||||
#: tachartstrconsts.rslogarithmic
|
||||
msgid "Logarithmic"
|
||||
@ -502,6 +502,10 @@ msgstr "Die ausgewählten Sortier-Parameter werden von %s nicht unterstützt."
|
||||
msgid "Star (lines)"
|
||||
msgstr "Stern (Linien)"
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr "Zustands-Diagramm"
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr "Oben"
|
||||
@ -556,4 +560,3 @@ msgstr "Fehler beim Umbenennen von Komponenten: %s"
|
||||
#: tachartstrconsts.tastoolseditortitle
|
||||
msgid "Edit tools"
|
||||
msgstr "Werkzeuge bearbeiten"
|
||||
|
||||
|
||||
@ -490,6 +490,10 @@ msgstr ""
|
||||
msgid "Star (lines)"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr ""
|
||||
|
||||
@ -500,6 +500,10 @@ msgstr "Les paramètres de tri sélectionnés ne sont pas pris en charge par %s.
|
||||
msgid "Star (lines)"
|
||||
msgstr "Étoile (lignes)"
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr "Haut"
|
||||
|
||||
@ -500,6 +500,10 @@ msgstr "A(z) %s nem támogatja a kiválasztott rendezési paramétert."
|
||||
msgid "Star (lines)"
|
||||
msgstr "Csillag (vonalak)"
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr "Felülre"
|
||||
|
||||
@ -501,6 +501,10 @@ msgstr ""
|
||||
msgid "Star (lines)"
|
||||
msgstr "Žvaigždės (linijos)"
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr "Viršus"
|
||||
|
||||
@ -499,6 +499,10 @@ msgstr ""
|
||||
msgid "Star (lines)"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr ""
|
||||
|
||||
@ -490,6 +490,10 @@ msgstr ""
|
||||
msgid "Star (lines)"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr ""
|
||||
|
||||
@ -500,6 +500,10 @@ msgstr "Parâmetros de ordenação selecionados não são suportados por %s."
|
||||
msgid "Star (lines)"
|
||||
msgstr "Estrela (linhas)"
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr "Topo"
|
||||
|
||||
@ -500,6 +500,10 @@ msgstr "Выбранные параметры сортировки не подд
|
||||
msgid "Star (lines)"
|
||||
msgstr "Звезда (из линий)"
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr "Верхняя"
|
||||
|
||||
@ -503,6 +503,10 @@ msgstr ""
|
||||
msgid "Star (lines)"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr ""
|
||||
|
||||
@ -503,6 +503,10 @@ msgstr "Вибрані параметри сортування не підтри
|
||||
msgid "Star (lines)"
|
||||
msgstr "Зірка (з ліній)"
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr "Верхня"
|
||||
|
||||
@ -501,6 +501,10 @@ msgstr ""
|
||||
msgid "Star (lines)"
|
||||
msgstr "星(线)"
|
||||
|
||||
#: tachartstrconsts.rsstateseries
|
||||
msgid "State series"
|
||||
msgstr ""
|
||||
|
||||
#: tachartstrconsts.rstop
|
||||
msgid "Top"
|
||||
msgstr "上部"
|
||||
|
||||
@ -33,7 +33,7 @@
|
||||
for details about the copyright.
|
||||
"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="56">
|
||||
<Files Count="57">
|
||||
<Item1>
|
||||
<Filename Value="tagraph.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
@ -278,6 +278,10 @@
|
||||
<Filename Value="tacolormap.pas"/>
|
||||
<UnitName Value="TAColorMap"/>
|
||||
</Item56>
|
||||
<Item57>
|
||||
<Filename Value="tastateseries.pas"/>
|
||||
<UnitName Value="TAStateSeries"/>
|
||||
</Item57>
|
||||
</Files>
|
||||
<CompatibilityMode Value="True"/>
|
||||
<LazDoc Paths="$(LazarusDir)\components\tachart\fpdoc"/>
|
||||
|
||||
@ -19,7 +19,7 @@ uses
|
||||
TACustomFuncSeries, TAFitUtils, TAGUIConnector, TADiagram, TADiagramDrawing,
|
||||
TADiagramLayout, TAChartStrConsts, TAChartCombos, TAHtml, TAFonts,
|
||||
TAExpressionSeries, TAFitLib, TASourcePropEditors, TADataPointsEditor,
|
||||
TAPolygonSeries, TAColorMap, LazarusPackageIntf;
|
||||
TAPolygonSeries, TAColorMap, TAStateSeries, LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -27,6 +27,7 @@ resourcestring
|
||||
rsExpressionSeries = 'Math expression series';
|
||||
rsExpressionColorMapSeries = 'Math expression color map series';
|
||||
rsPolygonSeries = 'Polygon series';
|
||||
rsStateSeries = 'State series';
|
||||
|
||||
// Series editor
|
||||
sesSeriesEditorTitle = 'Edit series';
|
||||
|
||||
543
components/tachart/tastateseries.pas
Normal file
543
components/tachart/tastateseries.pas
Normal file
@ -0,0 +1,543 @@
|
||||
unit TAStateSeries;
|
||||
|
||||
{$mode ObjFPC}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Types, Math, Graphics,
|
||||
TAChartUtils, TADrawUtils, TAMath, TAGeometry, TALegend, TACustomSeries;
|
||||
|
||||
type
|
||||
EStateTimeSeriesError = class(EChartError);
|
||||
|
||||
TBarHeightStyle = (bhsPercent, bhsPercentMin);
|
||||
|
||||
TStateSeries = class(TBasicPointSeries)
|
||||
private
|
||||
const
|
||||
DEFAULT_BAR_HEIGHT_PERCENT = 70;
|
||||
private
|
||||
FBarHeightPercent: Integer;
|
||||
FBarHeightStyle: TBarHeightStyle;
|
||||
FBrush: TBrush;
|
||||
FPen: TPen;
|
||||
procedure SetBarHeightPercent(AValue: Integer);
|
||||
procedure SetBarHeightStyle(AValue: TBarHeightStyle);
|
||||
procedure SetBrush(AValue: TBrush);
|
||||
procedure SetPen(AValue: TPen);
|
||||
protected
|
||||
FMinYRange: Double;
|
||||
procedure CalcBarHeight(AY: Double; AIndex: Integer; out AHeight: Double);
|
||||
function GetLabelDataPoint(AIndex, AYIndex: Integer): TDoublePoint; override;
|
||||
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
||||
function NearestYNumber(var AIndex: Integer; ADir: Integer): Double;
|
||||
procedure UpdateMinYRange;
|
||||
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure Assign(ASource: TPersistent); override;
|
||||
|
||||
function AddXY(AStart, AEnd, Y: Double; ALabel: String;
|
||||
AColor: TColor = clTAColor): Integer;
|
||||
procedure Draw(ADrawer: IChartDrawer); override;
|
||||
function Extent: TDoubleRect; override;
|
||||
function GetBarHeight(AIndex: Integer): Integer;
|
||||
function GetNearestPoint(const AParams: TNearestPointParams;
|
||||
out AResults: TNearestPointResults): Boolean; override;
|
||||
function GetYRange(AY: Double; AIndex: Integer): Double;
|
||||
procedure MovePointEx(var AIndex: Integer; AXIndex, AYIndex: Integer;
|
||||
const ANewPos: TDoublePoint); override;
|
||||
|
||||
class procedure GetXYCountNeeded(out AXCount, AYCount: Cardinal); override;
|
||||
|
||||
published
|
||||
property BarHeightPercent: Integer read FBarHeightPercent
|
||||
write SetBarHeightPercent default DEFAULT_BAR_HEIGHT_PERCENT;
|
||||
property BarHeightStyle: TBarHeightStyle read FBarHeightStyle
|
||||
write SetBarHeightStyle default bhsPercent;
|
||||
property Brush: TBrush read FBrush write SetBrush;
|
||||
property Pen: TPen read FPen write SetPen;
|
||||
property MarkPositions;
|
||||
property Marks;
|
||||
property ToolTargets default [nptPoint, nptXList, nptCustom];
|
||||
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
TAChartStrConsts, TAGraph;
|
||||
|
||||
constructor TStateSeries.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited;
|
||||
|
||||
FPen := TPen.Create;
|
||||
FPen.OnChange := @StyleChanged;
|
||||
FPen.Color := clBlack;
|
||||
|
||||
FBrush := TBrush.Create;
|
||||
FBrush.OnChange := @StyleChanged;
|
||||
FBrush.Color := clRed;
|
||||
|
||||
FBarHeightPercent := DEFAULT_BAR_HEIGHT_PERCENT;
|
||||
FBarHeightStyle := bhsPercent;
|
||||
|
||||
ToolTargets := [nptPoint, nptXList, nptCustom];
|
||||
end;
|
||||
|
||||
destructor TStateSeries.Destroy;
|
||||
begin
|
||||
FBrush.Free;
|
||||
FPen.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TStateSeries.AddXY(AStart, AEnd, Y: Double;
|
||||
ALabel: String; AColor: TColor = clTAColor): Integer;
|
||||
begin
|
||||
EnsureOrder(AStart, AEnd);
|
||||
Result := ListSource.AddXListY([AStart, AEnd], Y, ALabel, AColor);
|
||||
end;
|
||||
|
||||
procedure TStateSeries.Assign(ASource: TPersistent);
|
||||
begin
|
||||
if ASource is TStateSeries then
|
||||
with TStateSeries(ASource) do begin
|
||||
Self.BarHeightPercent := FBarHeightPercent;
|
||||
Self.BarHeightStyle := FBarHeightStyle;
|
||||
Self.Brush.Assign(FBrush);
|
||||
Self.Pen.Assign(FPen);
|
||||
end;
|
||||
inherited Assign(ASource);
|
||||
end;
|
||||
|
||||
procedure TStateSeries.CalcBarHeight(AY: Double; AIndex: Integer;
|
||||
out AHeight: Double);
|
||||
var
|
||||
r: Double;
|
||||
begin
|
||||
case BarHeightStyle of
|
||||
bhsPercent : r := GetYRange(AY, AIndex) * PERCENT;
|
||||
bhsPercentMin : r := FMinYRange * PERCENT;
|
||||
else
|
||||
raise EStateTimeSeriesError.Create('BarHeightStyle not implemented'){%H-};
|
||||
end;
|
||||
AHeight := r * BarHeightPercent / 2;
|
||||
end;
|
||||
|
||||
procedure TStateSeries.Draw(ADrawer: IChartDrawer);
|
||||
var
|
||||
pointIndex: Integer;
|
||||
scaledDepth: Integer;
|
||||
|
||||
procedure DrawBar(const ARect: TRect);
|
||||
var
|
||||
sz: TSize;
|
||||
c: TColor;
|
||||
// ic: IChartTCanvasDrawer; -- maybe later...
|
||||
begin
|
||||
ADrawer.Pen := FPen;
|
||||
if FPen.Color = clDefault then
|
||||
ADrawer.SetPenColor(FChart.GetDefaultColor(dctFont))
|
||||
else
|
||||
ADrawer.SetPenColor(FPen.Color);
|
||||
ADrawer.Brush := FBrush;
|
||||
if FBrush.Color = clDefault then
|
||||
ADrawer.SetBrushColor(FChart.GetDefaultColor(dctBrush))
|
||||
else
|
||||
ADrawer.SetPenColor(FPen.Color);
|
||||
|
||||
c := Source[pointIndex]^.Color;
|
||||
if c <> clTAColor then
|
||||
ADrawer.BrushColor := c;
|
||||
|
||||
sz := Size(ARect);
|
||||
if (sz.cx <= 2*FPen.Width) or (sz.cy <= 2*FPen.Width) then begin
|
||||
// Bars are too small to distinguish the border from the interior.
|
||||
ADrawer.SetPenParams(psSolid, ADrawer.BrushColor);
|
||||
end;
|
||||
(* todo --- add me
|
||||
if Assigned(FOnCustomDrawBar) then begin
|
||||
FOnCustomDrawBar(Self, ADrawer, AR, pointIndex, stackIndex);
|
||||
exit;
|
||||
end;
|
||||
|
||||
if Supports(ADrawer, IChartTCanvasDrawer, ic) and Assigned(OnBeforeDrawBar) then
|
||||
OnBeforeDrawBar(Self, ic.Canvas, AR, pointIndex, stackIndex, defaultDrawing);
|
||||
if not defaultDrawing then exit; *)
|
||||
|
||||
ADrawer.Rectangle(ARect);
|
||||
if scaledDepth > 0 then begin
|
||||
c := ADrawer.BrushColor;
|
||||
ADrawer.BrushColor := GetDepthColor(c, true);
|
||||
ADrawer.DrawLineDepth(
|
||||
ARect.Left, ARect.Top, ARect.Right - 1, ARect.Top, scaledDepth);
|
||||
ADrawer.BrushColor := GetDepthColor(c, false);
|
||||
ADrawer.DrawLineDepth(
|
||||
ARect.Right - 1, ARect.Top, ARect.Right - 1, ARect.Bottom - 1, scaledDepth);
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
ext2: TDoubleRect;
|
||||
h: Double;
|
||||
p: TDoublePoint;
|
||||
|
||||
procedure BuildBar(x1, x2, y: Double);
|
||||
var
|
||||
graphBar: TDoubleRect;
|
||||
imageBar: TRect;
|
||||
begin
|
||||
graphBar := DoubleRect(x1, y - h, x2, y + h);
|
||||
if IsRotated then
|
||||
with graphBar do begin
|
||||
Exchange(a.X, a.Y);
|
||||
Exchange(b.X, b.Y);
|
||||
end;
|
||||
|
||||
if not RectIntersectsRect(graphBar, ext2) then exit;
|
||||
|
||||
with imageBar do begin
|
||||
TopLeft := ParentChart.GraphToImage(graphBar.a);
|
||||
BottomRight := ParentChart.GraphToImage(graphBar.b);
|
||||
TAGeometry.NormalizeRect(imageBar);
|
||||
if IsRotated then inc(imageBar.Right) else inc(imageBar.Bottom);
|
||||
|
||||
// Draw a line instead of an empty rectangle.
|
||||
if (Left = Right) and IsRotated then Dec(Left);
|
||||
if (Bottom = Top) and not IsRotated then Inc(Bottom);
|
||||
end;
|
||||
DrawBar(imageBar);
|
||||
end;
|
||||
|
||||
var
|
||||
x1, x2: Double;
|
||||
begin
|
||||
if IsEmpty or (not Active) then exit;
|
||||
|
||||
if BarHeightStyle = bhsPercentMin then
|
||||
UpdateMinYRange;
|
||||
ext2 := ParentChart.CurrentExtent;
|
||||
ExpandRange(ext2.a.X, ext2.b.X, 1.0);
|
||||
ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
|
||||
|
||||
scaledDepth := ADrawer.Scale(Depth);
|
||||
|
||||
PrepareGraphPoints(ext2, true);
|
||||
for pointIndex := FLoBound to FUpBound do begin
|
||||
p := Source[pointIndex]^.Point;
|
||||
if SkipMissingValues(pointIndex) then
|
||||
continue;
|
||||
p.Y := AxisToGraphY(p.Y);
|
||||
CalcBarHeight(p.Y, pointIndex, h);
|
||||
|
||||
with Source[pointIndex]^ do
|
||||
begin
|
||||
x1 := AxisToGraphX(GetX(0));
|
||||
x2 := AxisToGraphX(GetX(1));
|
||||
end;
|
||||
|
||||
BuildBar(x1, x2, p.Y);
|
||||
end;
|
||||
|
||||
DrawLabels(ADrawer);
|
||||
end;
|
||||
|
||||
function TStateSeries.Extent: TDoubleRect;
|
||||
var
|
||||
y, h: Double;
|
||||
i: Integer;
|
||||
begin
|
||||
// Result := inherited Extent;
|
||||
Result := Source.ExtentXYList;
|
||||
|
||||
if FChart = nil then
|
||||
raise EStateTimeSeriesError.Create('Calculation of TStateTimeSeries.Extent is not possible when the series is not added to a chart.');
|
||||
|
||||
if IsEmpty then exit;
|
||||
if BarHeightStyle = bhsPercentMin then
|
||||
UpdateMinYRange;
|
||||
|
||||
// Show lowest and highest bars fully.
|
||||
if Source.YCount = 0 then begin
|
||||
CalcBarHeight(0.0, 0, h);
|
||||
Result.a.Y -= h;
|
||||
Result.b.Y += h;
|
||||
end else begin
|
||||
i := 0;
|
||||
y := NearestYNumber(i, +1); // --> y is in graph units
|
||||
if not IsNan(y) then begin
|
||||
CalcBarHeight(y, i, h);
|
||||
y := GraphToAxisY(y - h); // y is in graph units, Extent in axis units!
|
||||
Result.a.Y := Min(Result.a.Y, y);
|
||||
end;
|
||||
i := Count - 1;
|
||||
y := NearestYNumber(i, -1);
|
||||
if not IsNan(y) then begin
|
||||
CalcBarHeight(y, i, h);
|
||||
y := GraphToAxisY(y + h);
|
||||
Result.b.Y := Max(Result.b.Y, y);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TStateSeries.GetBarHeight(AIndex: Integer): Integer;
|
||||
var
|
||||
h: Double;
|
||||
f: TGraphToImageFunc;
|
||||
begin
|
||||
CalcBarHeight(GetGraphPointX(AIndex), AIndex, h);
|
||||
if IsRotated then
|
||||
f := @FChart.YGraphToImage
|
||||
else
|
||||
f := @FChart.XGraphToImage;
|
||||
Result := Abs(f(2 * h) - f(0));
|
||||
end;
|
||||
|
||||
function TStateSeries.GetLabelDataPoint(AIndex, AYIndex: Integer): TDoublePoint;
|
||||
var
|
||||
P1, P2: TDoublePoint;
|
||||
begin
|
||||
P1 := GetGraphPoint(AIndex, 0, AYIndex);
|
||||
P2 := GetGraphPoint(AIndex, 1, AYIndex);
|
||||
|
||||
if IsRotated then
|
||||
Result := DoublePoint(P1.X, (P1.Y + P2.Y) / 2)
|
||||
else
|
||||
Result := DoublePoint((P1.X + P2.X) / 2, P1.Y);
|
||||
end;
|
||||
|
||||
procedure TStateSeries.GetLegendItems(AItems: TChartLegendItems);
|
||||
begin
|
||||
GetLegendItemsRect(AItems, Brush, Pen);
|
||||
end;
|
||||
|
||||
function TStateSeries.GetNearestPoint(const AParams: TNearestPointParams;
|
||||
out AResults: TNearestPointResults): Boolean;
|
||||
var
|
||||
pointIndex: Integer;
|
||||
graphClickPt: TDoublePoint;
|
||||
sp: TDoublePoint;
|
||||
p1, p2, h: Double;
|
||||
img1, img2, imgClick: Integer;
|
||||
begin
|
||||
Result := false;
|
||||
AResults.FDist := Sqr(AParams.FRadius) + 1;
|
||||
AResults.FIndex := -1;
|
||||
AResults.FXIndex := 0;
|
||||
AResults.FYIndex := 0;
|
||||
|
||||
// clicked point in image units
|
||||
graphClickPt := ParentChart.ImageToGraph(AParams.FPoint);
|
||||
|
||||
// Iterate through all points of the series
|
||||
for pointIndex := 0 to Count - 1 do begin
|
||||
sp := Source[pointIndex]^.Point;
|
||||
if IsNaN(sp) then
|
||||
Continue;
|
||||
if Source.YCount = 0 then
|
||||
sp.Y := pointIndex;
|
||||
sp := AxisToGraph(sp);
|
||||
|
||||
if IsRotated then
|
||||
begin
|
||||
CalcBarHeight(sp.X, pointIndex, h);
|
||||
if not InRange(graphClickPt.X, sp.X - h, sp.X + h) then
|
||||
Continue;
|
||||
with Source[pointIndex]^ do
|
||||
begin
|
||||
p1 := AxisToGraphY(GetX(0));
|
||||
p2 := AxisToGraphY(GetX(1));
|
||||
end;
|
||||
img1 := ParentChart.YGraphToImage(p1);
|
||||
img2 := ParentChart.YGraphToImage(p2);
|
||||
imgClick := AParams.FPoint.Y;
|
||||
end else
|
||||
begin
|
||||
CalcBarHeight(sp.Y, pointIndex, h); // works with graph units
|
||||
if not InRange(graphClickPt.Y, sp.Y - h, sp.Y + h) then
|
||||
continue;
|
||||
with Source[pointIndex]^ do
|
||||
begin
|
||||
p1 := AxisToGraphX(GetX(0));
|
||||
p2 := AxisToGraphX(GetX(1));
|
||||
end;
|
||||
img1 := ParentChart.XGraphToImage(p1);
|
||||
img2 := ParentChart.XGraphToImage(p2);
|
||||
imgClick := AParams.FPoint.X;
|
||||
end;
|
||||
|
||||
// Checking start point
|
||||
if (nptPoint in AParams.FTargets) and (nptPoint in ToolTargets) and
|
||||
InRange(imgClick, img1 - AParams.FRadius, img1 + AParams.FRadius) then
|
||||
begin
|
||||
AResults.FDist := abs(img1 - imgClick);
|
||||
AResults.FIndex := pointindex;
|
||||
AResults.FXIndex := 0;
|
||||
AResults.FValue := DoublePoint(p1, Source[pointIndex]^.Point.Y);
|
||||
Result := true;
|
||||
break;
|
||||
end;
|
||||
|
||||
// Checking end point
|
||||
if (nptXList in AParams.FTargets) and (nptXList in ToolTargets) and
|
||||
InRange(imgClick, img2 - AParams.FRadius, img2 + AParams.FRadius) then
|
||||
begin
|
||||
AResults.FDist := abs(img2 - imgClick);
|
||||
AResults.FIndex := pointIndex;
|
||||
AResults.FXIndex := 1;
|
||||
AResults.FValue := DoublePoint(Source[pointindex]^.GetX(1), Source[pointindex]^.Y);
|
||||
Result := true;
|
||||
break;
|
||||
end;
|
||||
|
||||
// Checking interior
|
||||
if IsRotated then
|
||||
Exchange(img1, img2);
|
||||
if (nptCustom in AParams.FTargets) and (nptCustom in ToolTargets) and
|
||||
InRange(imgClick, img1, img2) then
|
||||
begin
|
||||
AResults.FDist := abs((img1 + img2) div 2 - imgClick);
|
||||
AResults.FIndex := pointIndex;
|
||||
AResults.FXIndex := -1;
|
||||
AResults.FValue := DoublePoint((Source[pointIndex]^.GetX(0) + Source[pointIndex]^.GetX(1))/2, Source[pointIndex]^.Y);
|
||||
Result := true;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
if Result then
|
||||
begin
|
||||
AResults.FYIndex := 0;
|
||||
AResults.FImg := AParams.FPoint;
|
||||
end;
|
||||
end;
|
||||
|
||||
class procedure TStateSeries.GetXYCountNeeded(out AXCount, AYCount: Cardinal);
|
||||
begin
|
||||
AXCount := 2;
|
||||
AYCount := 1;
|
||||
end;
|
||||
|
||||
function TStateSeries.GetYRange(AY: Double; AIndex: Integer): Double;
|
||||
var
|
||||
hb, ht: Double;
|
||||
i: Integer;
|
||||
begin
|
||||
if Source.YCount > 0 then begin
|
||||
i := AIndex - 1;
|
||||
hb := Abs(AY - NearestYNumber(i, -1));
|
||||
i := AIndex + 1;
|
||||
ht := Abs(AY - NearestYNumber(i, +1));
|
||||
Result := NumberOr(SafeMin(hb, ht), 1.0);
|
||||
if Result = 0.0 then
|
||||
Result := 1.0;
|
||||
end else
|
||||
Result := 1.0;
|
||||
end;
|
||||
|
||||
procedure TStateSeries.MovePointEx(var AIndex: Integer;
|
||||
AXIndex, AYIndex: Integer; const ANewPos: TDoublePoint);
|
||||
var
|
||||
np: TDoublePoint;
|
||||
x1, x2, dx: Double;
|
||||
begin
|
||||
Unused(AYIndex);
|
||||
|
||||
if not InRange(AIndex, 0, Count - 1) then
|
||||
exit;
|
||||
|
||||
x1 := XValues[AIndex, 0];
|
||||
x2 := XValues[AIndex, 1];
|
||||
dx := (x2 - x1) / 2;
|
||||
np := GraphToAxis(ANewPos);
|
||||
|
||||
ParentChart.DisableRedrawing;
|
||||
try
|
||||
case AXIndex of
|
||||
-1: begin
|
||||
x1 := np.X - dx;
|
||||
x2 := np.X + dx;
|
||||
end;
|
||||
0: x1 := np.X;
|
||||
1: x2 := np.X;
|
||||
end;
|
||||
EnsureOrder(x1, x2);
|
||||
with ListSource.Item[AIndex]^ do
|
||||
begin
|
||||
SetX(0, x1);
|
||||
SetX(1, x2);
|
||||
end;
|
||||
finally
|
||||
ParentChart.EnableRedrawing;
|
||||
UpdateParentChart;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TStateSeries.NearestYNumber(var AIndex: Integer; ADir: Integer): Double;
|
||||
begin
|
||||
while InRange(AIndex, 0, Count - 1) do
|
||||
with Source[AIndex]^ do
|
||||
if IsNan(Y) then
|
||||
AIndex += ADir
|
||||
else
|
||||
exit(AxisToGraphY(Y));
|
||||
Result := SafeNan;
|
||||
end;
|
||||
|
||||
procedure TStateSeries.SetBarHeightPercent(AValue: Integer);
|
||||
begin
|
||||
if FBarHeightPercent = AValue then
|
||||
exit;
|
||||
if (csDesigning in ComponentState) and (AValue < 1) or (AValue > 100) then
|
||||
raise EStateTimeSeriesError.Create('Wrong BarHeight Percent');
|
||||
FBarHeightPercent := EnsureRange(AValue, 1, 100);
|
||||
UpdateParentChart;
|
||||
end;
|
||||
|
||||
procedure TStateSeries.SetBarHeightStyle(AValue: TBarHeightStyle);
|
||||
begin
|
||||
if FBarHeightStyle = AValue then
|
||||
exit;
|
||||
FBarHeightStyle := AValue;
|
||||
UpdateParentChart;
|
||||
end;
|
||||
|
||||
procedure TStateSeries.SetBrush(AValue: TBrush);
|
||||
begin
|
||||
FBrush.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TStateSeries.SetPen(AValue: TPen);
|
||||
begin
|
||||
FPen.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TStateSeries.UpdateMinYRange;
|
||||
var
|
||||
Y, prevY: Double;
|
||||
i: Integer;
|
||||
begin
|
||||
if (Count < 2) or (Source.YCount = 0) then begin
|
||||
FMinYRange := 1.0;
|
||||
exit;
|
||||
end;
|
||||
Y := Source[0]^.Y;
|
||||
prevY := Source[1]^.Y;
|
||||
FMinYRange := Abs(Y - prevY);
|
||||
for i := 2 to Count - 1 do begin
|
||||
Y := Source[i]^.Y;
|
||||
FMinYRange := SafeMin(Abs(Y - prevY), FMinYRange);
|
||||
prevY := Y;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
initialization
|
||||
RegisterSeriesClass(TStateSeries, @rsStateSeries);
|
||||
|
||||
end.
|
||||
|
||||
@ -16,7 +16,7 @@ unit TATools;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
uses lazloggerbase,
|
||||
// LCL
|
||||
LCLIntf, LCLType, // must be before Types
|
||||
// RTL, FCL
|
||||
@ -2027,6 +2027,9 @@ begin
|
||||
FindNearestPoint(APoint);
|
||||
if FSeries = nil then exit;
|
||||
FOrigin := NearestGraphPoint;
|
||||
|
||||
DebugLn(['[TDatapointDragTool.MouseDown] APoint=(', APoint.x,';',APoint.y,'), FSeries=', TChartSeries(FSeries).Title, ', FOrigin=(',FormatFloat('0.00',FOrigin.X),';',FormatFloat('0.00',FOrigin.Y),'), FXIndex=', FXIndex, ', FPointIndex=', FPointIndex]);
|
||||
|
||||
FSeries.DragOrigin := APoint;
|
||||
p := FChart.ImageToGraph(APoint);
|
||||
FDistance := p - FOrigin;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user