[SOLVED] Combined pointer style

[CM630]

I need to combine two pointer styles in a single point of the line series - I need to have a psCross combined with another pointer (an inbuilt or a BMP one).
I suppose this is not possible.
So I decided I shall draw two points at the same coordinates and the two points should belong to a single lineseries.
But it occurs that the .pointer.style property is one for the entire series, I cannot set different pointer style to different point of the same series.


In the example image, I have overlapped two line series, each one containing a single item (point).
The pointer style of one of them is psDiamond, and the pointer style of the other is psCross.
But maybe there is a better way?

Also: The pen style for the pointers is psDashDot, but as seen from the screenshot, the lines are solid.

[wp]

Two possibilities:

/1/ The line series has an event OnGetPointerStyle in which you can can change the pointer of individual data points. You can used it to draw the pointer of that particular data point as a cross for the first series, and as the other pointer for the second series (the second series should have Pointer.Style = psNone to avoid having two pointers of the other data points as well).

/2/ In this method you do not need a clone of the series. Because there is another event OnCustomDrawPointer which allows you to draw the pointer in an arbitrary way. It's a bit tricky, though, to draw the built-in pointers without repeating their drawing code: simply create a SeriesPointer, adjust its properties and call its Draw or DrawSize methods to paint it. Maybe like this:

Code: Pascal  [Select][+][-]

1. procedure TForm1.Chart1LineSeries1CustomDrawPointer(ASender: TChartSeries;
2.   ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);
3. var
4.   p: TSeriesPointer;
5.   ps: TSeriesPointerStyle;
6.   clr: TColor;
7.   sz: Integer;
8. begin
9.   if AIndex = 3 then
10.   begin
11.     ADrawer.SetPenParams(psSolid, clBlue, 3);
12.     ADrawer.Line(ACenter.X-10, ACenter.Y-10, ACenter.X+10, ACenter.Y+10);
13.     ADrawer.Line(ACenter.X-10, ACenter.Y+10, ACenter.X+10, ACenter.Y-10);
14.     clr := clBlue;
15.     sz := 8;
16.     ps := psCircle;
17.   end else
18.   begin
19.     clr := clRed;
20.     ps := psTriangle;
21.     sz := 5;
22.   end;
23.   p := TSeriesPointer.Create(nil);
24.   try
25.     p.Style := ps;
26.     p.HorizSize := sz;
27.     p.VertSize := sz;
28.     p.Draw(ADrawer, ACenter, clr);
29.   finally
30.     p.Free;
31.   end;
32. end;  

[CM630]

.../2/ In this method you do not need a clone of the series. Because there is another event OnCustomDrawPointer which allows you to draw the pointer in an arbitrary way. It's a bit tricky, though, to draw the built-in pointers without repeating their drawing code: simply create a SeriesPointer, adjust its properties and call its Draw or DrawSize methods to paint it...

Draw and DrawSize require and IChartDrawer, and there seem to be multiple kinds of drawers. I do not know which of them I shall use.


Without calling Draw the OnCustomDrawPointer event does not fire.

[wp]

.../2/ In this method you do not need a clone of the series. Because there is another event OnCustomDrawPointer which allows you to draw the pointer in an arbitrary way. It's a bit tricky, though, to draw the built-in pointers without repeating their drawing code: simply create a SeriesPointer, adjust its properties and call its Draw or DrawSize methods to paint it...

Draw and DrawSize require and IChartDrawer, and there seem to be multiple kinds of drawers. I do not know which of them I shall use.

The currently active drawer comes as a parameter of the event handler.

Without calling Draw the OnCustomDrawPointer event does not fire.

OnCustomdrawPointer fires during the Paint cycle whenever a pointer must be drawn. When you need the pointer at a specific occasion call Chart.Invalidate or Chart.Repaint.

Note also that the property LineSeries.Pointer.Visible (or LineSeries.ShowPoints) must be set to true, otherwise the pointer drawing procedure is not called.

