paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-09 10:47:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Extend dragdrop demo to show horizontal dragging of bars.

Browse Source 
git-svn-id: trunk@59243 -
This commit is contained in:
wp 2018-10-03 16:20:57 +00:00
parent e9f492c0d9
commit a0a5e9d8cd
2 changed files with 104 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
components/tachart/demo/dragdrop/main.lfm
View File

@ -2,10 +2,10 @@ object Form1: TForm1
Left = 404
Height = 550
Top = 180
Width = 539
Width = 571
Caption = 'Form1'
ClientHeight = 550
ClientWidth = 539
ClientWidth = 571
OnCreate = FormCreate
Position = poScreenCenter
LCLVersion = '2.1.0.0'
@ -13,20 +13,20 @@ object Form1: TForm1
Left = 0
Height = 550
Top = 0
Width = 539
ActivePage = tsBars
Width = 571
ActivePage = tsPoints
Align = alClient
TabIndex = 1
TabIndex = 0
TabOrder = 0
object tsPoints: TTabSheet
Caption = 'Points'
ClientHeight = 522
ClientWidth = 531
ClientWidth = 563
object chPoints: TChart
Left = 0
Height = 486
Top = 36
Width = 531
Width = 563
AutoFocus = True
AxisList = <
item
@ -75,12 +75,12 @@ object Form1: TForm1
Left = 0
Height = 36
Top = 0
Width = 531
Width = 563
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 36
ClientWidth = 531
ClientWidth = 563
TabOrder = 1
object cbSorted: TCheckBox
AnchorSideLeft.Control = Panel1
@ -100,13 +100,12 @@ object Form1: TForm1
object tsBars: TTabSheet
Caption = 'Bars'
ClientHeight = 522
ClientWidth = 531
ClientWidth = 563
object chBars: TChart
Left = 0
Height = 522
Top = 0
Width = 531
AutoFocus = True
Height = 486
Top = 36
Width = 563
AxisList = <
item
Marks.LabelBrush.Style = bsClear
@ -125,7 +124,7 @@ object Form1: TForm1
Title.Brush.Color = clBtnFace
Title.Font.Color = clBlue
Title.Text.Strings = (
'Drag end of bars while holding SHIFT key down'
'Drag bars while holding SHIFT key down'
)
Title.Visible = True
Toolset = ctBars
@ -133,6 +132,60 @@ object Form1: TForm1
DoubleBuffered = True
object chBarsBarSeries1: TBarSeries
BarBrush.Color = clRed
ToolTargets = [nptPoint, nptYList]
end
end
object Panel2: TPanel
Left = 0
Height = 36
Top = 0
Width = 563
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 36
ClientWidth = 563
TabOrder = 1
object rbDragY: TRadioButton
AnchorSideLeft.Control = Panel2
AnchorSideTop.Control = Panel2
AnchorSideTop.Side = asrCenter
Left = 8
Height = 19
Top = 9
Width = 179
BorderSpacing.Around = 8
Caption = 'Drag y value (grab bars at top)'
Checked = True
OnChange = rbDragYChange
TabOrder = 0
TabStop = True
end
object rbDragX: TRadioButton
AnchorSideLeft.Control = rbDragY
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel2
AnchorSideTop.Side = asrCenter
Left = 203
Height = 19
Top = 9
Width = 198
BorderSpacing.Left = 16
Caption = 'Drag x value (grab bars anywhere)'
OnChange = rbDragYChange
TabOrder = 1
end
object cbConstBarWidth: TCheckBox
AnchorSideLeft.Control = rbDragX
AnchorSideLeft.Side = asrBottom
Left = 409
Height = 19
Top = 8
Width = 119
BorderSpacing.Around = 8
Caption = 'constant bar width'
OnChange = cbConstBarWidthChange
TabOrder = 2
end
end
end
@ -166,8 +219,8 @@ object Form1: TForm1
Shift = [ssShift, ssLeft]
GrabRadius = 30
ActiveCursor = crSizeNS
Targets = [nptPoint, nptXList, nptYList]
OnDrag = ctBarsDataPointDragTool1Drag
OnDragStart = ctBarsDataPointDragTool1DragStart
end
end
object RandomChartSource1: TRandomChartSource

