paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-16 02:40:36 +01:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Add TBarSeries.BarWidthStyle property

Browse Source 
git-svn-id: trunk@28717 -
This commit is contained in:
ask 2010-12-15 05:24:44 +00:00
parent 702bb61c02
commit ff046e1b02
2 changed files with 46 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
components/tachart/tacustomseries.pas
View File

@ -187,6 +187,7 @@ type
protected
FGraphPoints: array of TDoublePoint;
FLoBound: Integer;
FMinXRange: Double;
FUpBound: Integer;
FUseReticule: Boolean;
@ -198,6 +199,7 @@ type
const AExtent: TDoubleRect; AFilterByExtent: Boolean);
procedure UpdateGraphPoints(AIndex: Integer);
procedure UpdateMargins(ACanvas: TCanvas; var AMargins: TRect); override;
procedure UpdateMinXRange;
property UseReticule: Boolean
read FUseReticule write SetUseReticule default false;
public
@ -881,6 +883,25 @@ begin
end;
end;
procedure TBasicPointSeries.UpdateMinXRange;
var
x, prevX: Double;
i: Integer;
begin
if Count < 2 then begin
FMinXRange := 1.0;
exit;
end;
x := Source[0]^.X;
prevX := Source[1]^.X;
FMinXRange := Abs(x - prevX);
for i := 2 to Count - 1 do begin
x := Source[i]^.X;
FMinXRange := Min(Abs(x - prevX), FMinXRange);
prevX := x;
end;
end;
procedure SkipObsoleteProperties;
begin
RegisterPropertyEditor(

28
components/tachart/taseries.pas
View File

@ -38,6 +38,8 @@ const
type
EBarError = class(EChartError);
TBarWidthStyle = (bwPercent, bwPercentMin);
{ TBarSeries }
TBarSeries = class(TBasicPointSeries)
@ -46,15 +48,17 @@ type
FBarOffsetPercent: Integer;
FBarPen: TPen;
FBarWidthPercent: Integer;
FBarWidthStyle: TBarWidthStyle;
FZeroLevel: Double;
procedure BarOffsetWidth(
AX: Double; AIndex: Integer; out AOffset, AWidth: Double);
function IsZeroLevelStored: boolean;
procedure SetBarBrush(Value: TBrush);
procedure SetBarOffsetPercent(const AValue: Integer);
procedure SetBarOffsetPercent(AValue: Integer);
procedure SetBarPen(Value: TPen);
procedure SetBarWidthPercent(Value: Integer);
procedure SetBarWidthStyle(AValue: TBarWidthStyle);
procedure SetSeriesColor(AValue: TColor);
procedure SetZeroLevel(AValue: Double);
protected
@ -75,6 +79,8 @@ type
property BarPen: TPen read FBarPen write SetBarPen;
property BarWidthPercent: Integer
read FBarWidthPercent write SetBarWidthPercent default DEF_BAR_WIDTH_PERCENT;
property BarWidthStyle: TBarWidthStyle
read FBarWidthStyle write SetBarWidthStyle default bwPercent;
property Depth;
property SeriesColor: TColor
read GetSeriesColor write SetSeriesColor stored false default clRed;
@ -654,7 +660,12 @@ procedure TBarSeries.BarOffsetWidth(
var
r: Double;
begin
r := GetXRange(AX, AIndex) * PERCENT;
case BarWidthStyle of
bwPercent: r := GetXRange(AX, AIndex) * PERCENT;
bwPercentMin: r := FMinXRange * PERCENT;
else
raise EBarError.Create('BarWidthStyle not implemented');
end;
AOffset := r * BarOffsetPercent;
AWidth := r * BarWidthPercent / 2;
end;
@ -743,6 +754,8 @@ var
begin
if IsEmpty then exit;
if BarWidthStyle = bwPercentMin then
UpdateMinXRange;
ext2 := ParentChart.CurrentExtent;
ExpandRange(ext2.a.X, ext2.b.X, 1.0);
ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
@ -775,6 +788,8 @@ var
begin
Result := inherited Extent;
if IsEmpty then exit;
if BarWidthStyle = bwPercentMin then
UpdateMinXRange;
UpdateMinMax(ZeroLevel, Result.a.Y, Result.b.Y);
// Show first and last bars fully.
x := GetGraphPointX(0);
@ -805,7 +820,7 @@ begin
FBarBrush.Assign(Value);
end;
procedure TBarSeries.SetBarOffsetPercent(const AValue: Integer);
procedure TBarSeries.SetBarOffsetPercent(AValue: Integer);
begin
if FBarOffsetPercent = AValue then exit;
FBarOffsetPercent := AValue;
@ -824,6 +839,13 @@ begin
FBarWidthPercent := Value;
end;
procedure TBarSeries.SetBarWidthStyle(AValue: TBarWidthStyle);
begin
if FBarWidthStyle = AValue then exit;
FBarWidthStyle := AValue;
UpdateParentChart;
end;
procedure TBarSeries.SetSeriesColor(AValue: TColor);
begin
FBarBrush.Color := AValue;