mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-23 11:40:35 +02:00
TAChart: Add TCustomAnimatedChartSource
git-svn-id: trunk@38442 -
This commit is contained in:
parent
a51ed493bb
commit
ddfd58d1de
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -2996,6 +2996,7 @@ components/tachart/numlib_fix/ipf.pas svneol=native#text/pascal
|
||||
components/tachart/numlib_fix/mdt.pas svneol=native#text/pascal
|
||||
components/tachart/numlib_fix/sle.pas svneol=native#text/pascal
|
||||
components/tachart/numlib_fix/spe.pas svneol=native#text/pascal
|
||||
components/tachart/taanimatedsource.pas svneol=native#text/pascal
|
||||
components/tachart/tachartaggpas.lpk svneol=native#text/pascal
|
||||
components/tachart/tachartaggpas.pas svneol=native#text/pascal
|
||||
components/tachart/tachartaxis.pas svneol=native#text/pascal
|
||||
|
222
components/tachart/taanimatedsource.pas
Normal file
222
components/tachart/taanimatedsource.pas
Normal file
@ -0,0 +1,222 @@
|
||||
{
|
||||
|
||||
*****************************************************************************
|
||||
* *
|
||||
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
||||
* for details about the copyright. *
|
||||
* *
|
||||
* This program is distributed in the hope that it will be useful, *
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
||||
* *
|
||||
*****************************************************************************
|
||||
|
||||
Authors: Alexander Klenin
|
||||
|
||||
}
|
||||
|
||||
unit TAAnimatedSource;
|
||||
|
||||
{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, CustomTimer,
|
||||
TAChartUtils, TACustomSource;
|
||||
|
||||
type
|
||||
TCustomAnimatedChartSource = class;
|
||||
|
||||
TAnimatedChartSourceItemEvent = procedure (
|
||||
ASender: TCustomAnimatedChartSource;
|
||||
AIndex: Integer; var AItem: TChartDataItem) of object;
|
||||
TAnimatedChartSourceEvent = procedure (
|
||||
ASender: TCustomAnimatedChartSource) of object;
|
||||
|
||||
TCustomAnimatedChartSource = class(TCustomChartSource)
|
||||
strict private
|
||||
FAnimationInterval: Cardinal;
|
||||
FAnimationTime: Cardinal;
|
||||
FCurrentStep: Cardinal;
|
||||
FItem: TChartDataItem;
|
||||
FListener: TListener;
|
||||
FOnGetItem: TAnimatedChartSourceItemEvent;
|
||||
FOnStop: TAnimatedChartSourceEvent;
|
||||
FOrigin: TCustomChartSource;
|
||||
FProjectedSteps: Cardinal;
|
||||
FSkippedFramesCount: Cardinal;
|
||||
FStartTime: Cardinal;
|
||||
FTimer: TCustomTimer;
|
||||
procedure Changed(ASender: TObject);
|
||||
procedure OnTimer(ASender: TObject);
|
||||
procedure SetOrigin(AValue: TCustomChartSource);
|
||||
protected
|
||||
function GetCount: Integer; override;
|
||||
function GetItem(AIndex: Integer): PChartDataItem; override;
|
||||
procedure SetYCount(AValue: Cardinal); override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
|
||||
function Extent: TDoubleRect; override;
|
||||
function ExtentCumulative: TDoubleRect; override;
|
||||
function ExtentList: TDoubleRect; override;
|
||||
|
||||
function IsAnimating: Boolean; inline;
|
||||
function Progress: Double; inline;
|
||||
procedure Start;
|
||||
procedure Stop(ACallEvent: Boolean = false);
|
||||
|
||||
property CurrentStep: Cardinal read FCurrentStep;
|
||||
property ProjectedSteps: Cardinal read FProjectedSteps;
|
||||
property SkippedFramesCount: Cardinal read FSkippedFramesCount;
|
||||
published
|
||||
property AnimationInterval: Cardinal
|
||||
read FAnimationInterval write FAnimationInterval default 0;
|
||||
property AnimationTime: Cardinal
|
||||
read FAnimationTime write FAnimationTime default 0;
|
||||
property Origin: TCustomChartSource read FOrigin write SetOrigin;
|
||||
published
|
||||
property OnGetItem: TAnimatedChartSourceItemEvent
|
||||
read FOnGetItem write FOnGetItem;
|
||||
property OnStop: TAnimatedChartSourceEvent read FOnStop write FOnStop;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
LCLIntf, Math, SysUtils;
|
||||
|
||||
{ TCustomAnimatedChartSource }
|
||||
|
||||
procedure TCustomAnimatedChartSource.Changed(ASender: TObject);
|
||||
begin
|
||||
Notify;
|
||||
end;
|
||||
|
||||
constructor TCustomAnimatedChartSource.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FListener := TListener.Create(@FOrigin, @Changed);
|
||||
FTimer := TCustomTimer.Create(nil);
|
||||
FTimer.Enabled := false;
|
||||
FTimer.OnTimer := @OnTimer;
|
||||
end;
|
||||
|
||||
destructor TCustomAnimatedChartSource.Destroy;
|
||||
begin
|
||||
FreeAndNil(FTimer);
|
||||
FreeAndNil(FListener);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TCustomAnimatedChartSource.Extent: TDoubleRect;
|
||||
begin
|
||||
if Origin = nil then
|
||||
Result := EmptyExtent
|
||||
else
|
||||
Result := Origin.Extent;
|
||||
end;
|
||||
|
||||
function TCustomAnimatedChartSource.ExtentCumulative: TDoubleRect;
|
||||
begin
|
||||
if Origin = nil then
|
||||
Result := EmptyExtent
|
||||
else
|
||||
Result := Origin.ExtentCumulative;
|
||||
end;
|
||||
|
||||
function TCustomAnimatedChartSource.ExtentList: TDoubleRect;
|
||||
begin
|
||||
if Origin = nil then
|
||||
Result := EmptyExtent
|
||||
else
|
||||
Result := Origin.ExtentList;
|
||||
end;
|
||||
|
||||
function TCustomAnimatedChartSource.GetCount: Integer;
|
||||
begin
|
||||
if Origin = nil then
|
||||
Result := 0
|
||||
else
|
||||
Result := Origin.Count;
|
||||
end;
|
||||
|
||||
function TCustomAnimatedChartSource.GetItem(AIndex: Integer): PChartDataItem;
|
||||
begin
|
||||
if Origin = nil then exit(nil);
|
||||
if not IsAnimating then exit(Origin.Item[AIndex]);
|
||||
FItem := Origin.Item[AIndex]^;
|
||||
Result := @FItem;
|
||||
if Assigned(OnGetItem) then
|
||||
OnGetItem(Self, AIndex, FItem);
|
||||
end;
|
||||
|
||||
function TCustomAnimatedChartSource.IsAnimating: Boolean;
|
||||
begin
|
||||
Result := FTimer.Enabled;
|
||||
end;
|
||||
|
||||
procedure TCustomAnimatedChartSource.OnTimer(ASender: TObject);
|
||||
var
|
||||
d, s: Cardinal;
|
||||
begin
|
||||
Unused(ASender);
|
||||
d := GetTickCount - FStartTime;
|
||||
if d >= AnimationTime then
|
||||
Stop(true);
|
||||
s := Round(d * ProjectedSteps / AnimationTime);
|
||||
if FCurrentStep + 1 <> s then
|
||||
FSkippedFramesCount += 1;
|
||||
FCurrentStep := s;
|
||||
Notify;
|
||||
end;
|
||||
|
||||
function TCustomAnimatedChartSource.Progress: Double;
|
||||
begin
|
||||
if ProjectedSteps = 0 then
|
||||
Result := 0
|
||||
else
|
||||
Result := (FCurrentStep - 1) / ProjectedSteps;
|
||||
end;
|
||||
|
||||
procedure TCustomAnimatedChartSource.SetOrigin(AValue: TCustomChartSource);
|
||||
begin
|
||||
if AValue = Self then
|
||||
AValue := nil;
|
||||
if FOrigin = AValue then exit;
|
||||
if FOrigin <> nil then
|
||||
FOrigin.Broadcaster.Unsubscribe(FListener);
|
||||
FOrigin := AValue;
|
||||
if FOrigin <> nil then
|
||||
FOrigin.Broadcaster.Subscribe(FListener);
|
||||
end;
|
||||
|
||||
procedure TCustomAnimatedChartSource.SetYCount(AValue: Cardinal);
|
||||
begin
|
||||
Unused(AValue);
|
||||
raise EYCountError.Create('Can not set YCount');
|
||||
end;
|
||||
|
||||
procedure TCustomAnimatedChartSource.Start;
|
||||
begin
|
||||
Stop;
|
||||
FSkippedFramesCount := 0;
|
||||
if (AnimationInterval = 0) or (AnimationTime <= AnimationInterval) then exit;
|
||||
FProjectedSteps := Round(AnimationTime / AnimationInterval);
|
||||
FStartTime := GetTickCount;
|
||||
FTimer.Interval := AnimationInterval;
|
||||
FTimer.Enabled := true;
|
||||
end;
|
||||
|
||||
procedure TCustomAnimatedChartSource.Stop(ACallEvent: Boolean);
|
||||
begin
|
||||
FTimer.Enabled := false;
|
||||
FCurrentStep := 0;
|
||||
if ACallEvent and Assigned(OnStop) then
|
||||
OnStop(Self);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
@ -34,7 +34,7 @@
|
||||
for details about the copyright.
|
||||
"/>
|
||||
<Version Major="1"/>
|
||||
<Files Count="38">
|
||||
<Files Count="39">
|
||||
<Item1>
|
||||
<Filename Value="tagraph.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
@ -205,6 +205,10 @@
|
||||
<Filename Value="tadatatools.pas"/>
|
||||
<UnitName Value="TADataTools"/>
|
||||
</Item38>
|
||||
<Item39>
|
||||
<Filename Value="taanimatedsource.pas"/>
|
||||
<UnitName Value="TAAnimatedSource"/>
|
||||
</Item39>
|
||||
</Files>
|
||||
<LazDoc Paths="$(LazarusDir)\components\tachart\fpdoc"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
|
@ -13,7 +13,8 @@ uses
|
||||
TALegendPanel, TARadialSeries, TACustomSource, TAGeometry, TANavigation,
|
||||
TADrawerCanvas, TADrawerSVG, TAIntervalSources, TAChartAxisUtils,
|
||||
TAChartListbox, TAEnumerators, TADataPointsEditor, TAChartExtentLink,
|
||||
TAToolEditors, TAMath, TAChartImageList, TADataTools, LazarusPackageIntf;
|
||||
TAToolEditors, TAMath, TAChartImageList, TADataTools, TAAnimatedSource,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
@ -163,9 +163,9 @@ type
|
||||
function IsUpdating: Boolean; inline;
|
||||
public
|
||||
class procedure CheckFormat(const AFormat: String);
|
||||
function Extent: TDoubleRect;
|
||||
function ExtentCumulative: TDoubleRect;
|
||||
function ExtentList: TDoubleRect;
|
||||
function Extent: TDoubleRect; virtual;
|
||||
function ExtentCumulative: TDoubleRect; virtual;
|
||||
function ExtentList: TDoubleRect; virtual;
|
||||
procedure FindBounds(AXMin, AXMax: Double; out ALB, AUB: Integer);
|
||||
function FormatItem(
|
||||
const AFormat: String; AIndex, AYIndex: Integer): String;
|
||||
|
@ -1082,7 +1082,7 @@ destructor TCalculatedChartSource.Destroy;
|
||||
begin
|
||||
FreeAndNil(FHistory);
|
||||
FreeAndNil(FListener);
|
||||
inherited Destroy;
|
||||
inherited;
|
||||
end;
|
||||
|
||||
function TCalculatedChartSource.EffectiveAccumulationRange: Cardinal;
|
||||
|
@ -478,7 +478,6 @@ type
|
||||
destructor Destroy; override;
|
||||
procedure Draw(AChart: TChart; ADrawer: IChartDrawer); override;
|
||||
procedure Hide; virtual;
|
||||
procedure KeyDown(APoint: TPoint); override;
|
||||
published
|
||||
property DrawingMode;
|
||||
property GrabRadius default 20;
|
||||
@ -500,6 +499,7 @@ type
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
procedure Draw(AChart: TChart; ADrawer: IChartDrawer); override;
|
||||
procedure KeyDown(APoint: TPoint); override;
|
||||
procedure MouseMove(APoint: TPoint); override;
|
||||
property Position: TDoublePoint read FPosition;
|
||||
published
|
||||
@ -1661,11 +1661,6 @@ begin
|
||||
Deactivate;
|
||||
end;
|
||||
|
||||
procedure TDataPointDrawTool.KeyDown(APoint: TPoint);
|
||||
begin
|
||||
MouseMove(APoint);
|
||||
end;
|
||||
|
||||
procedure TDataPointDrawTool.SetPen(AValue: TChartPen);
|
||||
begin
|
||||
FPen.Assign(AValue);
|
||||
@ -1711,6 +1706,11 @@ begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TDataPointCrosshairTool.KeyDown(APoint: TPoint);
|
||||
begin
|
||||
MouseMove(APoint);
|
||||
end;
|
||||
|
||||
procedure TDataPointCrosshairTool.MouseMove(APoint: TPoint);
|
||||
begin
|
||||
DoHide;
|
||||
|
Loading…
Reference in New Issue
Block a user