From a0a5e9d8cd90de1635aaa46170bfbf2c1efcf15f Mon Sep 17 00:00:00 2001 From: wp Date: Wed, 3 Oct 2018 16:20:57 +0000 Subject: [PATCH] TAChart: Extend dragdrop demo to show horizontal dragging of bars. git-svn-id: trunk@59243 - --- components/tachart/demo/dragdrop/main.lfm | 85 ++++++++++++++++++----- components/tachart/demo/dragdrop/main.pas | 51 +++++++++----- 2 files changed, 104 insertions(+), 32 deletions(-) diff --git a/components/tachart/demo/dragdrop/main.lfm b/components/tachart/demo/dragdrop/main.lfm index 9619f6ba9a..46a2e6ae1a 100644 --- a/components/tachart/demo/dragdrop/main.lfm +++ b/components/tachart/demo/dragdrop/main.lfm @@ -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 diff --git a/components/tachart/demo/dragdrop/main.pas b/components/tachart/demo/dragdrop/main.pas index d005733105..10045ae95a 100644 --- a/components/tachart/demo/dragdrop/main.pas +++ b/components/tachart/demo/dragdrop/main.pas @@ -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.