I am attaching to little project which I wrote and tested before answering you post.

[CM630]

Thanks, this exceeds my expectations indeed!!!

I have simplified the code because I have a separate TLineSeries for each cursor.

Code: Pascal  [Select][+][-]

1. procedure TWaveformGraph.CursorOnCustomDrawPointer(ASender: TChartSeries; ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);
2. const
3.   CrsH= 10;
4.   CrsV= 10;
5. begin
6.   //Draw cross
7.   ADrawer.SetPenParams(psSolid, clRed, 1);
8.   ADrawer.Line(ACenter.X, ACenter.Y-CrsV, ACenter.X, ACenter.Y+CrsV); //Vertical bar
9.   ADrawer.Line(ACenter.X-CrsH, ACenter.Y, ACenter.X+CrsH, ACenter.Y); //Horizontal bar
10.  
11.   try
12.     TLineSeries(ASender).Pointer.Draw(ADrawer,ACenter,TLineSeries(ASender).Pointer.Pen.Color);
13.   except
14.  
15.   end;
16. end;

There is some more work to do, in order to apply the proper bars length, but for now it looks close to what it shall be.

But, since I have come across it, is this a bug:

...The pen style for the pointers is psDashDot, but as seen from the screenshot, the lines are solid...

[wp]

The pen style for the pointers is psDashDot, but as seen from the screenshot, the lines are solid...

Cannot reproduce this - see attachment. Please post a small project so that I can see what you are doing.

[CM630]

Now I cannot reproduce it neither 
Hopefully I was mistaken and it is not a sporadic bug.

Meanwhile I noticed that the size of the pointer is equal to HorizSize · 2 + 1.
I suppose that this is the intended behaviour.

[CM630]

Something seems wrong (a snippet is attached).
When executing the code this way everything is fine - an empty circle is drawn.
But if I uncomment //aPointer.Pen.Color := clRed; the circle is not empty anymore.
If the style is psRectangle, then the rectangle is empty in both cases, which seems to me as the expected behaviour.

Code: Pascal  [Select][+][-]

1. procedure TForm1.Chart1LineSeries1CustomDrawPointer(ASender: TChartSeries; ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);
2. var
3.   aPointer:  TSeriesPointer;
4. begin
5.   aPointer := TSeriesPointer.Create(nil);
6. //  aPointer.Pen.Color := clRed;
7.   aPointer.Brush.Style := bsClear;
8.   aPointer.VertSize := 20;
9.   aPointer.HorizSize := 20;
10.   aPointer.Style := psCircle {psRectangle};
11.   try
12.     aPointer.Draw(ADrawer,ACenter,aPointer.Pen.Color);
13.   finally
14.     aPointer.Free;
15.   end;
16. end;
17.  

Some more info: While //  aPointer.Pen.Color := clRed; is still commented, I changed aPointer.Draw(ADrawer,ACenter,aPointer.Pen.Color); to aPointer.Draw(ADrawer,ACenter,clRed); And I get a filled circle again.


(Lazarus 3.2 (rev lazarus_3_2) FPC 3.2.2 x86_64-win64-win32/win64)

[wp]

