TAChart: Add owner-draw pointer event to TLineSeries. Add demo showing bitmap pointer and drawing only every nth pointer.

git-svn-id: trunk@52103 -
2025-06-04 13:18:19 +02:00 · 2016-04-04 12:07:40 +00:00 · 2016-04-04 12:07:40 +00:00 · e63ea5918a
commit e63ea5918a
parent 299995c6b9
5 changed files with 236 additions and 38 deletions
--- a/components/tachart/demo/line/Main.lfm
+++ b/components/tachart/demo/line/Main.lfm
@ -8,7 +8,7 @@ object Form1: TForm1
  ClientWidth = 691
  OnCreate = FormCreate
  Position = poScreenCenter
-  LCLVersion = '1.1'
+  LCLVersion = '1.7'
  object PageControl1: TPageControl
    Left = 0
    Height = 494
@ -21,11 +21,11 @@ object Form1: TForm1
    OnChange = PageControl1Change
    object tsFast: TTabSheet
      Caption = 'Fast drawing'
-      ClientHeight = 468
+      ClientHeight = 466
      ClientWidth = 683
      object chFast: TChart
        Left = 0
-        Height = 430
+        Height = 428
        Top = 38
        Width = 683
        AxisList = <        
@ -47,7 +47,6 @@ object Form1: TForm1
        Toolset = ChartToolset1
        Align = alClient
        DoubleBuffered = True
-        ParentColor = False
        object chFastLineSeries1: TLineSeries
          LinePen.Color = clTeal
          LinePen.Width = 3
@ -72,10 +71,10 @@ object Form1: TForm1
        TabOrder = 1
        object cbLineType: TComboBox
          Left = 8
-          Height = 21
+          Height = 23
          Top = 8
          Width = 96
-          ItemHeight = 13
+          ItemHeight = 15
          ItemIndex = 1
          Items.Strings = (
            'None'
@ -91,18 +90,18 @@ object Form1: TForm1
        end
        object cb3D: TCheckBox
          Left = 112
-          Height = 17
+          Height = 19
          Top = 12
-          Width = 33
+          Width = 34
          Caption = '3D'
          OnChange = cb3DChange
          TabOrder = 1
        end
        object cbRotated: TCheckBox
          Left = 152
-          Height = 17
+          Height = 19
          Top = 12
-          Width = 59
+          Width = 61
          Caption = 'Rotated'
          OnChange = cbRotatedChange
          TabOrder = 2
@ -118,7 +117,7 @@ object Form1: TForm1
        end
        object edTime: TEdit
          Left = 496
-          Height = 21
+          Height = 23
          Top = 6
          Width = 76
          Alignment = taRightJustify
@ -135,9 +134,9 @@ object Form1: TForm1
        end
        object cbSorted: TCheckBox
          Left = 216
-          Height = 17
+          Height = 19
          Top = 12
-          Width = 52
+          Width = 54
          Caption = 'Sorted'
          OnChange = cbSortedChange
          TabOrder = 6
@ -153,11 +152,11 @@ object Form1: TForm1
    end
    object tsPointers: TTabSheet
      Caption = 'Pointers'
-      ClientHeight = 468
+      ClientHeight = 466
      ClientWidth = 683
      object chPointers: TChart
        Left = 0
-        Height = 468
+        Height = 466
        Top = 0
        Width = 513
        AxisList = <        
@ -180,20 +179,19 @@ object Form1: TForm1
          'TAChart'
        )
        Align = alClient
-        ParentColor = False
      end
      object pnlPointers: TPanel
        Left = 513
-        Height = 468
+        Height = 466
        Top = 0
        Width = 170
        Align = alRight
-        ClientHeight = 468
+        ClientHeight = 466
        ClientWidth = 170
        TabOrder = 1
        object sePointerSize: TSpinEdit
          Left = 49
-          Height = 21
+          Height = 23
          Top = 6
          Width = 50
          OnChange = sePointerSizeChange
@ -202,21 +200,134 @@ object Form1: TForm1
        end
        object lblPointerSize: TLabel
          Left = 9
