Forum > TAChart
[SOLVED] Combined pointer style
wp:
--- Quote from: CM630 on March 20, 2024, 07:59:59 pm ---Actually aPointer.OverrideColor:=[***]; is needed only for the circle. Diamond and rectangle do not need it.
--- End quote ---
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TSeriesPointer.DrawSize(ADrawer: IChartDrawer; ACenter, ASize: TPoint; AColor: TColor; AAngle: Double; ABrushAlreadySet: Boolean);[...]begin if not ABrushAlreadySet then begin ADrawer.Brush := Brush; if (ocBrush in OverrideColor) and (AColor <> clTAColor) then ADrawer.SetBrushParams(Brush.Style, AColor); // <--- add this// ADrawer.BrushColor := AColor; // <--- remove this end; [...]
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:
--- Quote from: wp on March 20, 2024, 10:44:18 pm ---
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---procedure TSeriesPointer.DrawSize(ADrawer: IChartDrawer; ACenter, ASize: TPoint; AColor: TColor; AAngle: Double; ABrushAlreadySet: Boolean);[...]begin if not ABrushAlreadySet then begin ADrawer.Brush := Brush; if (ocBrush in OverrideColor) and (AColor <> clTAColor) then ADrawer.SetBrushParams(Brush.Style, AColor); // <--- add this// ADrawer.BrushColor := AColor; // <--- remove this end; [...]
....
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.
--- End quote ---
With this change and the following code things look consistent (image attached).
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, TAGraph, TASeries, TADrawUtils, TACustomSeries,TATypes, TAChartUtils; type { TForm1 } TForm1 = class(TForm) Chart1: TChart; Chart1LineSeries1: TLineSeries; procedure Chart1LineSeries1CustomDrawPointer(ASender: TChartSeries; ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint); procedure FormCreate(Sender: TObject); private public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin with Chart1.BottomAxis.Range do begin UseMin := True; UseMax := True; Min := 4; Max := 16; end; //with with Chart1.LeftAxis.Range do begin UseMin := True; UseMax := True; Min := 4; Max := 10; end; //with Chart1LineSeries1.ShowLines := False; Chart1LineSeries1.AddXY (5,5); Chart1LineSeries1.AddXY (6,6); Chart1LineSeries1.AddXY (7,7); Chart1LineSeries1.AddXY (8,8); Chart1LineSeries1.AddXY (9,9); Chart1LineSeries1.AddXY (10,5); Chart1LineSeries1.AddXY (11,6); Chart1LineSeries1.AddXY (12,7); Chart1LineSeries1.AddXY (13,8); Chart1LineSeries1.AddXY (14,9);end; procedure TForm1.Chart1LineSeries1CustomDrawPointer(ASender: TChartSeries; ADrawer: IChartDrawer; AIndex: Integer; ACenter: TPoint);var aPointer: TSeriesPointer; EmptyPointer: Boolean = True; //Change value according necessitiesbegin ADrawer.SetPenParams(psSolid, clBlue, 1); ADrawer.Line(ACenter.X, ACenter.Y, ACenter.X, ACenter.Y); aPointer := TSeriesPointer.Create(nil); aPointer.Brush.Style := bsClear; aPointer.Pen.Color := clGreen; aPointer.VertSize := 10; aPointer.HorizSize := 10; case AIndex of 0,5: aPointer.Style := psCircle; 1,6: aPointer.Style := psRectangle; 2,7: aPointer.Style := psDiamond; 3,8: aPointer.Style := psFullStar; 4,9: aPointer.Style := psTriangle; end; EmptyPointer := AIndex < 5; if EmptyPointer then aPointer.Brush.Style:=bsClear else aPointer.Brush.Style:=bsSolid; try aPointer.Draw(ADrawer,ACenter,clRed); finally aPointer.Free; end; if AIndex > 4 then begin ADrawer.SetPenParams(psSolid, clNone, 2); ADrawer.Line(ACenter.X-5, ACenter.Y-5, ACenter.X+5, ACenter.Y+5); ADrawer.Line(ACenter.X-5, ACenter.Y+5, ACenter.X+5, ACenter.Y-5); end;end; end.
There is something which is maybe not right:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- ADrawer.SetPenParams(psSolid, clBlue, 1); 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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} --- if AIndex > 4 then begin ADrawer.SetPenParams(psSolid, clNone, 2); ADrawer.Line(ACenter.X-5, ACenter.Y-5, ACenter.X+5, ACenter.Y+5); ADrawer.Line(ACenter.X-5, ACenter.Y+5, ACenter.X+5, ACenter.Y-5); end;
wp:
--- Quote from: CM630 on March 22, 2024, 07:30:48 pm ---With this change and the following code things look consistent (image attached).
--- End quote ---
Thanks for testing. I committed it to Laz/main, and it will be backported to Fixes and contained in Laz 3.4.
--- Quote from: CM630 on March 22, 2024, 07:30:48 pm ---I expected this to draw a single dot in the centre of the point. But it does not.
--- End quote ---
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---type IChartDrawer = interface ['{6D8E5591-6788-4D2D-9FE6-596D5157C3C3}'] procedure AddToFontOrientation(ADelta: Integer); procedure ClippingStart(const AClipRect: TRect); procedure ClippingStart; procedure ClippingStop; procedure DrawingBegin(const ABoundingBox: TRect); procedure DrawingEnd; procedure DrawLineDepth(AX1, AY1, AX2, AY2, ADepth: Integer); procedure DrawLineDepth(const AP1, AP2: TPoint; ADepth: Integer); procedure Ellipse(AX1, AY1, AX2, AY2: Integer); procedure FillRect(AX1, AY1, AX2, AY2: Integer); function GetBrushColor: TChartColor; function GetFontAngle: Double; // in radians function GetFontColor: TFPColor; function GetFontName: String; function GetFontSize: Integer; function GetFontStyle: TChartFontStyles; function GetPenColor: TChartColor; procedure SetDoChartColorToFPColorFunc(AValue: TChartColorToFPColorFunc); procedure Line(AX1, AY1, AX2, AY2: Integer); procedure Line(const AP1, AP2: TPoint); procedure LineTo(AX, AY: Integer); procedure LineTo(const AP: TPoint); procedure MoveTo(AX, AY: Integer); procedure MoveTo(const AP: TPoint); procedure Polygon( const APoints: array of TPoint; AStartIndex, ANumPts: Integer); procedure Polyline( const APoints: array of TPoint; AStartIndex, ANumPts: Integer); procedure PrepareSimplePen(AColor: TChartColor); procedure PutImage(AX, AY: Integer; AImage: TFPCustomImage); procedure PutPixel(AX, AY: Integer; AColor: TChartColor); procedure RadialPie( AX1, AY1, AX2, AY2: Integer; AStartAngle16Deg, AAngleLength16Deg: Integer); procedure Rectangle(const ARect: TRect); procedure Rectangle(AX1, AY1, AX2, AY2: Integer); procedure ResetFont; function Scale(ADistance: Integer): Integer; procedure SetAntialiasingMode(AValue: TChartAntialiasingMode); procedure SetBrush(ABrush: TFPCustomBrush); procedure SetBrushColor(AColor: TChartColor); procedure SetBrushParams(AStyle: TFPBrushStyle; AColor: TChartColor); procedure SetFont(AValue: TFPCustomFont); procedure SetGetFontOrientationFunc(AValue: TGetFontOrientationFunc); procedure SetMonochromeColor(AColor: TChartColor); procedure SetPen(APen: TFPCustomPen); procedure SetPenColor(AColor: TChartColor); procedure SetPenParams(AStyle: TFPPenStyle; AColor: TChartColor; AWidth: Integer = 1); procedure SetPenWidth(AWidth: Integer); function GetRightToLeft: Boolean; procedure SetRightToLeft(AValue: Boolean); procedure SetTransparency(ATransparency: TChartTransparency); procedure SetXor(AXor: Boolean); function TextExtent(const AText: String; ATextFormat: TChartTextFormat = tfNormal): TPoint; function TextExtent(AText: TStrings; ATextFormat: TChartTextFormat = tfNormal): TPoint; function TextOut: TChartTextOut; property Brush: TFPCustomBrush write SetBrush; property BrushColor: TChartColor read GetBrushColor write SetBrushColor; property Font: TFPCustomFont write SetFont; property Pen: TFPCustomPen write SetPen; property DoChartColorToFPColor: TChartColorToFPColorFunc write SetDoChartColorToFPColorFunc; property DoGetFontOrientation: TGetFontOrientationFunc write SetGetFontOrientationFunc; end;
--- Quote from: CM630 on March 22, 2024, 07:30:48 pm ---Can I erase from a shape?
--- End quote ---
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 :D
Navigation
[0] Message Index
[*] Previous page