diff --git a/components/tachart/demo/unit1.lfm b/components/tachart/demo/unit1.lfm index ba49c1de94..82bbdef942 100644 --- a/components/tachart/demo/unit1.lfm +++ b/components/tachart/demo/unit1.lfm @@ -51,13 +51,13 @@ object Form1: TForm1 ParentColor = False object Chart1LineHor: TLine ShowInLegend = False - Pen.Style = psDot + Pen.Style = psDash SeriesColor = clBlack end object Chart1LineVert: TLine ShowInLegend = False LineStyle = lsVertical - Pen.Style = psDot + Pen.Style = psDash SeriesColor = clBlack end end diff --git a/components/tachart/demo/unit1.lrs b/components/tachart/demo/unit1.lrs index 2c0b03166c..227bace6ab 100644 --- a/components/tachart/demo/unit1.lrs +++ b/components/tachart/demo/unit1.lrs @@ -20,9 +20,9 @@ LazarusResources.Add('TForm1','FORMDATA',[ +'.Font.Height'#2#245#26'BottomAxis.Title.Font.Name'#6#13'MS Sans Serif'#18'B' +'ottomAxis.Visible'#9#13'Frame.Visible'#9#9'BackColor'#7#9'clBtnFace'#5'Alig' +'n'#7#8'alClient'#5'Color'#7#9'clBtnFace'#11'ParentColor'#8#0#5'TLine'#13'Ch' - +'art1LineHor'#12'ShowInLegend'#8#9'Pen.Style'#7#5'psDot'#11'SeriesColor'#7#7 + +'art1LineHor'#12'ShowInLegend'#8#9'Pen.Style'#7#6'psDash'#11'SeriesColor'#7#7 +'clBlack'#0#0#5'TLine'#14'Chart1LineVert'#12'ShowInLegend'#8#9'LineStyle'#7 - +#10'lsVertical'#9'Pen.Style'#7#5'psDot'#11'SeriesColor'#7#7'clBlack'#0#0#0#6 + +#10'lsVertical'#9'Pen.Style'#7#6'psDash'#11'SeriesColor'#7#7'clBlack'#0#0#0#6 +'TPanel'#6'Panel1'#6'Height'#2'f'#3'Top'#3#136#1#5'Width'#3'I'#2#5'Align'#7#8 +'alBottom'#12'ClientHeight'#2'f'#11'ClientWidth'#3'I'#2#8'TabOrder'#2#0#0#6 +'TLabel'#6'lblAdd'#4'Left'#2#13#6'Height'#2#14#3'Top'#2#10#5'Width'#2#24#7'C' diff --git a/components/tachart/tagraph.pas b/components/tachart/tagraph.pas index 7748c551bb..7fcc548205 100644 --- a/components/tachart/tagraph.pas +++ b/components/tachart/tagraph.pas @@ -184,9 +184,6 @@ type function GetSeriesCount: Integer; - procedure DrawLineHoriz(ACanvas: TCanvas; AY: Integer); - procedure DrawLineVert(ACanvas: TCanvas; AX: Integer); - protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; @@ -195,11 +192,12 @@ type ASeriesIndex, AIndex: Integer; const AImg: TPoint; const AData: TDoublePoint); virtual; - procedure Refresh(ACanvas: TCanvas; ARect: TRect); procedure Clean(ACanvas: TCanvas; ARect: TRect); procedure DrawTitleFoot(ACanvas: TCanvas; ARect: TRect); procedure DrawAxis(ACanvas: TCanvas; ARect: TRect); procedure DrawLegend(ACanvas: TCanvas; ARect: TRect); + procedure UpdateExtent; + public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -229,6 +227,8 @@ type procedure SaveToBitmapFile(const FileName: String); procedure CopyToClipboardBitmap; procedure DrawOnCanvas(Rect: TRect; ACanvas: TCanvas); + procedure DrawLineHoriz(ACanvas: TCanvas; AY: Integer); + procedure DrawLineVert(ACanvas: TCanvas; AX: Integer); function GetNewColor: TColor; function GetRectangle: TRect; @@ -426,7 +426,15 @@ procedure TChart.PaintOnCanvas(ACanvas: TCanvas; ARect: TRect); begin FClipRect := ARect; InflateRect(FClipRect, -2, -2); - Refresh(ACanvas, ARect); + DrawReticule(ACanvas); + + UpdateExtent; + Clean(ACanvas, ARect); + DrawTitleFoot(ACanvas, ARect); + DrawLegend(ACanvas, ARect); + DrawAxis(ACanvas, ARect); + DisplaySeries(ACanvas); + DrawReticule(ACanvas); end; procedure TChart.PrepareXorPen; @@ -588,8 +596,7 @@ procedure TChart.DrawAxis(ACanvas: TCanvas; ARect: TRect); if FBottomAxis.Grid.Visible then begin ACanvas.Pen.Assign(FBottomAxis.Grid); ACanvas.Brush.Style := bsClear; - if (x > FClipRect.Left) and (x < FClipRect.Right) then - DrawLineVert(ACanvas, x); + DrawLineVert(ACanvas, x); end; ACanvas.Pen.Color := AxisColor; @@ -616,8 +623,7 @@ procedure TChart.DrawAxis(ACanvas: TCanvas; ARect: TRect); if FLeftAxis.Grid.Visible then begin ACanvas.Pen.Assign(FLeftAxis.Grid); ACanvas.Brush.Style := bsClear; - if (y > FClipRect.Top) and (y < FClipRect.Bottom) then - DrawLineHoriz(ACanvas, y); + DrawLineHoriz(ACanvas, y); end; ACanvas.Pen.Color := AxisColor; @@ -679,7 +685,7 @@ begin // that a new mark longer then existing ones is introduced. // That will change marks width and reduce view area, // requiring another call to CalculateTransformationCoeffs... - // So punt for now and just reserve space for extra digit unconditilnally. + // So punt for now and just reserve space for extra digit unconditionally. leftAxisWidth += ACanvas.TextWidth('0'); if FMirrorX then FClipRect.Right -= leftAxisWidth @@ -789,12 +795,14 @@ end; procedure TChart.DrawLineHoriz(ACanvas: TCanvas; AY: Integer); begin - ACanvas.Line(FClipRect.Left, AY, FClipRect.Right, AY); + if (FClipRect.Top < AY) and (AY < FClipRect.Bottom) then + ACanvas.Line(FClipRect.Left, AY, FClipRect.Right, AY); end; procedure TChart.DrawLineVert(ACanvas: TCanvas; AX: Integer); begin - ACanvas.Line(AX, FClipRect.Top, AX, FClipRect.Bottom); + if (FClipRect.Left < AX) and (AX < FClipRect.Right) then + ACanvas.Line(AX, FClipRect.Top, AX, FClipRect.Bottom); end; procedure TChart.SetAutoUpdateXMin(Value: Boolean); @@ -921,110 +929,25 @@ end; procedure TChart.SetAutoXMin(Auto: Boolean); begin FAutoUpdateXMin := Auto; - Refresh(Canvas, Rect(0, 0, Width, Height)); + Invalidate; end; procedure TChart.SetAutoXMax(Auto: Boolean); begin FAutoUpdateXMax := Auto; - Refresh(Canvas, Rect(0, 0, Width, Height)); + Invalidate; end; procedure TChart.SetAutoYMin(Auto: Boolean); begin FAutoUpdateYMin := Auto; - Refresh(Canvas, Rect(0, 0, Width, Height)); + Invalidate; end; procedure TChart.SetAutoYMax(Auto: Boolean); begin FAutoUpdateYMax := Auto; - Refresh(Canvas, Rect(0, 0, Width, Height)); -end; - -procedure TChart.Refresh(ACanvas: TCanvas; ARect: TRect); -var - Tolerance, Valeur: Double; - i: Integer; - allEmpty: Boolean = true; - XMinSeries, XMaxSeries, YMinSeries, YMaxSeries: Double; -begin - DrawReticule(ACanvas); - if FIsZoomed then begin - FXGraphMin := FCurrentExtent.a.X; - FYGraphMin := FCurrentExtent.a.Y; - FXGraphMax := FCurrentExtent.b.X; - FYGraphMax := FCurrentExtent.b.Y; - end - else begin - // Search # of points, min and max of all series - XMinSeries := MaxDouble; - XMaxSeries := MinDouble; - YMinSeries := MaxDouble; - YMaxSeries := MinDouble; - for i := 0 to SeriesCount - 1 do - with Series[i] do - if Active then begin - allEmpty := allEmpty and IsEmpty; - UpdateBounds(XMinSeries, YMinSeries, XMaxSeries, YMaxSeries); - end; - if XMinSeries > MaxDouble / 10 then XMinSeries := 0; - if YMinSeries > MaxDouble / 10 then YMinSeries := 0; - if XMaxSeries < MinDouble / 10 then XMaxSeries := 0; - if YMaxSeries < MinDouble / 10 then YMaxSeries := 0; - - if YMaxSeries = YMinSeries then begin - YMaxSeries := YMaxSeries + 1; - YMinSeries := YMinSeries - 1; - end; - if XMaxSeries = XMinSeries then begin - XMaxSeries := XMaxSeries + 1; - XMinSeries := XMinSeries - 1; - end; - - - // Image coordinates calculation - // Update max in graph - // If one point : +/-10% of the point coordinates - Tolerance := 0.001; //this should be cleaned eventually - // Tolerance := 0.1; - - if not allEmpty then begin - // If several points : automatic +/-10% of interval - Valeur := Tolerance * (XMaxSeries - XMinSeries); - if Valeur <> 0 then begin - if FAutoUpdateXMin then FXGraphMin := XMinSeries - Valeur; - if FAutoUpdateXMax then FXGraphMax := XMaxSeries + Valeur; - end - else begin - if FAutoUpdateXMin then FXGraphMin := XMinSeries - 1; - if FAutoUpdateXMax then FXGraphMax := XMaxSeries + 1; - end; - Valeur := Tolerance * (YMaxSeries - YMinSeries); - if Valeur<>0 then begin - if FAutoUpdateYMin then FYGraphMin := YMinSeries-Valeur; - if FAutoUpdateYMax then FYGraphMax := YMaxSeries+Valeur; - end - else begin - if FAutoUpdateYMin then FYGraphMin := YMinSeries-1; - if FAutoUpdateYMax then FYGraphMax := YMinSeries+1; - end; - end - else begin - // 0 Points - if FAutoUpdateXMin then FXGraphMin := 0; - if FAutoUpdateXMax then FXGraphMax := 0; - if FAutoUpdateYMin then FYGraphMin := 0; - if FAutoUpdateYMax then FYGraphMax := 0; - end; - end; - - Clean(ACanvas, ARect); - DrawTitleFoot(ACanvas, ARect); - DrawLegend(ACanvas, ARect); - DrawAxis(ACanvas, ARect); - DisplaySeries(ACanvas); - DrawReticule(ACanvas); + Invalidate; end; procedure TChart.XGraphToImage(Xin: Double; out XOut: Integer); @@ -1364,6 +1287,82 @@ begin Result := FSeries.FList.Count; end; +procedure TChart.UpdateExtent; +var + XMinSeries, YMinSeries, XMaxSeries, YMaxSeries, Valeur, Tolerance: Double; + allEmpty: Boolean; + i: Integer; +begin + if FIsZoomed then begin + FXGraphMin := FCurrentExtent.a.X; + FYGraphMin := FCurrentExtent.a.Y; + FXGraphMax := FCurrentExtent.b.X; + FYGraphMax := FCurrentExtent.b.Y; + end + else begin + // Search # of points, min and max of all series + XMinSeries := MaxDouble; + XMaxSeries := MinDouble; + YMinSeries := MaxDouble; + YMaxSeries := MinDouble; + for i := 0 to SeriesCount - 1 do + with Series[i] do + if Active then begin + allEmpty := allEmpty and IsEmpty; + UpdateBounds(XMinSeries, YMinSeries, XMaxSeries, YMaxSeries); + end; + if XMinSeries > MaxDouble / 10 then XMinSeries := 0; + if YMinSeries > MaxDouble / 10 then YMinSeries := 0; + if XMaxSeries < MinDouble / 10 then XMaxSeries := 0; + if YMaxSeries < MinDouble / 10 then YMaxSeries := 0; + + if YMaxSeries = YMinSeries then begin + YMaxSeries := YMaxSeries + 1; + YMinSeries := YMinSeries - 1; + end; + if XMaxSeries = XMinSeries then begin + XMaxSeries := XMaxSeries + 1; + XMinSeries := XMinSeries - 1; + end; + + + // Image coordinates calculation + // Update max in graph + // if one point : + / - 10% of the point coordinates + Tolerance := 0.001; //this should be cleaned eventually + // Tolerance := 0.1; + + if not allEmpty then begin + // if several points : automatic + / - 10% of interval + Valeur := Tolerance * (XMaxSeries - XMinSeries); + if Valeur <> 0 then begin + if FAutoUpdateXMin then FXGraphMin := XMinSeries - Valeur; + if FAutoUpdateXMax then FXGraphMax := XMaxSeries + Valeur; + end + else begin + if FAutoUpdateXMin then FXGraphMin := XMinSeries - 1; + if FAutoUpdateXMax then FXGraphMax := XMaxSeries + 1; + end; + Valeur := Tolerance * (YMaxSeries - YMinSeries); + if Valeur <> 0 then begin + if FAutoUpdateYMin then FYGraphMin := YMinSeries - Valeur; + if FAutoUpdateYMax then FYGraphMax := YMaxSeries + Valeur; + end + else begin + if FAutoUpdateYMin then FYGraphMin := YMinSeries - 1; + if FAutoUpdateYMax then FYGraphMax := YMinSeries + 1; + end; + end + else begin + // 0 Points + if FAutoUpdateXMin then FXGraphMin := 0; + if FAutoUpdateXMax then FXGraphMax := 0; + if FAutoUpdateYMin then FYGraphMin := 0; + if FAutoUpdateYMax then FYGraphMax := 0; + end; + end; +end; + procedure TChart.ZoomFull; begin FIsZoomed := false; diff --git a/components/tachart/taseries.pas b/components/tachart/taseries.pas index 536d5aa06f..73d50a1f7f 100644 --- a/components/tachart/taseries.pas +++ b/components/tachart/taseries.pas @@ -48,7 +48,6 @@ type FValuesTotalValid: Boolean; function GetXMinVal: Integer; - procedure InitBounds(out XMin, YMin, XMax, YMax: Integer); procedure SetMarks(const AValue: TChartMarks); protected procedure AfterAdd; override; @@ -421,21 +420,6 @@ begin Result := 0; end; -procedure TChartSeries.InitBounds(out XMin, YMin, XMax, YMax: Integer); -begin - with ParentChart do begin - XMin := ClipRect.Left; - XMax := ClipRect.Right; - YMin := ClipRect.Bottom; - YMax := ClipRect.Top; - end; - - if XMin > XMax then - Exchange(XMin, XMax); - if YMin > YMax then - Exchange(YMin, YMax); -end; - function TChartSeries.IsEmpty: Boolean; begin Result := Count = 0; @@ -591,7 +575,6 @@ procedure TLineSeries.Draw(ACanvas: TCanvas); var i1, i2: TPoint; g1, g2: TDoublePoint; - XMin, XMax, YMin, YMax: Integer; function PrepareLine: Boolean; begin @@ -636,9 +619,7 @@ var procedure DrawPoint(AIndex: Integer); begin - if - FShowPoints and InRange(i1.Y, YMin, YMax) and InRange(i1.X, XMin, XMax) - then begin + if FShowPoints and PtInRect(ParentChart.ClipRect, i1) then begin FPointer.Draw(ACanvas, i1, SeriesColor); if Assigned(FOnDrawPointer) then FOnDrawPointer(Self, ACanvas, AIndex, i1); @@ -650,7 +631,6 @@ var begin if Count = 0 then exit; - InitBounds(XMin, YMin, XMax, YMax); ACanvas.Pen.Mode := pmCopy; ACanvas.Pen.Width := 1; @@ -976,26 +956,23 @@ end; procedure TLine.Draw(ACanvas: TCanvas); var - xmin, xmax, ymin, ymax, posImage: Integer; + posImage: Integer; begin - InitBounds(xmin, ymin, xmax, ymax); - ACanvas.Pen.Assign(FPen); - case LineStyle of - lsHorizontal: - if InRange(FPosGraph, ParentChart.XGraphMin, ParentChart.XGraphMax) then begin - ParentChart.YGraphToImage(FPosGraph, posImage); - ACanvas.MoveTo(xmin, posImage); - ACanvas.LineTo(xmax, posImage); - end; - lsVertical: - if InRange(FPosGraph, ParentChart.YGraphMin, ParentChart.YGraphMax) then begin - ParentChart.XGraphToImage(FPosGraph, posImage); - ACanvas.MoveTo(posImage, ymin); - ACanvas.LineTo(posImage, ymax); - end; - end; + with ParentChart do + case LineStyle of + lsHorizontal: + begin + YGraphToImage(FPosGraph, posImage); + DrawLineHoriz(ACanvas, posImage); + end; + lsVertical: + begin + XGraphToImage(FPosGraph, posImage); + DrawLineVert(ACanvas, posImage); + end; + end; end; function TLine.GetSeriesColor: TColor; @@ -1441,30 +1418,27 @@ end; procedure TAreaSeries.Draw(ACanvas: TCanvas); var - i, xi2a, iy_min: Integer; + i, xi2a, ymin: Integer; i1, i2: TPoint; g1, g2: TDoublePoint; - XMin, XMax, YMin, YMax: Integer; procedure DrawPart; begin - ACanvas.Polygon([Point(i1.X, iy_min), i1, i2, Point(i2.X, iy_min)]); + ACanvas.Polygon([Point(i1.X, ymin), i1, i2, Point(i2.X, ymin)]); end; begin if Count = 0 then exit; - InitBounds(XMin, YMin, XMax, YMax); - ACanvas.Pen.Mode := pmCopy; ACanvas.Pen.Style := psSolid; ACanvas.Pen.Width := 1; + ymin := ParentChart.ClipRect.Bottom - 1; for i := 0 to Count - 2 do begin GetCoords(i, g1, i1); GetCoords(i + 1, g2, i2); - iy_min := ParentChart.ClipRect.Bottom; ACanvas.Pen.Color:= clBlack; ACanvas.Brush.Color:= PChartCoord(FCoordList.Items[i])^.Color; @@ -1474,10 +1448,10 @@ begin then begin if FStairs then begin if FInvertedStairs then - ACanvas.Polygon([Point(i1.X, iy_min), i1, i2, Point(i2.X, iy_min)]) + ACanvas.Polygon([Point(i1.X, ymin), i1, i2, Point(i2.X, ymin)]) else ACanvas.Polygon([ - Point(i1.X, iy_min), i1, Point(i2.X, i1.Y), Point(i2.X, iy_min)]) + Point(i1.X, ymin), i1, Point(i2.X, i1.Y), Point(i2.X, ymin)]) end else DrawPart; continue; @@ -1496,32 +1470,33 @@ begin Exchange(i1.X, i2.X); Exchange(i1.Y, i2.Y); end; - if g1.Y = g2.Y then begin - if g1.X > g2.X then - Exchange(g1, g2); - if g1.X < ParentChart.XGraphMin then i1.X := ParentChart.ClipRect.Left; - if g2.X > ParentChart.XGraphMax then i2.X := ParentChart.ClipRect.Right; - end - else if g1.X = g2.X then begin - if g1.Y < ParentChart.YGraphMin then i1.Y := ParentChart.ClipRect.Bottom; - if g2.Y > ParentChart.YGraphMax then i2.Y := ParentChart.ClipRect.Top; - end - else if ParentChart.LineInViewPort(g1, g2) then begin - xi2a := i2.X; - i1 := ParentChart.GraphToImage(g1); - i2 := ParentChart.GraphToImage(g2); - {if i2.Y <= YMin then} begin - ACanvas.Polygon([ - Point(i1.X, iy_min), i1, i2, Point(xi2a, YMin), Point(xi2a, iy_min)]); - continue; + with ParentChart do + if g1.Y = g2.Y then begin + if g1.X > g2.X then + Exchange(g1, g2); + if g1.X < XGraphMin then i1.X := ClipRect.Left; + if g2.X > XGraphMax then i2.X := ClipRect.Right; + end + else if g1.X = g2.X then begin + if g1.Y < YGraphMin then i1.Y := ymin; + if g2.Y > YGraphMax then i2.Y := ClipRect.Top; + end + else if LineInViewPort(g1, g2) then begin + xi2a := i2.X; + i1 := GraphToImage(g1); + i2 := GraphToImage(g2); + {if i2.Y <= ymin then} begin + ACanvas.Polygon([ + Point(i1.X, ymin), i1, i2, Point(xi2a, ymin), Point(xi2a, ymin)]); + continue; + end; + end + else if g2.Y >= YGraphMax then begin + i1.Y := ymin; + i2.Y := ymin; + i1.X := EnsureRange(i1.X, ClipRect.Left, ClipRect.Right); + i2.X := EnsureRange(i2.X, ClipRect.Left, ClipRect.Right); end; - end - else if g2.Y >= ParentChart.YGraphMax then begin - i1.Y := YMin; - i2.Y := YMin; - i1.X := EnsureRange(i1.X, XMin, XMax); - i2.X := EnsureRange(i2.X, XMin, XMax); - end; DrawPart; end; @@ -1550,8 +1525,7 @@ begin inherited DrawLegend(ACanvas, ARect); ACanvas.Pen.Color := SeriesColor; y := (ARect.Top + ARect.Bottom) div 2; - ACanvas.MoveTo(ARect.Left, y); - ACanvas.LineTo(ARect.Right, y); + ACanvas.Line(ARect.Left, y, ARect.Right, y); end; { TFuncSeries } @@ -1611,8 +1585,7 @@ begin ACanvas.TextOut(ARect.Right + 3, ARect.Top, Title); ACanvas.Pen.Assign(Pen); y := (ARect.Top + ARect.Bottom) div 2; - ACanvas.MoveTo(ARect.Left, y); - ACanvas.LineTo(ARect.Right, y); + ACanvas.Line(ARect.Left, y, ARect.Right, y); end; function TFuncSeries.GetLegendCount: Integer;