paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 19:19:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Add clipping option to TDatapointDistanceTool. Update demo.

Browse Source 
git-svn-id: trunk@60766 -
This commit is contained in:
wp 2019-03-24 21:39:45 +00:00
parent c66c600938
commit 0bfea66f90
5 changed files with 72 additions and 42 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
components/tachart/demo/distance/Main.lfm
View File

@ -44,23 +44,24 @@ object Form1: TForm1
end
object Panel1: TPanel
Left = 4
Height = 92
Top = 407
Height = 99
Top = 400
Width = 797
Align = alBottom
AutoSize = True
BorderSpacing.Left = 4
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
BevelOuter = bvNone
ClientHeight = 92
ClientHeight = 99
ClientWidth = 797
TabOrder = 2
object rgSnapMode: TRadioGroup
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
Left = 0
Height = 89
Height = 99
Top = 0
Width = 103
AutoFill = True
@ -68,13 +69,14 @@ object Form1: TForm1
Caption = 'Snapping mode'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.VerticalSpacing = 5
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 69
ClientHeight = 79
ClientWidth = 99
ItemIndex = 0
Items.Strings = (
@ -90,7 +92,7 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 217
Height = 89
Height = 99
Top = 0
Width = 98
AutoFill = True
@ -99,13 +101,14 @@ object Form1: TForm1
Caption = 'Drawing mode'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.VerticalSpacing = 5
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 69
ClientHeight = 79
ClientWidth = 94
ItemIndex = 1
Items.Strings = (
@ -122,9 +125,8 @@ object Form1: TForm1
AnchorSideTop.Side = asrBottom
Left = 439
Height = 19
Top = 27
Top = 23
Width = 82
BorderSpacing.Top = 4
Caption = 'Rotate label'
Checked = True
OnClick = cbRotateLabelClick
@ -235,9 +237,8 @@ object Form1: TForm1
AnchorSideTop.Side = asrBottom
Left = 439
Height = 19
Top = 73
Top = 61
Width = 114
BorderSpacing.Top = 4
Caption = 'Hide at mouse up'
OnClick = cbHideClick
TabOrder = 5
@ -247,7 +248,7 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 111
Height = 89
Height = 99
Top = 0
Width = 98
AutoFill = True
@ -256,13 +257,14 @@ object Form1: TForm1
Caption = 'Measure mode'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.VerticalSpacing = 5
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 69
ClientHeight = 79
ClientWidth = 94
ItemIndex = 0
Items.Strings = (
@ -280,8 +282,8 @@ object Form1: TForm1
AnchorSideBottom.Control = cbHide
AnchorSideBottom.Side = asrBottom
Left = 561
Height = 42
Top = 50
Height = 48
Top = 32
Width = 128
Anchors = [akTop, akLeft, akRight, akBottom]
Lines.Strings = (
@ -296,7 +298,7 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 323
Height = 89
Height = 99
Top = 0
Width = 108
AutoFill = True
@ -305,13 +307,14 @@ object Form1: TForm1
Caption = 'Data point mode'
ChildSizing.LeftRightSpacing = 6
ChildSizing.TopBottomSpacing = 6
ChildSizing.VerticalSpacing = 5
ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
ChildSizing.EnlargeVertical = crsHomogenousChildResize
ChildSizing.ShrinkHorizontal = crsScaleChilds
ChildSizing.ShrinkVertical = crsScaleChilds
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ChildSizing.ControlsPerLine = 1
ClientHeight = 69
ClientHeight = 79
ClientWidth = 104
ItemIndex = 0
Items.Strings = (
@ -328,17 +331,28 @@ object Form1: TForm1
AnchorSideTop.Side = asrBottom
Left = 439
Height = 19
Top = 50
Top = 42
Width = 67
BorderSpacing.Top = 4
Caption = 'Flip label'
OnClick = cbFlipLabelClick
TabOrder = 9
end
object cbClipping: TCheckBox
AnchorSideLeft.Control = cbShowLabel
AnchorSideTop.Control = cbHide
AnchorSideTop.Side = asrBottom
Left = 439
Height = 19
Top = 80
Width = 65
Caption = 'Clipping'
OnChange = cbClippingChange
TabOrder = 10
end
end
object Chart1: TChart
Left = 0
Height = 399
Height = 392
Top = 0
Width = 809
AutoFocus = True

7
components/tachart/demo/distance/Main.pas
View File

@ -27,6 +27,7 @@ type
ChartAxisTransformations1LogarithmAxisTransform1: TLogarithmAxisTransform;
ChartAxisTransformations3: TChartAxisTransformations;
ChartAxisTransformations3AutoScaleAxisTransform1: TAutoScaleAxisTransform;
cbClipping: TCheckBox;
chFit: TChart;
chFitFitSeries1: TFitSeries;
chFitLineSeries1: TLineSeries;
@ -60,6 +61,7 @@ type
StatusBar1: TStatusBar;
tsMain: TTabSheet;
tsFit: TTabSheet;
procedure cbClippingChange(Sender: TObject);
procedure cbFlipLabelClick(Sender: TObject);
procedure cbHideClick(Sender: TObject);
procedure cbRotateLabelClick(Sender: TObject);
@ -107,6 +109,11 @@ begin
SwitchOptions([dpdoFlipLabel], cbFlipLabel.Checked);
end;
procedure TForm1.cbClippingChange(Sender: TObject);
begin
SwitchOptions([dpdoClipping], cbClipping.Checked);
end;
procedure TForm1.cbHideClick(Sender: TObject);
begin
SwitchOptions([dpdoPermanent], not cbHide.Checked);

7
components/tachart/demo/distance/distancedemo.lpi
View File

@ -1,11 +1,10 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="11"/>
<ProjectOptions BuildModesCount="1">
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="distancedemo"/>
<Scaled Value="True"/>
<ResourceType Value="res"/>
@ -17,7 +16,7 @@
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<BuildModes Count="1">
<BuildModes>
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>

3
components/tachart/fpdoc/tagraph.xml
View File

@ -339,8 +339,7 @@ chart margin and the space reserved for series marks.
<var>Drawer</var>. Unlike
<var>PaintOnCanvas</var> the chart can be drawn on non-canvas devices, such as a svg file.
</descr>
<seealso>
<link id=""/>
<seealso><link id=""/>
</seealso>
</element>
<element name="TChart.Create">

13
components/tachart/tadatatools.pas
View File

@ -50,7 +50,7 @@ type
TDataPointMode = (dpmFree, dpmSnap, dpmLock);
TOptions = set of (
dpdoRotateLabel, dpdoLabelAbove, dpdoPermanent, dpdoFlipLabel);
dpdoRotateLabel, dpdoLabelAbove, dpdoPermanent, dpdoFlipLabel, dpdoClipping);
strict private
// Workaround for FPC 2.6 bug. Remove after migration to 2.8.
@ -230,6 +230,7 @@ var
flip: Boolean;
begin
if not (IsActive or (FChart <> nil) and (dpdoPermanent in Options)) then exit;
p1 := FChart.GraphToImage(PointStart.GraphPos);
p2 := FChart.GraphToImage(PointEnd.GraphPos);
case MeasureMode of
@ -238,6 +239,10 @@ begin
end;
if p1 = p2 then exit;
StartTransparency;
if dpdoClipping in FOptions then
FChart.Drawer.ClippingStart(FChart.ClipRect);
try
if LinePen.Visible then begin
FChart.Drawer.Pen := LinePen;
FChart.Drawer.Line(p1, p2);
@ -245,6 +250,7 @@ begin
a := ArcTan2(p2.Y - p1.Y, p2.X - p1.X);
DrawPointer(PointerStart, p1);
DrawPointer(PointerEnd, p2);
if Marks.Visible then begin
flip := (dpdoFlipLabel in Options) and ((a > Pi /2) or (a < -Pi / 2));
Marks.SetAdditionalAngle(
@ -254,7 +260,12 @@ begin
p2 := p1 + RotatePointX(Marks.Distance, a);
Marks.DrawLabel(FChart.Drawer, p1, p2, GetDistanceText, dummy);
end;
finally
if dpdoClipping in FOptions then FChart.Drawer.ClippingStop;
end;
inherited;
Chart.Drawer.SetTransparency(0);
end;