-          Height = 13
+          Height = 15
          Top = 10
-          Width = 19
+          Width = 20
          Caption = 'Size'
          ParentColor = False
        end
      end
    end
+    object tsOwnerDrawnPointer: TTabSheet
+      Caption = 'Ownerdrawn pointer'
+      ClientHeight = 466
+      ClientWidth = 683
+      object ChartOwnerDrawnPointer: TChart
+        Left = 0
+        Height = 432
+        Top = 34
+        Width = 683
+        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'
+        )
+        Align = alClient
+        object lsOwnerDrawnPointer: TLineSeries
+          OnOwnerDrawPointer = lsOwnerDrawnPointerOwnerDrawPointer
+          ShowPoints = True
+          Source = RandomChartSource1
+        end
+      end
+      object Panel2: TPanel
+        Left = 0
+        Height = 34
+        Top = 0
+        Width = 683
+        Align = alTop
+        BevelOuter = bvNone
+        ClientHeight = 34
+        ClientWidth = 683
+        TabOrder = 1
+        object cbBitmapPointer: TCheckBox
+          Left = 8
+          Height = 19
+          Top = 8
+          Width = 99
+          Caption = 'Bitmap pointer'
+          Checked = True
+          OnChange = cbBitmapPointerChange
+          State = cbChecked
+          TabOrder = 0
+        end
+        object cbDrawEveryNthPointer: TCheckBox
+          AnchorSideLeft.Control = PointerImage
+          AnchorSideLeft.Side = asrBottom
+          Left = 139
+          Height = 19
+          Top = 8
+          Width = 115
+          BorderSpacing.Left = 16
+          Caption = 'Every n-th pointer'
+          Checked = True
+          OnChange = cbBitmapPointerChange
+          State = cbChecked
+          TabOrder = 1
+        end
+        object edEveryNth: TSpinEdit
+          AnchorSideLeft.Control = cbDrawEveryNthPointer
+          AnchorSideLeft.Side = asrBottom
+          Left = 254
+          Height = 23
+          Top = 8
+          Width = 50
+          Alignment = taRightJustify
+          MaxValue = 10
+          MinValue = 1
+          OnChange = edEveryNthChange
+          TabOrder = 2
+          Value = 3
+        end
+        object PointerImage: TImage
+          AnchorSideLeft.Control = cbBitmapPointer
+          AnchorSideLeft.Side = asrBottom
+          Left = 107
+          Height = 16
+          Top = 10
+          Width = 16
+          AutoSize = True
+          Picture.Data = {
+            1754506F727461626C654E6574776F726B477261706869632B02000089504E47
+            0D0A1A0A0000000D49484452000000100000001008060000001FF3FF61000000
+            017352474200AECE1CE900000006624B474400FF00FF00FFA0BDA79300000009
+            7048597300000B1300000B1301009A9C180000000774494D4507DC06140F1F36
+            F0AF9FA6000001AB4944415438CB9592416813411486BFD96EECB1D09357AF5E
+            24224868D18330117BF5604E1AC1A6EBA188500985F4D0802C22228B685BC1D6
+            532EB92849210BA145101B5A103C45BDE79243C183D0E2CEF3B0DD71D326D8FE
+            30CCCC9BFFCD9B7FDEAF18814BD71E3C17D45D4761322E6BBBEDB50AA7C554BE
+            D4CC694FBABD48BABD4872DA93EBB74A1F4E957CFEE29D8974F2FF2E5147155B
+            461C9D044B8BCFC85E18673C3366893B3F7EB3FAF489DD3BCA849F5BAB793595
+            2FB544D0EF365E7316DCBFF730528AB60B2038001466AE58C2D51BB779F4B80C
+            C0CB173E9D76DD9ED59A7B08CE98C2C4819CF62468F4A5DB8B249BCD8A483C77
+            7E1EC8FBADFD8158D0E84BD0E84B4E7B02E0027C09DF2840F4C62B6ACD3DBC05
+            1F80CEF75FB6AAB7E053AC86F10B82A524E7E8EDC7D069D72D19A0580D0724A4
+            E124120AF3CB270ED72B9AF58A3E112FCC2F6325C42D047D7992C33FC2F6B7FD
+            B318AEE5C6663003C9C56AC8D7FAA295915EFF3390196DA4617292CF3B6EA4A1
+            C4A4ADE991684E502E974777C151264C57AB054B9C73CDC734C7F77DB1128661
+            FAE65C23326A0620E3CADB4F9B2BB3C3787F01CE48DFB7D4C375300000000049
+            454E44AE426082
+          }
+        end
+      end
+    end
    object tsOscilloscope: TTabSheet
      Caption = 'Oscilloscope'
