TAChart: Add "Bars" page to the "dragdrop" demo

git-svn-id: trunk@38791 -
2025-12-09 19:57:45 +01:00 · 2012-09-21 15:48:34 +00:00 · 2012-09-21 15:48:34 +00:00 · e4d555f7f9
commit e4d555f7f9
parent 4678f2ffd4
2 changed files with 219 additions and 94 deletions
--- a/components/tachart/demo/dragdrop/main.lfm
+++ b/components/tachart/demo/dragdrop/main.lfm
@ -1,98 +1,169 @@
 object Form1: TForm1
  Left = 404
-  Height = 481
+  Height = 550
  Top = 180
-  Width = 483
-  ActiveControl = Chart1
+  Width = 539
  Caption = 'Form1'
-  ClientHeight = 481
-  ClientWidth = 483
+  ClientHeight = 550
+  ClientWidth = 539
+  OnActivate = FormActivate
  OnCreate = FormCreate
  Position = poScreenCenter
  LCLVersion = '1.1'
-  object Chart1: TChart
+  object PageControl1: TPageControl
    Left = 0
-    Height = 447
-    Top = 34
-    Width = 483
-    AxisList = <    
-      item
-        Minors = <>
-        Title.LabelFont.Orientation = 900
-      end    
-      item
-        Alignment = calBottom
-        Minors = <>
-      end>
-    Foot.Brush.Color = clBtnFace
-    Foot.Font.Color = clBlue
-    Margins.Left = 8
-    Margins.Top = 8
-    Margins.Right = 8
-    Margins.Bottom = 8
-    Title.Brush.Color = clBtnFace
-    Title.Font.Color = clBlue
-    Title.Text.Strings = (
-      'Drag data points while holding Shift key'
-      'Change point color by right-click'
-      'Show hint while holding ctrl key'
-    )
-    Title.Visible = True
-    Toolset = ChartToolset1
-    Align = alClient
-    DoubleBuffered = True
-    ParentColor = False
-    object Chart1LineSeries1: TLineSeries
-      Marks.Clipped = False
-      Marks.Format = '%0:.9g'
-      Marks.Style = smsValue
-      OnGetMark = Chart1LineSeries1GetMark
-      Pointer.Brush.Color = clPurple
-      Pointer.HorizSize = 6
-      Pointer.Style = psDiamond
-      Pointer.VertSize = 6
-      ShowPoints = True
-    end
-  end
-  object Panel1: TPanel
-    Left = 0
-    Height = 34
+    Height = 550
    Top = 0
-    Width = 483
-    Align = alTop
-    ClientHeight = 34
-    ClientWidth = 483
-    TabOrder = 1
-    object cbSorted: TCheckBox
-      Left = 12
-      Height = 17
-      Top = 8
-      Width = 52
-      Caption = 'Sorted'
-      OnChange = cbSortedChange
-      TabOrder = 0
+    Width = 539
+    ActivePage = tsPoints
+    Align = alClient
+    TabIndex = 0
+    TabOrder = 0
+    OnChange = PageControl1Change
+    object tsPoints: TTabSheet
+      Caption = 'Points'
+      ClientHeight = 524
+      ClientWidth = 531
+      object chPoints: TChart
+        Left = 0
+        Height = 490
+        Top = 34
+        Width = 531
+        AxisList = <        
+          item
+            Minors = <>
+            Title.LabelFont.Orientation = 900
+          end        
+          item
+            Alignment = calBottom
+            Minors = <>
+          end>
+        Foot.Brush.Color = clBtnFace
+        Foot.Font.Color = clBlue
+        Margins.Left = 8
+        Margins.Top = 8
+        Margins.Right = 8
+        Margins.Bottom = 8
+        Title.Brush.Color = clBtnFace
+        Title.Font.Color = clBlue
+        Title.Text.Strings = (
+          'Drag data points while holding Shift key'
+          'Change point color by right-click'
+          'Show hint while holding ctrl key'
+        )
+        Title.Visible = True
+        Toolset = ctPoints
+        Align = alClient
+        DoubleBuffered = True
+        ParentColor = False
+        object chPointsLineSeries1: TLineSeries
+          Marks.Clipped = False
+          Marks.Format = '%0:.9g'
+          Marks.Style = smsValue
+          OnGetMark = chPointsLineSeries1GetMark
+          Pointer.Brush.Color = clPurple
+          Pointer.HorizSize = 6
+          Pointer.Style = psDiamond
+          Pointer.VertSize = 6
+          ShowPoints = True
+        end
+      end
+      object Panel1: TPanel
+        Left = 0
+        Height = 34
+        Top = 0
+        Width = 531
+        Align = alTop
+        ClientHeight = 34
+        ClientWidth = 531
+        TabOrder = 1
+        object cbSorted: TCheckBox
+          Left = 12
+          Height = 17
+          Top = 8
+          Width = 52
+          Caption = 'Sorted'
+          OnChange = cbSortedChange
+          TabOrder = 0
+        end
+      end
+    end
+    object tsBars: TTabSheet
+      Caption = 'Bars'
+      ClientHeight = 524
+      ClientWidth = 531
+      object chBars: TChart
+        Left = 0
+        Height = 524
+        Top = 0
+        Width = 531
+        AxisList = <        
+          item
+            Minors = <>
+            Title.LabelFont.Orientation = 900
+          end        
+          item
+            Alignment = calBottom
+            Minors = <>
+          end>
+        Foot.Brush.Color = clBtnFace
+        Foot.Font.Color = clBlue
+        Title.Brush.Color = clBtnFace
+        Title.Font.Color = clBlue
+        Title.Text.Strings = (
+          'TAChart'
+        )
+        Toolset = ctBars
+        Align = alClient
+        DoubleBuffered = True
+        ParentColor = False
+        object chBarsBarSeries1: TBarSeries
+          BarBrush.Color = clRed
+        end
+      end
    end
  end
