{ /*************************************************************************** TATypes.pas ----------- Component Library Standard Graph Element Types ***************************************************************************/ ***************************************************************************** See the file COPYING.modifiedLGPL.txt, included in this distribution, for details about the license. ***************************************************************************** Authors: Luнs Rodrigues, Philippe Martinole, Alexander Klenin } unit TATypes; {$H+} interface uses Classes, Graphics, Controls, FPCanvas, TAChartUtils, TADrawUtils; const DEF_MARGIN = 4; DEF_MARKS_DISTANCE = 20; DEF_POINTER_SIZE = 4; MARKS_YINDEX_ALL = -1; DEF_ARROW_LENGTH = 10; DEF_ARROW_WIDTH = 5; DEF_SHADOW_OFFSET = 8; DEF_SHADOW_TRANSPARENCY = 128; // Constants for Chart.Notify commands CMD_QUERY_SERIESEXTENT = 0; type TCustomChart = class(TCustomControl) public procedure Notify(ACommand: Integer; AParam1, AParam2: Pointer; var Data); virtual; abstract; procedure StyleChanged(Sender: TObject); virtual; abstract; procedure ZoomFull(AImmediateRecalc: Boolean = false); virtual; abstract; end; { TChartPen } TChartPen = class(TPen) strict private FVisible: Boolean; procedure SetVisible(AValue: Boolean); public constructor Create; override; public procedure Assign(ASource: TPersistent); override; function EffVisible: Boolean; inline; published property Visible: Boolean read FVisible write SetVisible default true; end; TClearBrush = class(TBrush) published property Style default bsClear; end; TFPCanvasHelperClass = class of TFPCanvasHelper; { TChartElement } TChartElement = class(TPersistent) strict protected FOwner: TCustomChart; FVisible: Boolean; procedure InitHelper(var AResult; AClass: TFPCanvasHelperClass); procedure SetVisible(AValue: Boolean); procedure StyleChanged(Sender: TObject); virtual; protected function GetOwner: TPersistent; override; public constructor Create(AOwner: TCustomChart); public procedure Assign(ASource: TPersistent); override; procedure SetOwner(AOwner: TCustomChart); property Visible: Boolean read FVisible write SetVisible; end; TSeriesPointerStyle = ( psNone, psRectangle, psCircle, psCross, psDiagCross, psStar, psLowBracket, psHighBracket, psLeftBracket, psRightBracket, psDiamond, psTriangle, psLeftTriangle, psRightTriangle, psVertBar, psHorBar, psPoint); { TSeriesPointer } TSeriesPointer = class(TChartElement) strict private FBrush: TBrush; FHorizSize: Integer; FOverrideColor: TOverrideColors; FPen: TChartPen; FStyle: TSeriesPointerStyle; FVertSize: Integer; procedure SetBrush(AValue: TBrush); procedure SetHorizSize(AValue: Integer); procedure SetOverrideColor(AValue: TOverrideColors); procedure SetPen(AValue: TChartPen); procedure SetStyle(AValue: TSeriesPointerStyle); procedure SetVertSize(AValue: Integer); public constructor Create(AOwner: TCustomChart); destructor Destroy; override; public procedure Assign(Source: TPersistent); override; procedure Draw(ADrawer: IChartDrawer; ACenter: TPoint; AColor: TColor); procedure DrawSize( ADrawer: IChartDrawer; ACenter, ASize: TPoint; AColor: TColor; AAngle: Double = 0.0); published property Brush: TBrush read FBrush write SetBrush; property HorizSize: Integer read FHorizSize write SetHorizSize default DEF_POINTER_SIZE; property OverrideColor: TOverrideColors read FOverrideColor write SetOverrideColor default [ocBrush]; property Pen: TChartPen read FPen write SetPen; property Style: TSeriesPointerStyle read FStyle write SetStyle default psRectangle; property VertSize: Integer read FVertSize write SetVertSize default DEF_POINTER_SIZE; property Visible default true; end; EExtentError = class(EChartError); TChartRange = class(TChartElement) strict private FBounds: array [1..2] of Double; FUseBounds: array [1..2] of Boolean; function GetBounds(AIndex: Integer): Double; function GetUseBounds(AIndex: integer): Boolean; function IsBoundsStored(AIndex: Integer): Boolean; procedure SetBounds(AIndex: Integer; const AValue: Double); procedure SetUseBounds(AIndex: Integer; AValue: Boolean); public procedure Assign(ASource: TPersistent); override; procedure CheckBoundsOrder; procedure Intersect(var AMin, AMax: Double); published property Max: Double index 2 read GetBounds write SetBounds stored IsBoundsStored; property Min: Double index 1 read GetBounds write SetBounds stored IsBoundsStored; property UseMax: Boolean index 2 read GetUseBounds write SetUseBounds default false; property UseMin: Boolean index 1 read GetUseBounds write SetUseBounds default false; end; { TChartExtent } TChartExtent = class(TChartElement) strict private FExtent: TDoubleRect; FUseBounds: array [1..4] of Boolean; function GetBounds(AIndex: Integer): Double; function GetUseBounds(AIndex: integer): Boolean; function IsBoundsStored(AIndex: Integer): Boolean; procedure SetBounds(AIndex: Integer; const AValue: Double); procedure SetUseBounds(AIndex: Integer; AValue: Boolean); public procedure Assign(ASource: TPersistent); override; procedure CheckBoundsOrder; procedure FixTo(const ABounds: TDoubleRect); published property UseXMax: Boolean index 3 read GetUseBounds write SetUseBounds default false; property UseXMin: Boolean index 1 read GetUseBounds write SetUseBounds default false; property UseYMax: Boolean index 4 read GetUseBounds write SetUseBounds default false; property UseYMin: Boolean index 2 read GetUseBounds write SetUseBounds default false; property XMax: Double index 3 read GetBounds write SetBounds stored IsBoundsStored; property XMin: Double index 1 read GetBounds write SetBounds stored IsBoundsStored; property YMax: Double index 4 read GetBounds write SetBounds stored IsBoundsStored; property YMin: Double index 2 read GetBounds write SetBounds stored IsBoundsStored; end; TChartExtentHistory = specialize THistory; TRectArray = array [1..4] of Integer; { TChartMargins } TChartMargins = class(TChartElement) strict private FData: record case Integer of 0: (FRect: TRect;); 1: (FCoords: TRectArray;); end; public constructor Create(AOwner: TCustomChart); function GetValue(AIndex: Integer): Integer; procedure SetValue(AIndex: Integer; AValue: TChartDistance); public procedure Assign(Source: TPersistent); override; procedure ExpandRectScaled(ADrawer: IChartDrawer; var ARect: TRect); property Data: TRect read FData.FRect; published property Left: TChartDistance index 1 read GetValue write SetValue default DEF_MARGIN; property Top: TChartDistance index 2 read GetValue write SetValue default DEF_MARGIN; property Right: TChartDistance index 3 read GetValue write SetValue default DEF_MARGIN; property Bottom: TChartDistance index 4 read GetValue write SetValue default DEF_MARGIN; end; TChartArrow = class(TChartElement) strict private FBaseLength: TChartDistance; FInverted: Boolean; FLength: TChartDistance; FWidth: TChartDistance; procedure SetBaseLength(AValue: TChartDistance); procedure SetInverted(AValue: Boolean); procedure SetLength(AValue: TChartDistance); procedure SetWidth(AValue: TChartDistance); public constructor Create(AOwner: TCustomChart); public procedure Assign(ASource: TPersistent); override; procedure Draw( ADrawer: IChartDrawer; const AEndPos: TPoint; AAngle: Double; APen: TFPCustomPen); published property BaseLength: TChartDistance read FBaseLength write SetBaseLength default 0; property Inverted: Boolean read FInverted write SetInverted default false; property Length: TChartDistance read FLength write SetLength default DEF_ARROW_LENGTH; property Visible default false; property Width: TChartDistance read FWidth write SetWidth default DEF_ARROW_WIDTH; end; TChartShadow = class(TChartElement) strict private FColor: TColor; FOffset: TPoint; FTransparency: TChartTransparency; procedure SetColor(AValue: TColor); procedure SetOffsetX(AValue: Integer); procedure SetOffsetY(AValue: Integer); procedure SetTransparency(AValue: TChartTransparency); public constructor Create(AOwner: TCustomChart); public procedure Assign(ASource: TPersistent); override; published property Color: TColor read FColor write SetColor default clBlack; property OffsetX: Integer read FOffset.X write SetOffsetX default DEF_SHADOW_OFFSET; property OffsetY: Integer read FOffset.Y write SetOffsetY default DEF_SHADOW_OFFSET; property Transparency: TChartTransparency read FTransparency write SetTransparency default DEF_SHADOW_TRANSPARENCY; property Visible default false; end; implementation uses Math, SysUtils, TAGeometry; { TChartPen } procedure TChartPen.Assign(ASource: TPersistent); begin if ASource is TChartPen then FVisible := TChartPen(ASource).Visible; inherited Assign(ASource); end; constructor TChartPen.Create; begin inherited Create; SetPropDefaults(Self, ['Color', 'Style', 'Visible']); end; function TChartPen.EffVisible: Boolean; begin Result := Visible and (Style <> psClear); end; procedure TChartPen.SetVisible(AValue: Boolean); begin FVisible := AValue; if Assigned(OnChange) then OnChange(Self); end; { TChartElement } procedure TChartElement.Assign(ASource: TPersistent); begin if ASource is TChartElement then with TChartElement(ASource) do begin Self.FVisible := FVisible; Self.FOwner := FOwner; end; end; constructor TChartElement.Create(AOwner: TCustomChart); begin inherited Create; FOwner := AOwner; end; function TChartElement.GetOwner: TPersistent; begin Result := FOwner; end; procedure TChartElement.InitHelper(var AResult; AClass: TFPCanvasHelperClass); begin TFPCanvasHelper(AResult) := AClass.Create; TFPCanvasHelper(AResult).OnChange := @StyleChanged; end; procedure TChartElement.SetOwner(AOwner: TCustomChart); begin FOwner := AOwner; end; procedure TChartElement.SetVisible(AValue: Boolean); begin if FVisible = AValue then exit; FVisible := AValue; StyleChanged(Self); end; procedure TChartElement.StyleChanged(Sender: TObject); begin if FOwner <> nil then FOwner.StyleChanged(Sender); end; { TSeriesPointer } procedure TSeriesPointer.Assign(Source: TPersistent); begin if Source is TSeriesPointer then with TSeriesPointer(Source) do begin Self.FBrush.Assign(Brush); Self.FHorizSize := HorizSize; Self.FOverrideColor := OverrideColor; Self.FPen.Assign(Pen); Self.FStyle := Style; Self.FVertSize := VertSize; end; inherited Assign(Source); end; constructor TSeriesPointer.Create(AOwner: TCustomChart); begin inherited Create(AOwner); InitHelper(FBrush, TBrush); InitHelper(FPen, TChartPen); FHorizSize := DEF_POINTER_SIZE; SetPropDefaults(Self, ['OverrideColor', 'Style']); FVertSize := DEF_POINTER_SIZE; FVisible := true; end; destructor TSeriesPointer.Destroy; begin FreeAndNil(FBrush); FreeAndNil(FPen); inherited; end; procedure TSeriesPointer.Draw( ADrawer: IChartDrawer; ACenter: TPoint; AColor: TColor); begin DrawSize(ADrawer, ACenter, Point(ADrawer.Scale(HorizSize), ADrawer.Scale(VertSize)), AColor ); end; procedure TSeriesPointer.DrawSize(ADrawer: IChartDrawer; ACenter, ASize: TPoint; AColor: TColor; AAngle: Double); function PointByIndex(AIndex: Char): TPoint; inline; // 7--8--9 // 4 5 6 // 1--2--3 const V: array ['1'..'9'] of -1..1 = (1, 1, 1, 0, 0, 0, -1, -1, -1); H: array ['1'..'9'] of -1..1 = (-1, 0, 1, -1, 0, 1, -1, 0, 1); begin Result := ACenter + RotatePoint( Point(H[AIndex] * ASize.X, V[AIndex] * ASize.Y), AAngle); end; procedure DrawByString(const AStr: String); var pts: array of TPoint; i: Integer; j: Integer = 0; begin SetLength(pts, Length(AStr)); for i := 1 to Length(AStr) do begin if AStr[i] = ' ' then begin if Brush.Style = bsClear then ADrawer.Polyline(pts, 0, j) else ADrawer.Polygon(pts, 0, j); // Winding? j := 0; end else begin pts[j] := PointByIndex(AStr[i]); Inc(j); end; end; end; const DRAW_STRINGS: array [TSeriesPointerStyle] of String = ( // psNone, psRectangle, psCircle, psCross, psDiagCross, psStar, // psLowBracket, psHighBracket, psLeftBracket, psRightBracket, psDiamond, // psTriangle, psLeftTriangle, psRightTriangle, psVertBar, psHorBar, psPoint '', '17931', '', '28 46', '19 73', '28 46 19 73', '41236', '47896', '87412', '89632', '84268', '183', '842', '862', '82', '46', ''); begin ADrawer.Brush := Brush; if (ocBrush in OverrideColor) and (AColor <> clTAColor) then ADrawer.BrushColor := AColor; ADrawer.Pen := Pen; if (ocPen in OverrideColor) and (AColor <> clTAColor) then ADrawer.SetPenParams(Pen.Style, AColor); if Style = psPoint then ADrawer.PutPixel(ACenter.X, ACenter.Y, Pen.Color) else if Style = psCircle then ADrawer.Ellipse( ACenter.X - ASize.X, ACenter.Y - ASize.Y, ACenter.X + ASize.X + 1, ACenter.Y + ASize.Y + 1) else DrawByString(DRAW_STRINGS[Style] + ' '); end; procedure TSeriesPointer.SetBrush(AValue: TBrush); begin FBrush.Assign(AValue); StyleChanged(Self); end; procedure TSeriesPointer.SetHorizSize(AValue: Integer); begin if FHorizSize = AValue then exit; FHorizSize := AValue; StyleChanged(Self); end; procedure TSeriesPointer.SetOverrideColor(AValue: TOverrideColors); begin if FOverrideColor = AValue then exit; FOverrideColor := AValue; StyleChanged(Self); end; procedure TSeriesPointer.SetPen(AValue: TChartPen); begin FPen.Assign(AValue); StyleChanged(Self); end; procedure TSeriesPointer.SetStyle(AValue: TSeriesPointerStyle); begin if FStyle = AValue then exit; FStyle := AValue; StyleChanged(Self); end; procedure TSeriesPointer.SetVertSize(AValue: Integer); begin if FVertSize = AValue then exit; FVertSize := AValue; StyleChanged(Self); end; { TChartRange } procedure TChartRange.Assign(ASource: TPersistent); begin if ASource is TChartRange then with TChartRange(ASource) do begin Self.FBounds := FBounds; Self.FUseBounds := FUseBounds; end; inherited Assign(ASource); end; procedure TChartRange.CheckBoundsOrder; begin if UseMin and UseMax and (Min >= Max) then begin UseMin := false; UseMax := false; raise EExtentError.Create('ChartRange: Min >= Max'); end; end; function TChartRange.GetBounds(AIndex: Integer): Double; begin Result := FBounds[AIndex]; end; function TChartRange.GetUseBounds(AIndex: integer): Boolean; begin Result := FUseBounds[AIndex]; end; procedure TChartRange.Intersect(var AMin, AMax: Double); begin if UseMin and (Min > AMin) then AMin := Min; if UseMax and (Max < AMax)then AMax := Max; end; function TChartRange.IsBoundsStored(AIndex: Integer): Boolean; begin Result := FBounds[AIndex] <> 0; end; procedure TChartRange.SetBounds(AIndex: Integer; const AValue: Double); begin FBounds[AIndex] := AValue; StyleChanged(Self); end; procedure TChartRange.SetUseBounds(AIndex: Integer; AValue: Boolean); begin FUseBounds[AIndex] := AValue; StyleChanged(Self); end; { TChartExtent } procedure TChartExtent.Assign(ASource: TPersistent); begin if ASource is TChartExtent then with TChartExtent(ASource) do begin Self.FExtent := FExtent; Self.FUseBounds := FUseBounds; end; inherited Assign(ASource); end; procedure TChartExtent.CheckBoundsOrder; begin if UseXMin and UseXMax and (XMin >= XMax) then begin UseXMin := false; UseXMax := false; raise EExtentError.Create('ChartExtent: XMin >= XMax'); end; if UseYMin and UseYMax and (YMin >= YMax) then begin UseYMin := false; UseYMax := false; raise EExtentError.Create('ChartExtent: YMin >= YMax'); end; end; procedure TChartExtent.FixTo(const ABounds: TDoubleRect); begin FExtent := ABounds; FillChar(FUseBounds, SizeOf(FUseBounds), true); StyleChanged(Self); end; function TChartExtent.GetBounds(AIndex: Integer): Double; begin Result := FExtent.coords[AIndex]; end; function TChartExtent.GetUseBounds(AIndex: Integer): Boolean; begin Result := FUseBounds[AIndex]; end; function TChartExtent.IsBoundsStored(AIndex: Integer): Boolean; begin Result := FExtent.coords[AIndex] <> 0; end; procedure TChartExtent.SetBounds(AIndex: Integer; const AValue: Double); begin FExtent.coords[AIndex] := AValue; StyleChanged(Self); end; procedure TChartExtent.SetUseBounds(AIndex: Integer; AValue: Boolean); begin FUseBounds[AIndex] := AValue; StyleChanged(Self); end; { TChartMargins } procedure TChartMargins.Assign(Source: TPersistent); begin if Source is TChartMargins then TChartMargins(Source).FData.FRect := Data; inherited Assign(Source); end; constructor TChartMargins.Create(AOwner: TCustomChart); begin inherited Create(AOwner); SetPropDefaults(Self, ['Left', 'Top', 'Right', 'Bottom']); end; procedure TChartMargins.ExpandRectScaled( ADrawer: IChartDrawer; var ARect: TRect); begin ARect.TopLeft -= Point(ADrawer.Scale(Left), ADrawer.Scale(Top)); ARect.BottomRight += Point(ADrawer.Scale(Right), ADrawer.Scale(Bottom)); end; function TChartMargins.GetValue(AIndex: Integer): Integer; begin Result := FData.FCoords[AIndex]; end; procedure TChartMargins.SetValue(AIndex: Integer; AValue: TChartDistance); begin if FData.FCoords[AIndex] = AValue then exit; FData.FCoords[AIndex] := AValue; StyleChanged(Self); end; { TChartArrow } procedure TChartArrow.Assign(ASource: TPersistent); begin if ASource is TChartArrow then with TChartArrow(ASource) do begin Self.FBaseLength := FBaseLength; Self.FLength := FLength; Self.FWidth := FWidth; end; inherited Assign(ASource); end; constructor TChartArrow.Create(AOwner: TCustomChart); begin inherited Create(AOwner); FLength := DEF_ARROW_LENGTH; FVisible := false; FWidth := DEF_ARROW_WIDTH; end; procedure TChartArrow.Draw( ADrawer: IChartDrawer; const AEndPos: TPoint; AAngle: Double; APen: TFPCustomPen); var da: Double; diag: Integer; pt1, pt2, ptBase: TPoint; sgn: Integer; begin if not Visible then exit; da := ArcTan2(Width, Length); sgn := IfThen(FInverted, -1, +1); diag := -ADrawer.Scale(Round(Sqrt(Sqr(Length) + Sqr(Width)))); pt1 := AEndPos + RotatePointX(diag, AAngle - da)*sgn; pt2 := AEndPos + RotatePointX(diag, AAngle + da)*sgn; if BaseLength > 0 then begin ptBase := AEndPos + RotatePointX(-ADrawer.Scale(BaseLength), AAngle)*sgn; ADrawer.SetBrushParams(bsSolid, FPColorToChartColor(APen.FPColor)); ADrawer.Polygon([pt1, AEndPos, pt2, ptBase], 0, 4); end else ADrawer.Polyline([pt1, AEndPos, pt2], 0, 3); end; procedure TChartArrow.SetBaseLength(AValue: TChartDistance); begin if FBaseLength = AValue then exit; FBaseLength := AValue; StyleChanged(Self); end; procedure TChartArrow.SetInverted(AValue: Boolean); begin if FInverted = AValue then exit; FInverted := AValue; StyleChanged(Self); end; procedure TChartArrow.SetLength(AValue: TChartDistance); begin if FLength = AValue then exit; FLength := AValue; StyleChanged(Self); end; procedure TChartArrow.SetWidth(AValue: TChartDistance); begin if FWidth = AValue then exit; FWidth := AValue; StyleChanged(Self); end; { TChartShadow } procedure TChartShadow.Assign(ASource: TPersistent); begin if ASource is TChartShadow then with TChartShadow(ASource) do begin Self.FColor := Color; Self.FOffset := FOffset; Self.FTransparency := Transparency; end; inherited Assign(ASource); end; constructor TChartShadow.Create(AOwner: TCustomChart); begin inherited Create(AOwner); FColor := clBlack; FOffset := Point(DEF_SHADOW_OFFSET, DEF_SHADOW_OFFSET); FTransparency := DEF_SHADOW_TRANSPARENCY; end; procedure TChartShadow.SetColor(AValue: TColor); begin if FColor = AValue then exit; FColor := AValue; StyleChanged(Self); end; procedure TChartShadow.SetOffsetX(AValue: Integer); begin if FOffset.X = AValue then exit; FOffset.X := AValue; StyleChanged(Self); end; procedure TChartShadow.SetOffsetY(AValue: Integer); begin if FOffset.Y = AValue then exit; FOffset.Y := AValue; StyleChanged(Self); end; procedure TChartShadow.SetTransparency(AValue: TChartTransparency); begin if FTransparency = AValue then exit; FTransparency := AValue; StyleChanged(Self); end; end.