-      ClientHeight = 453
+      ClientHeight = 466
      ClientWidth = 683
      object chOscillator: TChart
        Left = 0
-        Height = 453
+        Height = 466
        Top = 0
        Width = 683
        AxisList = <        
@ -245,7 +356,6 @@ object Form1: TForm1
        )
        Align = alClient
        DoubleBuffered = True
-        ParentColor = False
        object chOscillatorLineSeries1: TLineSeries
          AxisIndexX = 1
          LinePen.Color = clLime
--- a/components/tachart/demo/line/Main.pas
+++ b/components/tachart/demo/line/Main.pas
@ -7,7 +7,7 @@ interface
 uses
  Classes, ComCtrls, ExtCtrls, Spin, StdCtrls, SysUtils, FileUtil, Forms,
  Controls, Graphics, Dialogs, TAGraph, TASeries, TASources, TATools,
-  TATransformations, TACustomSeries;
+  TATransformations, TACustomSeries, Types, TADrawUtils;

 type

@ -25,6 +25,11 @@ type
    ccsDerivative: TCalculatedChartSource;
    ccsSum: TCalculatedChartSource;
    catOscillator: TChartAxisTransformations;
+    ChartOwnerDrawnPointer: TChart;
+    PointerImage: TImage;
+    lsOwnerDrawnPointer: TLineSeries;
+    cbBitmapPointer: TCheckBox;
+    cbDrawEveryNthPointer: TCheckBox;
    chOscillator: TChart;
    chOscillatorLineSeries1: TLineSeries;
    chPointers: TChart;
@ -41,9 +46,12 @@ type
    lcsOscillator: TListChartSource;
    PageControl1: TPageControl;
    Panel1: TPanel;
+    Panel2: TPanel;
    pnlPointers: TPanel;
    RandomChartSource1: TRandomChartSource;
    sePointerSize: TSpinEdit;
+    edEveryNth: TSpinEdit;
+    tsOwnerDrawnPointer: TTabSheet;
    timOscilloscope: TTimer;
    tsOscilloscope: TTabSheet;
    tsPointers: TTabSheet;