-  object ChartToolset1: TChartToolset
-    left = 99
-    top = 129
-    object ChartToolset1DataPointDragTool1: TDataPointDragTool
+  object ctPoints: TChartToolset
+    left = 127
+    top = 157
+    object ctPointsDataPointDragTool1: TDataPointDragTool
      Shift = [ssShift, ssLeft]
      GrabRadius = 10
      ActiveCursor = crDrag
    end
-    object ChartToolset1DataPointClickTool1: TDataPointClickTool
+    object ctPointsDataPointClickTool1: TDataPointClickTool
      Shift = [ssRight]
      GrabRadius = 10
      ActiveCursor = crHandPoint
-      OnPointClick = ChartToolset1DataPointClickTool1PointClick
+      OnPointClick = ctPointsDataPointClickTool1PointClick
    end
-    object ChartToolset1DataPointHintTool1: TDataPointHintTool
+    object ctPointsDataPointHintTool1: TDataPointHintTool
      Shift = [ssCtrl]
      GrabRadius = 10
      ActiveCursor = crHandPoint
-      OnHint = ChartToolset1DataPointHintTool1Hint
+      OnHint = ctPointsDataPointHintTool1Hint
      UseDefaultHintText = False
    end
  end
+  object ctBars: TChartToolset
+    left = 127
+    top = 224
+    object ctBarsDataPointDragTool1: TDataPointDragTool
+      Shift = [ssLeft]
+      OnBeforeKeyDown = ctBarsDataPointDragTool1BeforeKeyDown
+      GrabRadius = 30
+      OnDrag = ctBarsDataPointDragTool1Drag
+      OnDragStart = ctBarsDataPointDragTool1DragStart
+    end
+  end
+  object RandomChartSource1: TRandomChartSource
+    PointsNumber = 6
+    RandSeed = 71866733
+    XMax = 10
+    XMin = 0
+    YMax = 1
+    YMin = 0
+    left = 128
+    top = 104
+  end
 end
--- a/components/tachart/demo/dragdrop/main.pas
+++ b/components/tachart/demo/dragdrop/main.pas
@ -5,30 +5,46 @@ unit Main;
 interface

 uses
-  Classes, ExtCtrls, StdCtrls, SysUtils, FileUtil, LResources, Forms, Controls,
-  Graphics, Dialogs, TAGraph, TASeries, TATools, Types;
+  Classes, ComCtrls, ExtCtrls, StdCtrls, SysUtils, FileUtil, LResources, Forms,
+  Controls, Graphics, Dialogs, TAGraph, TASeries, TASources, TATools, Types, TAChartUtils;

 type

  { TForm1 }

  TForm1 = class(TForm)
-    Chart1: TChart;
-    Chart1LineSeries1: TLineSeries;
-    ChartToolset1: TChartToolset;
-    ChartToolset1DataPointClickTool1: TDataPointClickTool;
-    ChartToolset1DataPointDragTool1: TDataPointDragTool;
    cbSorted: TCheckBox;