Although the code looks relatively simple the TSeriesPointer.Draw(Size) considers many parameters. One of them is the OverrideColor property of the pointer. This is a set with the possible elements ocBrush and ocPen and defaults to [ocBrush]. It means that the color specified in the Pointer.Draw(Size) method overrides the previously set brush or pen color when then corresponding element is contained in the OverrideColor property. (And note that it is a feature of the LCL that setting the brush's color automatically switches the brush.Style to bsSolid; colors should always be changed before setting the style)

In other words, when you call "aPointer.Draw(ADrawer,ACenter, aPointer.Pen.Color)" with in the default pointer setting, the color in the third parameter (aPointer.Pen.Color=clRed) will be used for drawing the pointer's fill (because OverrideColor is [ocBrush]); the previously set aPointer.Brush.Style=bsClear is ignored.

When you switch OverrideColor to an empty set, [], the override mechanism is deactivated, and the previously selected brush of the pointer is used (Brush.Style = bsClear).

When you switch OverrideColor to [ocPen] and call "aPointer.Draw(ADrawer,ACenter, clBlue)" you will have a blue-bordered empty circle although the pen.color has been set to clRed before.

I think that all this is as expected.

[CM630]

Thanks, this code seems to work for me (the inner and the outer colours are the same, which is what I need):

Code: Pascal  [Select][+][-]

1. procedure TForm1.Chart1LineSeries1CustomDrawPointer(ASender: TChartSeries; ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);
2. var
3.   aPointer:  TSeriesPointer;
4.   EmptyPointer: Boolean = True; //Change value according necessities
5. begin
6.   aPointer := TSeriesPointer.Create(nil);
7.   aPointer.Brush.Style := bsClear;
8.   aPointer.VertSize := 20;
9.   aPointer.HorizSize := 20;
10.   //Uncomment whish is necessary
11.   aPointer.Style := psCircle;
12.   //aPointer.Style := psRectangle;
13.   //aPointer.Style := psDiamond;
14.   if EmptyPointer then
15.   begin
16.     aPointer.OverrideColor:= [ocPen];
17.     aPointer.Brush.Style:=bsClear;
18.   end
19.   else
20.   begin
21.     aPointer.OverrideColor:= [ocBrush,ocPen];
22.     aPointer.Brush.Style:=bsSolid;
23.   end;
24.   try
25.     aPointer.Draw(ADrawer,ACenter,clRed);
26.   finally
27.     aPointer.Free;
28.   end;
29. end;

Actually aPointer.OverrideColor:=[***]; is needed only for the circle. Diamond and rectangle do not need it.

[wp]

Actually aPointer.OverrideColor:=[***]; is needed only for the circle. Diamond and rectangle do not need it.

Ah, I see this inconsistency now.

The problem is that psCircle is drawn by directly calling ADrawer.Circle with the previously assigned brush. The others are drawn via ADrawer.Polygon, and the decision whether a filled or an open polygon should be drawn is made by querying the pointer's Brush.Style - but this is not necessarily the same as the Drawer's style due to the LCL's internal switching to bsSolid when the color is set. It is not even clear whether all drawer classes have the same behaviour. And there is no way to determine the currently active brush style of the drawer without a lot of changes in the drawer infrastructure...

Therefore I tend to make following change in procedure TSeriesPointer.DrawSize (unit TATypes):

Code: Pascal  [Select][+][-]

1. procedure TSeriesPointer.DrawSize(ADrawer: IChartDrawer;
2.   ACenter, ASize: TPoint; AColor: TColor; AAngle: Double; ABrushAlreadySet: Boolean);
3. [...]
4. begin
5.   if not ABrushAlreadySet then begin
6.     ADrawer.Brush := Brush;
7.     if (ocBrush in OverrideColor) and (AColor <> clTAColor) then
8.       ADrawer.SetBrushParams(Brush.Style, AColor);   // <--- add this
9. //    ADrawer.BrushColor := AColor;                  // <--- remove this
10.   end;
11.   [...]

ADrawer.SetBrushParams changes the color and keeps the current brush style in the drawer. This should create consistent behaviour between all pointerstyles and drawer types.

Can you test this in your version of TAChart and report back whether it solves the issue? IIRC, this part of the code has not been changed for a long time, therefore it will not be critical which Lazarus version you are using.

After this change it should not be needed any more to touch the pointer's OverrideColor property in your sample code.

[CM630]

Code: Pascal  [Select][+][-]

1. procedure TSeriesPointer.DrawSize(ADrawer: IChartDrawer;
2.   ACenter, ASize: TPoint; AColor: TColor; AAngle: Double; ABrushAlreadySet: Boolean);
3. [...]
4. begin
5.   if not ABrushAlreadySet then begin
6.     ADrawer.Brush := Brush;
7.     if (ocBrush in OverrideColor) and (AColor <> clTAColor) then
8.       ADrawer.SetBrushParams(Brush.Style, AColor);   // <--- add this
9. //    ADrawer.BrushColor := AColor;                  // <--- remove this
10.   end;
11.   [...]

....
Can you test this in your version of TAChart and report back whether it solves the issue? IIRC, this part of the code has not been changed for a long time, therefore it will not be critical which Lazarus version you are using.

After this change it should not be needed any more to touch the pointer's OverrideColor property in your sample code.

With this change and the following code things look consistent (image attached).

Code: Pascal  [Select][+][-]

1.  
2. unit Unit1;
3.  
4.  
5. {$mode objfpc}{$H+}
6.  
7.  
8. interface
9.  
10.  
11. uses
12.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, TAGraph, TASeries, TADrawUtils, TACustomSeries,TATypes,
13.   TAChartUtils;
14.  
15.  
16. type
17.  
18.  
19.   { TForm1 }
20.  
21.  
22.   TForm1 = class(TForm)
23.     Chart1: TChart;
24.     Chart1LineSeries1: TLineSeries;
25.     procedure Chart1LineSeries1CustomDrawPointer(ASender: TChartSeries;
26.       ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);
27.     procedure FormCreate(Sender: TObject);
28.   private
29.  
30.  
31.   public
32.  
33.  
34.   end;
35.  
36.  
37. var
38.   Form1: TForm1;
39.  
40.  
41. implementation
42.  
43.  
44. {$R *.lfm}
45.  
46.  
47. { TForm1 }
48.  
49.  
50. procedure TForm1.FormCreate(Sender: TObject);
51. begin
52.   with Chart1.BottomAxis.Range do
53.   begin
54.     UseMin := True;
55.     UseMax := True;
56.     Min := 4;
57.     Max := 16;
58.   end; //with
59.   with Chart1.LeftAxis.Range do
60.   begin
61.     UseMin := True;
62.     UseMax := True;
63.     Min := 4;
64.     Max := 10;
65.   end; //with
66.  
67.  
68.   Chart1LineSeries1.ShowLines := False;
69.   Chart1LineSeries1.AddXY (5,5);
70.   Chart1LineSeries1.AddXY (6,6);
71.   Chart1LineSeries1.AddXY (7,7);
72.   Chart1LineSeries1.AddXY (8,8);
73.   Chart1LineSeries1.AddXY (9,9);
74.  
75.  
76.   Chart1LineSeries1.AddXY (10,5);
77.   Chart1LineSeries1.AddXY (11,6);
78.   Chart1LineSeries1.AddXY (12,7);
79.   Chart1LineSeries1.AddXY (13,8);
80.   Chart1LineSeries1.AddXY (14,9);
81. end;
82.  
83.  
84. procedure TForm1.Chart1LineSeries1CustomDrawPointer(ASender: TChartSeries; ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);
85. var
86.   aPointer:  TSeriesPointer;
87.   EmptyPointer: Boolean = True; //Change value according necessities
88. begin
89.   ADrawer.SetPenParams(psSolid, clBlue, 1);
90.   ADrawer.Line(ACenter.X, ACenter.Y, ACenter.X, ACenter.Y);
91.  
92.  
93.   aPointer := TSeriesPointer.Create(nil);
94.   aPointer.Brush.Style := bsClear;
95.   aPointer.Pen.Color := clGreen;
96.   aPointer.VertSize := 10;
97.   aPointer.HorizSize := 10;
98.   case AIndex of
99.     0,5: aPointer.Style := psCircle;
100.     1,6: aPointer.Style := psRectangle;
101.     2,7: aPointer.Style := psDiamond;
102.     3,8: aPointer.Style := psFullStar;
103.     4,9: aPointer.Style := psTriangle;
104.   end;
105.  
106.  
107.   EmptyPointer := AIndex < 5;
108.   if EmptyPointer
109.     then aPointer.Brush.Style:=bsClear
110.     else aPointer.Brush.Style:=bsSolid;
111.   try
112.     aPointer.Draw(ADrawer,ACenter,clRed);
113.   finally
114.     aPointer.Free;
115.   end;
116.  
117.  
118.   if AIndex > 4 then
119.   begin
120.     ADrawer.SetPenParams(psSolid, clNone, 2);
121.     ADrawer.Line(ACenter.X-5, ACenter.Y-5, ACenter.X+5, ACenter.Y+5);
122.     ADrawer.Line(ACenter.X-5, ACenter.Y+5, ACenter.X+5, ACenter.Y-5);
123.   end;
124. end;
125.  
126.  
127. end.
128.  
129.  
130.  

There is something which is maybe not right:

Code: Pascal  [Select][+][-]

1.   ADrawer.SetPenParams(psSolid, clBlue, 1);
2.   ADrawer.Line(ACenter.X, ACenter.Y, ACenter.X, ACenter.Y);

I expected this to draw a single dot in the centre of the point. But it does not.
It does if I change ADrawer.SetPenParams(psSolid, clBlue, 1); to ADrawer.SetPenParams(psSolid, clBlue, 2);
Is this how it shall be?

And I wonder about something else.
Can I erase from a shape? For example there is a case when I need a transparrent cross in a shape.
The code below draws white nontransparrent crosses:

Code: Pascal  [Select][+][-]

1.   if AIndex > 4 then
2.   begin
3.     ADrawer.SetPenParams(psSolid, clNone, 2);
4.     ADrawer.Line(ACenter.X-5, ACenter.Y-5, ACenter.X+5, ACenter.Y+5);
5.     ADrawer.Line(ACenter.X-5, ACenter.Y+5, ACenter.X+5, ACenter.Y-5);
6.   end;

[wp]

With this change and the following code things look consistent (image attached).

Thanks for testing. I committed it to Laz/main, and it will be backported to Fixes and contained in Laz 3.4.

I expected this to draw a single dot in the centre of the point. But it does not.

This relates to an elemental feature in graphics. When I draw I line with the start and end point coordinates x=0 and x=5, it will set the pixels at 0, 1, 2, 3, 4. Because this way you can add a uninterrupted and non-overlapping second line from 5 to 10 without further considerations of duplicate pixels (it will contain the pixels 5, 6, ... 9). There were some discussions about this feature here recently.

Having this in mind you can draw a single pixel by means of the Line command when you call Drawer.Line(ACenter.X, ACenter.Y, ACenter.X+1, ACenter.Y+1).

Alternatively, however, there is a simpler way. Just call the drawer's PutPixel: Drawer.PutPixel(ACenter.X, ACenter.Y, color).

Maybe I should list the methods available from the ChartDrawer here:

Code: Pascal  [Select][+][-]

1. type
2.   IChartDrawer = interface
3.     ['{6D8E5591-6788-4D2D-9FE6-596D5157C3C3}']
4.     procedure AddToFontOrientation(ADelta: Integer);
5.     procedure ClippingStart(const AClipRect: TRect);
6.     procedure ClippingStart;
7.     procedure ClippingStop;
8.     procedure DrawingBegin(const ABoundingBox: TRect);
9.     procedure DrawingEnd;
10.     procedure DrawLineDepth(AX1, AY1, AX2, AY2, ADepth: Integer);
11.     procedure DrawLineDepth(const AP1, AP2: TPoint; ADepth: Integer);
12.     procedure Ellipse(AX1, AY1, AX2, AY2: Integer);
13.     procedure FillRect(AX1, AY1, AX2, AY2: Integer);
14.     function GetBrushColor: TChartColor;
15.     function GetFontAngle: Double;       // in radians
16.     function GetFontColor: TFPColor;
17.     function GetFontName: String;
18.     function GetFontSize: Integer;
19.     function GetFontStyle: TChartFontStyles;
20.     function GetPenColor: TChartColor;
21.     procedure SetDoChartColorToFPColorFunc(AValue: TChartColorToFPColorFunc);
22.     procedure Line(AX1, AY1, AX2, AY2: Integer);
23.     procedure Line(const AP1, AP2: TPoint);
24.     procedure LineTo(AX, AY: Integer);
25.     procedure LineTo(const AP: TPoint);
26.     procedure MoveTo(AX, AY: Integer);
27.     procedure MoveTo(const AP: TPoint);
28.     procedure Polygon(
29.       const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
30.     procedure Polyline(
31.       const APoints: array of TPoint; AStartIndex, ANumPts: Integer);
32.     procedure PrepareSimplePen(AColor: TChartColor);
33.     procedure PutImage(AX, AY: Integer; AImage: TFPCustomImage);
34.     procedure PutPixel(AX, AY: Integer; AColor: TChartColor);
35.     procedure RadialPie(
36.       AX1, AY1, AX2, AY2: Integer;
37.       AStartAngle16Deg, AAngleLength16Deg: Integer);
38.     procedure Rectangle(const ARect: TRect);
39.     procedure Rectangle(AX1, AY1, AX2, AY2: Integer);
40.     procedure ResetFont;
41.     function Scale(ADistance: Integer): Integer;
42.     procedure SetAntialiasingMode(AValue: TChartAntialiasingMode);
43.     procedure SetBrush(ABrush: TFPCustomBrush);
44.     procedure SetBrushColor(AColor: TChartColor);
45.     procedure SetBrushParams(AStyle: TFPBrushStyle; AColor: TChartColor);
46.     procedure SetFont(AValue: TFPCustomFont);
47.     procedure SetGetFontOrientationFunc(AValue: TGetFontOrientationFunc);
48.     procedure SetMonochromeColor(AColor: TChartColor);
49.     procedure SetPen(APen: TFPCustomPen);
50.     procedure SetPenColor(AColor: TChartColor);
51.     procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor; AWidth: Integer = 1);
52.     procedure SetPenWidth(AWidth: Integer);
53.     function GetRightToLeft: Boolean;
54.     procedure SetRightToLeft(AValue: Boolean);
55.     procedure SetTransparency(ATransparency: TChartTransparency);
56.     procedure SetXor(AXor: Boolean);
57.     function TextExtent(const AText: String;
58.       ATextFormat: TChartTextFormat = tfNormal): TPoint;
59.     function TextExtent(AText: TStrings;
60.       ATextFormat: TChartTextFormat = tfNormal): TPoint;
61.     function TextOut: TChartTextOut;
62.  
63.     property Brush: TFPCustomBrush write SetBrush;
64.     property BrushColor: TChartColor read GetBrushColor write SetBrushColor;
65.     property Font: TFPCustomFont write SetFont;
66.     property Pen: TFPCustomPen write SetPen;
67.     property DoChartColorToFPColor: TChartColorToFPColorFunc
68.       write SetDoChartColorToFPColorFunc;
69.     property DoGetFontOrientation: TGetFontOrientationFunc
70.       write SetGetFontOrientationFunc;
71.   end;

Can I erase from a shape?

Hmmm... My gut feeling tells me that this is not possible in the approach discussed so far, at least not for the LCL drawer which does not support alpha channel transparency.

I would follow a different approach here. Since the drawers have a PutImage method to draw a TFPCustomImage-descendant image you can first draw the image to a memory image (which does support alpha transparency), erase the parts needed by drawing with a fully transparent color, and then have the Drawer paint this image as cursor. See attached modification of your project.

Of course, rather than creating a new pointer for every data point, you should create the pointers at program start and then in the OnCustomdrawPointer just draw that bitmap. Or you can even use a pointer bitmap made by an external program (anti-aliasing of lines) -- there are many possibilities once you understood the basic principle.

[CM630]

Things seem to work as they need to, it is time to set the thread to solved