@ -51,10 +59,14 @@ type
    procedure btnAddSeriesClick(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure cb3DChange(Sender: TObject);
+    procedure cbBitmapPointerChange(Sender: TObject);
    procedure cbLineTypeChange(Sender: TObject);
    procedure cbRotatedChange(Sender: TObject);
    procedure cbSortedChange(Sender: TObject);
+    procedure edEveryNthChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
+    procedure lsOwnerDrawnPointerOwnerDrawPointer(ASender: TChartSeries;
+      ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);
    procedure PageControl1Change(Sender: TObject);
    procedure sePointerSizeChange(Sender: TObject);
    procedure timOscilloscopeTimer(Sender: TObject);
@ -68,7 +80,7 @@ implementation
 {$R *.lfm}

 uses
-  LCLIntf, TAChartUtils, TATypes, TAEnumerators;
+  LCLIntf, IntfGraphics, TAChartUtils, TATypes, TAEnumerators;

 type
  TLineSeriesEnum =
@ -111,6 +123,15 @@ begin
    ls.Depth := 15 - ls.Depth;
 end;

+procedure TForm1.cbBitmapPointerChange(Sender: TObject);
+begin
+  if cbBitmapPointer.Checked or cbDrawEveryNthPointer.Checked then
+    lsOwnerDrawnPointer.OnOwnerDrawPointer := @lsOwnerDrawnPointerOwnerDrawPointer
+  else
+    lsOwnerDrawnPointer.OnOwnerDrawPointer := nil;
+  ChartOwnerDrawnPointer.Invalidate;
+end;
+
 procedure TForm1.cbLineTypeChange(Sender: TObject);
 var
  ls: TLineSeries;
@ -138,6 +159,11 @@ begin
      ls.ListSource.Sorted := cbSorted.Checked;
 end;

+procedure TForm1.edEveryNthChange(Sender: TObject);
+begin
+  ChartOwnerDrawnPointer.Invalidate;
+end;
+
 procedure TForm1.FormCreate(Sender: TObject);
 var
  st: TSeriesPointerStyle;
@ -161,6 +187,39 @@ begin
  end;
 end;

+procedure TForm1.lsOwnerDrawnPointerOwnerDrawPointer(ASender: TChartSeries;
+  ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);
+var
+  lineser: TLineSeries;
+
+  procedure DoDrawPointer;
+  var
+    img: TLazIntfImage;
+    bmp: TBitmap;
+  begin
+    if cbBitmapPointer.Checked then begin
+      img := TLazIntfImage.Create(0,0);
+      try
+        bmp := PointerImage.Picture.Bitmap;
+        img.LoadFromBitmap(bmp.Handle, bmp.MaskHandle);
+        ADrawer.PutImage(
+          ACenter.X - bmp.Width div 2,
+          ACenter.Y - bmp.Height div 2,
+          img
+        )
+      finally
+        img.Free;
+      end;
+    end else
+      lineser.Pointer.Draw(ADrawer, ACenter, lineser.Pointer.Brush.Color);
+  end;
+
+begin
+  lineser := TLineSeries(ASender);
+  if not cbDrawEveryNthPointer.Checked or (AIndex mod edEveryNth.Value = 0) then
+    DoDrawPointer;
+end;
+
 procedure TForm1.PageControl1Change(Sender: TObject);
 begin
  timOscilloscope.Enabled := PageControl1.ActivePage = tsOscilloscope;
--- a/components/tachart/demo/line/linedemo.lpi
+++ b/components/tachart/demo/line/linedemo.lpi
@ -1,4 +1,4 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
  <ProjectOptions>
    <Version Value="9"/>
@ -46,7 +46,6 @@
      <Unit0>
        <Filename Value="linedemo.lpr"/>
        <IsPartOfProject Value="True"/>
-        <UnitName Value="linedemo"/>
      </Unit0>
      <Unit1>
        <Filename Value="Main.pas"/>
@ -54,7 +53,6 @@
        <ComponentName Value="Form1"/>
        <HasResources Value="True"/>
        <ResourceBaseClass Value="Form"/>
-        <UnitName Value="Main"/>
      </Unit1>
    </Units>
  </ProjectOptions>
@ -75,12 +73,6 @@
        </Win32>
      </Options>
    </Linking>
-    <Other>
-      <CompilerMessages>
-        <UseMsgFile Value="True"/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
  </CompilerOptions>
  <Debugging>
    <Exceptions Count="3">
--- a/components/tachart/tacustomseries.pas
+++ b/components/tachart/tacustomseries.pas
@ -259,6 +259,9 @@ type
    function GetXRange(AX: Double; AIndex: Integer): Double;
    function GetZeroLevel: Double; virtual;
    function NearestXNumber(var AIndex: Integer; ADir: Integer): Double;
+    procedure OwnerDrawPointer(
+      ADrawer: IChartDrawer; AIndex: Integer; const APos: TPoint;
+      var AContinue: Boolean); virtual;
    procedure PrepareGraphPoints(
      const AExtent: TDoubleRect; AFilterByExtent: Boolean);
    procedure UpdateGraphPoints(AIndex: Integer); overload; inline;
@ -1092,6 +1095,7 @@ var
  i: Integer;
  p: TDoublePoint;
  ai: TPoint;
+  defaultdraw: Boolean;
 begin
  Assert(Pointer <> nil, 'Series pointer');
  if not Pointer.Visible then exit;
@ -1099,8 +1103,12 @@ begin
    p := FGraphPoints[i - FLoBound];
    if not ParentChart.IsPointInViewPort(p) then continue;
    ai := ParentChart.GraphToImage(p);
-    Pointer.Draw(ADrawer, ai, Source[i]^.Color);
-    AfterDrawPointer(ADrawer, i, ai);
+    defaultdraw := true;
+    OwnerDrawPointer(ADrawer, i, ai, defaultdraw);
+    if defaultdraw then begin
+      Pointer.Draw(ADrawer, ai, Source[i]^.Color);
+      AfterDrawPointer(ADrawer, i, ai);
+    end;
  end;
 end;

@ -1258,6 +1266,15 @@ begin
  Result := SafeNan;
 end;

+procedure TBasicPointSeries.OwnerDrawPointer(
+  ADrawer: IChartDrawer; AIndex: Integer; const APos: TPoint;
+  var AContinue: Boolean);
+begin
+  Unused(ADrawer);
+  Unused(AIndex, APos);
+  Unused(AContinue);
+end;
+
 procedure TBasicPointSeries.PrepareGraphPoints(
  const AExtent: TDoubleRect; AFilterByExtent: Boolean);
 var
--- a/components/tachart/taseries.pas
+++ b/components/tachart/taseries.pas
@ -176,6 +176,10 @@ type
    ASender: TChartSeries; ACanvas: TCanvas; AIndex: Integer;
    ACenter: TPoint) of object;

