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

git-svn-id: trunk@59243 -

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
+    Width = 571
-    ActivePage = tsBars
+    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
+        Height = 486
-        Top = 0
+        Top = 36
-        Width = 531
+        Width = 563
-        AutoFocus = True
         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

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
+  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;
-
-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;
 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.