-    ChartToolset1DataPointHintTool1: TDataPointHintTool;
+    chPoints: TChart;
+    chBarsBarSeries1: TBarSeries;
+    chPointsLineSeries1: TLineSeries;
+    chBars: TChart;
+    ctBars: TChartToolset;
+    ctBarsDataPointDragTool1: TDataPointDragTool;
+    ctPoints: TChartToolset;
+    ctPointsDataPointClickTool1: TDataPointClickTool;
+    ctPointsDataPointDragTool1: TDataPointDragTool;
+    ctPointsDataPointHintTool1: TDataPointHintTool;
+    PageControl1: TPageControl;
    Panel1: TPanel;
+    RandomChartSource1: TRandomChartSource;
+    tsPoints: TTabSheet;
+    tsBars: TTabSheet;
    procedure cbSortedChange(Sender: TObject);
-    procedure Chart1LineSeries1GetMark(out AFormattedMark: String;
+    procedure chPointsLineSeries1GetMark(out AFormattedMark: String;
      AIndex: Integer);
-    procedure ChartToolset1DataPointClickTool1PointClick(ATool: TChartTool;
+    procedure ctBarsDataPointDragTool1BeforeKeyDown(ATool: TChartTool;
      APoint: TPoint);
-    procedure ChartToolset1DataPointHintTool1Hint(ATool: TDataPointHintTool;
+    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 FormActivate(Sender: TObject);
    procedure FormCreate(Sender: TObject);
+    procedure PageControl1Change(Sender: TObject);
  end;

 var
@ -39,51 +55,89 @@ implementation
 {$R *.lfm}

 uses
-  Math, TAChartUtils;
+  Math;

 { TForm1 }

 procedure TForm1.cbSortedChange(Sender: TObject);
 begin
-  Chart1LineSeries1.ListSource.Sorted := cbSorted.Checked;
-  Chart1.SetFocus;
+  chPointsLineSeries1.ListSource.Sorted := cbSorted.Checked;
+  chPoints.SetFocus;
 end;

-procedure TForm1.Chart1LineSeries1GetMark(
+procedure TForm1.chPointsLineSeries1GetMark(
  out AFormattedMark: String; AIndex: Integer);
 begin
-  if AIndex = ChartToolset1DataPointDragTool1.PointIndex then
-    with Chart1LineSeries1 do
+  // Show item label for last dragged point.
+  if AIndex = ctPointsDataPointDragTool1.PointIndex then
+    with chPointsLineSeries1 do
      AFormattedMark := Source.FormatItem(Marks.Format, AIndex, 0)
  else
    AFormattedMark := '';
 end;

-procedure TForm1.ChartToolset1DataPointClickTool1PointClick(
+procedure TForm1.ctBarsDataPointDragTool1BeforeKeyDown(ATool: TChartTool;
+  APoint: TPoint);
+begin
+  TDataPointDragTool(ATool).GrabRadius := chBarsBarSeries1.GetBarWidth(0);
+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;
+end;
+
+procedure TForm1.ctPointsDataPointClickTool1PointClick(
  ATool: TChartTool; APoint: TPoint);
 var
  pi: Integer;
 begin
  Unused(ATool, APoint);
-  pi := ChartToolset1DataPointClickTool1.PointIndex;
-  with Chart1LineSeries1 do
+  pi := ctPointsDataPointClickTool1.PointIndex;
+  with chPointsLineSeries1 do
    SetColor(pi, IfThen(GetColor(pi) = clRed, clTAColor, clRed));
 end;

-procedure TForm1.ChartToolset1DataPointHintTool1Hint(ATool: TDataPointHintTool;
+procedure TForm1.ctPointsDataPointHintTool1Hint(ATool: TDataPointHintTool;
  const APoint: TPoint; var AHint: String);
 begin
  Unused(APoint);
  AHint := 'Custom hint for point ' + IntToStr(ATool.PointIndex);
 end;

+procedure TForm1.FormActivate(Sender: TObject);
+begin
+  PageControl1Change(nil);
+end;
+
 procedure TForm1.FormCreate(Sender: TObject);
 var
  i: Integer;
 begin
  RandSeed := 675402;
  for i := 1 to 10 do
-    Chart1LineSeries1.AddXY(i, Random(20) - 10);
+    chPointsLineSeries1.AddXY(i, Random(20) - 10);
+  chBarsBarSeries1.ListSource.CopyFrom(RandomChartSource1);
+end;
+
+procedure TForm1.PageControl1Change(Sender: TObject);
+begin
+  if PageControl1.ActivePage = tsPoints then
+    chPoints.SetFocus;
 end;

 end.