51
components/tachart/demo/dragdrop/main.pas
View File

@ -14,6 +14,7 @@ type
TForm1 = class(TForm)
cbSorted: TCheckBox;
cbConstBarWidth: TCheckBox;
chPoints: TChart;
chBarsBarSeries1: TBarSeries;
chPointsLineSeries1: TLineSeries;
@ -26,21 +27,24 @@ type
ctPointsDataPointHintTool1: TDataPointHintTool;
PageControl1: TPageControl;
Panel1: TPanel;
Panel2: TPanel;
rbDragY: TRadioButton;
rbDragX: TRadioButton;
RandomChartSource1: TRandomChartSource;
tsPoints: TTabSheet;
tsBars: TTabSheet;
procedure cbConstBarWidthChange(Sender: TObject);
procedure cbSortedChange(Sender: TObject);
procedure chPointsLineSeries1GetMark(out AFormattedMark: String;
AIndex: Integer);
procedure ctBarsDataPointDragTool1Drag(ASender: TDataPointDragTool;
var AGraphPoint: TDoublePoint);
procedure ctBarsDataPointDragTool1DragStart(ASender: TDataPointDragTool;
var AGraphPoint: TDoublePoint);
procedure ctPointsDataPointClickTool1PointClick(ATool: TChartTool;
APoint: TPoint);
procedure ctPointsDataPointHintTool1Hint(ATool: TDataPointHintTool;
const APoint: TPoint; var AHint: String);
procedure FormCreate(Sender: TObject);
procedure rbDragYChange(Sender: TObject);
end;
var
@ -60,6 +64,14 @@ begin
chPointsLineSeries1.ListSource.Sorted := cbSorted.Checked;
end;
procedure TForm1.cbConstBarWidthChange(Sender: TObject);
begin
if cbConstBarWidth.Checked then
chBarsBarSeries1.BarWidthStyle := bwPercentMin
else
chBarsBarSeries1.BarWidthStyle := bwPercent;
end;
procedure TForm1.chPointsLineSeries1GetMark(
out AFormattedMark: String; AIndex: Integer);
begin
@ -74,20 +86,16 @@ end;
procedure TForm1.ctBarsDataPointDragTool1Drag(ASender: TDataPointDragTool;
var AGraphPoint: TDoublePoint);
begin
// Only allow vertical dragging.
AGraphPoint.X := ASender.Origin.X;
end;
procedure TForm1.ctBarsDataPointDragTool1DragStart(ASender: TDataPointDragTool;
var AGraphPoint: TDoublePoint);
const
Y_TOLERANCE = 3;
var
f: TGraphToImageFunc;
begin
f := @chBars.YGraphToImage;
if Abs(f(ASender.Origin.Y) - f(AGraphPoint.Y)) > Y_TOLERANCE then
ASender.Handled;
if rbDragY.Checked then begin
// Only allow vertical dragging.
AGraphPoint.X := ASender.Origin.X;
ctBarsDataPointDragTool1.ActiveCursor := crSizeNS;
end else
if rbDragX.Checked then begin
// Only allow horizontal dragging
AGraphPoint.Y := ASender.Origin.Y;
ctBarsDataPointDragTool1.ActiveCursor := crSizeWE;
end;
end;
procedure TForm1.ctPointsDataPointClickTool1PointClick(
@ -118,5 +126,16 @@ begin
chBarsBarSeries1.ListSource.CopyFrom(RandomChartSource1);
end;
procedure TForm1.rbDragYChange(Sender: TObject);
begin
if rbDragY.Checked then begin
chBarsBarSeries1.ToolTargets := chBarsBarSeries1.ToolTargets - [nptCustom];
ctBarsDataPointDragTool1.Targets := ctBarsDataPointDragTool1.Targets - [nptCustom];
end else begin
chBarsBarSeries1.ToolTargets := chBarsBarSeries1.ToolTargets + [nptCustom];
ctBarsDataPointDragTool1.Targets := ctBarsDataPointDragTool1.Targets + [nptCustom];
end;
end;
end.