+  TSeriesPointerOwnerDrawEvent = procedure (
+    ASender: TChartSeries; ADrawer: IChartDrawer; AIndex: Integer;
+    ACenter: TPoint) of object;
+
  TLineType = (ltNone, ltFromPrevious, ltFromOrigin, ltStepXY, ltStepYX);

  { TLineSeries }
@ -185,6 +189,7 @@ type
    FLinePen: TPen;
    FLineType: TLineType;
    FOnDrawPointer: TSeriesPointerDrawEvent;
+    FOnOwnerDrawPointer: TSeriesPointerOwnerDrawEvent;
    FShowPoints: Boolean;

    procedure DrawSingleLineInStack(ADrawer: IChartDrawer; AIndex: Integer);
@ -199,6 +204,8 @@ type
      ADrawer: IChartDrawer; AIndex: Integer; const APos: TPoint); override;
    procedure GetLegendItems(AItems: TChartLegendItems); override;
    function GetSeriesColor: TColor; override;
+    procedure OwnerDrawPointer(ADrawer: IChartDrawer; AIndex: Integer;
+      const APos: TPoint; var AContinue: Boolean); override;
  public
    procedure Assign(ASource: TPersistent); override;
    constructor Create(AOwner: TComponent); override;
@ -216,7 +223,9 @@ type
      read FLineType write SetLineType default ltFromPrevious;
    property MarkPositions;
    property OnDrawPointer: TSeriesPointerDrawEvent
-      read FOnDrawPointer write FOnDrawPointer;
+      read FOnDrawPointer write FOnDrawPointer; deprecated 'Use OnOwnerDrawPointer';
+    property OnOwnerDrawPointer: TSeriesPointerOwnerDrawEvent
+      read FOnOwnerDrawPointer write FOnOwnerDrawPointer;
    property Pointer;
    property SeriesColor: TColor
      read GetSeriesColor write SetSeriesColor stored false default clBlack;
@ -610,6 +619,17 @@ begin
  Result := FLineType <> ltNone;
 end;

+procedure TLineSeries.OwnerDrawPointer(
+  ADrawer: IChartDrawer; AIndex: Integer; const APos: TPoint;
+  var AContinue: Boolean);
+begin
+  if Assigned(FOnOwnerDrawPointer) then begin
+    FOnOwnerDrawPointer(Self, ADrawer, AIndex, APos);
+    AContinue := false;
+  end else
+    AContinue := true;
+end;
+
 procedure TLineSeries.SetLinePen(AValue: TPen);
 begin
  FLinePen.Assign(AValue);