TAChart: Separate color map functionality from TColorMapSeries into a generally-usable class TColorMap (unit TAColorMap).

This commit is contained in:
wp_xyz 2023-03-17 20:09:18 +01:00
parent f0ae6049c6
commit af597e4d16
6 changed files with 391 additions and 222 deletions

View File

@ -7,14 +7,13 @@ uses
cthreads, cthreads,
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset Interfaces, // this includes the LCL widgetset
Forms Forms { you can add units after this },
{ you can add units after this }, main, runtimetypeinfocontrols, main;
TAChartLazarusPkg;
{$R *.res} {$R *.res}
begin begin
Application.Title := 'TAChart function series demo'; Application.Title:='TAChart function series demo';
Application.Initialize; Application.Initialize;
Application.CreateForm(TForm1, Form1); Application.CreateForm(TForm1, Form1);
Application.Run; Application.Run;

View File

@ -99,20 +99,20 @@ object Form1: TForm1
end end
end end
object cbDomain: TCheckBox object cbDomain: TCheckBox
Left = 541 Left = 543
Height = 19 Height = 19
Top = 401 Top = 401
Width = 62 Width = 60
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'Domain' Caption = 'Domain'
OnChange = cbDomainChange OnChange = cbDomainChange
TabOrder = 1 TabOrder = 1
end end
object cbRotate: TCheckBox object cbRotate: TCheckBox
Left = 541 Left = 543
Height = 19 Height = 19
Top = 376 Top = 376
Width = 54 Width = 52
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
Caption = 'Rotate' Caption = 'Rotate'
OnChange = cbRotateChange OnChange = cbRotateChange
@ -200,7 +200,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 19 Height = 19
Top = 339 Top = 339
Width = 77 Width = 75
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
Caption = 'Interpolate' Caption = 'Interpolate'
@ -213,7 +213,7 @@ object Form1: TForm1
Left = 0 Left = 0
Height = 19 Height = 19
Top = 283 Top = 283
Width = 98 Width = 96
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 2 BorderSpacing.Bottom = 2
Caption = 'Expand legend' Caption = 'Expand legend'
@ -294,7 +294,7 @@ object Form1: TForm1
Left = 16 Left = 16
Height = 19 Height = 19
Top = 304 Top = 304
Width = 83 Width = 81
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Left = 16 BorderSpacing.Left = 16
BorderSpacing.Bottom = 16 BorderSpacing.Bottom = 16
@ -415,7 +415,7 @@ object Form1: TForm1
Left = 123 Left = 123
Height = 19 Height = 19
Top = 7 Top = 7
Width = 75 Width = 73
AutoSize = True AutoSize = True
BorderSpacing.Left = 24 BorderSpacing.Left = 24
Caption = 'Random X' Caption = 'Random X'
@ -440,10 +440,10 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = iseSplineDegree AnchorSideTop.Control = iseSplineDegree
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 294 Left = 290
Height = 19 Height = 19
Top = 7 Top = 7
Width = 51 Width = 49
AutoSize = True AutoSize = True
BorderSpacing.Left = 16 BorderSpacing.Left = 16
Caption = 'Cubic' Caption = 'Cubic'
@ -458,10 +458,10 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = pnSpline AnchorSideTop.Control = pnSpline
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 214 Left = 212
Height = 19 Height = 19
Top = 7 Top = 7
Width = 64 Width = 62
AutoSize = True AutoSize = True
BorderSpacing.Left = 16 BorderSpacing.Left = 16
Caption = 'B-Spline' Caption = 'B-Spline'
@ -475,10 +475,10 @@ object Form1: TForm1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = iseSplineDegree AnchorSideTop.Control = iseSplineDegree
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 369 Left = 363
Height = 19 Height = 19
Top = 7 Top = 7
Width = 50 Width = 48
AutoSize = True AutoSize = True
BorderSpacing.Left = 24 BorderSpacing.Left = 24
Caption = 'Log Y' Caption = 'Log Y'
@ -552,7 +552,7 @@ object Form1: TForm1
Left = 4 Left = 4
Height = 19 Height = 19
Top = 4 Top = 4
Width = 92 Width = 90
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 4 BorderSpacing.Top = 4
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4

View File

@ -30,7 +30,7 @@
for details about the copyright. for details about the copyright.
"/> "/>
<Version Major="1"/> <Version Major="1"/>
<Files Count="55"> <Files Count="56">
<Item1> <Item1>
<Filename Value="tagraph.pas"/> <Filename Value="tagraph.pas"/>
<HasRegisterProc Value="True"/> <HasRegisterProc Value="True"/>
@ -271,6 +271,10 @@
<Filename Value="tapolygonseries.pas"/> <Filename Value="tapolygonseries.pas"/>
<UnitName Value="TAPolygonSeries"/> <UnitName Value="TAPolygonSeries"/>
</Item55> </Item55>
<Item56>
<Filename Value="tacolormap.pas"/>
<UnitName Value="TAColorMap"/>
</Item56>
</Files> </Files>
<CompatibilityMode Value="True"/> <CompatibilityMode Value="True"/>
<LazDoc Paths="$(LazarusDir)\components\tachart\fpdoc"/> <LazDoc Paths="$(LazarusDir)\components\tachart\fpdoc"/>

View File

@ -19,7 +19,7 @@ uses
TACustomFuncSeries, TAFitUtils, TAGUIConnector, TADiagram, TADiagramDrawing, TACustomFuncSeries, TAFitUtils, TAGUIConnector, TADiagram, TADiagramDrawing,
TADiagramLayout, TAChartStrConsts, TAChartCombos, TAHtml, TAFonts, TADiagramLayout, TAChartStrConsts, TAChartCombos, TAHtml, TAFonts,
TAExpressionSeries, TAFitLib, TASourcePropEditors, TADataPointsEditor, TAExpressionSeries, TAFitLib, TASourcePropEditors, TADataPointsEditor,
TAPolygonSeries, LazarusPackageIntf; TAPolygonSeries, TAColorMap, LazarusPackageIntf;
implementation implementation

View File

@ -0,0 +1,320 @@
unit TAColorMap;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics,
TAChartUtils, TACustomSource, TASources, TACustomSeries;
type
TColorMapPalette = (cmpHot, cmpCold, cmpRainbow, cmpMonochrome);
TColorMap = class(TComponent)
private
FBuiltinColorSource: TListChartSource;
FBuiltinPalette: TColormapPalette;
FColorExtentMin, FColorExtentMax: Double;
FColorSource: TCustomChartSource;
FColorSourceListener: TListener;
FInterpolate: Boolean;
FNumXCountNeeded: Integer;
FNumYCountNeeded: Integer;
FOwnerSeries: TCustomChartSeries;
FPaletteMax: Double;
FPaletteMin: Double;
FOnChanged: TNotifyEvent;
function GetColorSource: TCustomChartSource;
procedure SetBuiltinPalette(AValue: TColorMapPalette);
procedure SetColorSource(AValue: TCustomChartSource);
procedure SetPaletteMax(AValue: Double);
procedure SetPaletteMin(AValue: Double);
protected
procedure BuildPalette(APalette: TColorMapPalette);
procedure CheckColorSource(ASource: TCustomChartSource);
procedure ColorMapChanged(Sender: TObject); virtual;
procedure ColorSourceChanged(Sender: TObject); virtual;
function OwnerSeries: TCustomChartSeries; inline;
procedure UpdateColorExtent;
public
constructor Create(AOwner: TCustomChartSeries; ANumXCountNeeded, ANumYCountNeeded: Integer); reintroduce;
destructor Destroy; override;
procedure Assign(ASource: TPersistent); override;
function ColorByValue(AValue: Double): TColor;
function IsColorSourceStored: boolean;
function IsPaletteMaxStored: Boolean;
function IsPaletteMinStored: Boolean;
// Read-only properties
property BuiltinColorSource: TListChartSource read FBuiltinColorSource;
property ColorExtentMax: Double read FColorExtentMax;
property ColorExtentMin: Double read FColorExtentMin;
// Read/write properties
property BuiltinPalette: TColormapPalette
read FBuiltInPalette write SetBuiltinPalette;
property ColorSource: TCustomChartSource
read GetColorSource write SetColorSource;
property Interpolate: Boolean
read FInterpolate write FInterpolate;
property PaletteMax: Double
read FPaletteMax write SetPaletteMax;
property PaletteMin: Double
read FPaletteMin write SetPaletteMin;
property OnChanged: TNotifyEvent
read FOnChanged write FOnChanged;
end;
implementation
uses
GraphUtil, Math,
TAChartStrConsts, TAMath;
constructor TColorMap.Create(AOwner: TCustomChartSeries;
ANumXCountNeeded, ANumYCountNeeded: Integer);
const
BUILTIN_SOURCE_NAME = 'BuiltinColors';
begin
inherited Create(AOwner);
FNumXCountNeeded := ANumXCountNeeded;
FNumYCountNeeded := ANumYCountNeeded;
FColorSourceListener := TListener.Create(@FColorSource, @ColorSourceChanged);
FBuiltinColorSource := TBuiltinListChartSource.Create(self, ANumXCountNeeded, ANumYCountNeeded);
FBuiltinColorSource.XCount := ANumXCountNeeded;
FBuiltinColorSource.YCount := ANumYCountNeeded;
FBuiltinColorSource.Name := BUILTIN_SOURCE_NAME;
FBuiltinColorSource.Broadcaster.Subscribe(FColorSourceListener);
end;
destructor TColorMap.Destroy;
begin
FreeAndNil(FBuiltinColorSource);
FreeAndNil(FColorSourceListener);
inherited Destroy;
end;
procedure TColorMap.Assign(ASource: TPersistent);
begin
if ASource is TColorMap then
with TColorMap(ASource) do begin
Self.BuiltinPalette := FBuiltinPalette;
{
Self.BuiltinPaletteMax := FPaletteMax;
Self.BuiltinPaletteMin := FPaletteMin;
}
Self.ColorSource := FColorSource;
Self.FInterpolate := FInterpolate;
Self.FNumXCountNeeded := FNumXCountNeeded;
Self.FNumYCountNeeded := FNumYCountNeeded;
end;
inherited Assign(ASource);
end;
procedure TColorMap.BuildPalette(APalette: TColorMapPalette);
var
i: Integer;
h, s, l: Byte;
cmax, cmin, factor: Double;
ex: TDoubleRect;
begin
with FBuiltinColorSource do begin
BeginUpdate;
try
Clear;
case APalette of
cmpHot:
begin
Add(0, 0, '', clBlack);
Add(1/3, 0, '', clRed);
Add(2/3, 0, '', clYellow);
Add(1, 0, '', clWhite);
end;
cmpCold:
begin
ColorToHLS(clBlue, h, l, s);
i := 0;
while i <= 255 do begin
Add(i, 0, '', HLSToColor(h, i, s));
inc(i, 32);
end;
Add(255, 0, '', clWhite);
end;
cmpRainbow:
begin
i := 0;
while i <= 255 do begin // i is hue
Add(i, 0, '', HLSToColor(i, 128, 255));
inc(i, 32);
end;
Add(255, 0, '', HLSToColor(255, 128, 255));
end;
cmpMonochrome:
begin
i := 0;
while i <= 255 do begin
Add(i, 0, '', RgbToColor(i, i, i));
inc(i, 32);
end;
Add(255, 0, '', clWhite);
end;
else
raise EChartError.Create('[TAColorMap.BuildPalette] Palette kind not supported.');
end;
if FPaletteMin < FPaletteMax then begin
cmin := FPaletteMin;
cmax := FPaletteMax;
end else
if FPaletteMax < FPaletteMin then begin
cmin := FPaletteMax;
cmax := FPaletteMin;
end else
exit;
ex := Extent;
if (ex.a.x = ex.b.x) then
exit;
factor := (cmax - cmin) / (ex.b.x - ex.a.x);
for i:=0 to Count-1 do
Item[i]^.X := (Item[i]^.X - ex.a.x) * factor + cmin;
finally
EndUpdate;
end;
end;
end;
function TColorMap.ColorByValue(AValue: Double): TColor;
var
lb, ub: Integer;
c1, c2: TColor;
v1, v2: Double;
begin
if (ColorSource = nil) or (ColorSource.Count = 0) then
exit(clTAColor);
ColorSource.FindBounds(AValue, SafeInfinity, lb, ub);
if Interpolate and InRange(lb, 1, ColorSource.Count - 1) then begin
with ColorSource[lb - 1]^ do begin
v1 := X;
c1 := Color;
end;
with ColorSource[lb]^ do begin
v2 := X;
c2 := Color;
end;
if v2 <= v1 then
Result := c1
else
Result := InterpolateRGB(c1, c2, (AValue - v1) / (v2 - v1));
end
else
Result := ColorSource[EnsureRange(lb, 0, ColorSource.Count - 1)]^.Color;
end;
procedure TColorMap.CheckColorSource(ASource: TCustomChartSource);
begin
if ASource = nil then
exit;
if ASource.XCount < FNumXCountNeeded then
raise EXCountError.CreateFmt(rsSourceCountError, [ClassName, FNumXCountNeeded, 'x']);
if ASource.YCount < FNumYCountNeeded then
raise EYCountError.CreateFmt(rsSourceCountError, [ClassName, FNumYCountNeeded, 'y']);
end;
procedure TColorMap.ColorMapChanged(Sender: TObject);
begin
if Assigned(FOnChanged) then
FOnChanged(Sender);
end;
procedure TColorMap.ColorSourceChanged(Sender: TObject);
begin
if (Sender <> FBuiltinColorSource) and (Sender is TCustomChartSource) then
try
CheckColorSource(TCustomChartSource(Sender));
except
ColorSource := nil; // revert to built-in source
raise;
end;
UpdateColorExtent;
ColorMapChanged(Sender);
end;
function TColorMap.GetColorSource: TCustomChartSource;
begin
if Assigned(FColorSource) then
Result := FColorSource
else
Result := FBuiltinColorSource;
end;
function TColorMap.IsColorSourceStored: boolean;
begin
Result := FColorSource <> nil;
end;
function TColorMap.IsPaletteMaxStored: Boolean;
begin
Result := FPaletteMax <> 0;
end;
function TColorMap.IsPaletteMinStored: Boolean;
begin
Result := FPaletteMin <> 0;
end;
function TColorMap.OwnerSeries: TCustomChartSeries;
begin
Result := Owner as TCustomChartSeries;
end;
procedure TColorMap.SetBuiltinPalette(AValue: TColorMapPalette);
begin
FBuiltinPalette := AValue;
BuildPalette(FBuiltinPalette);
end;
procedure TColorMap.SetColorSource(AValue: TCustomChartSource);
begin
if AValue = FBuiltinColorSource then
AValue := nil;
if FColorSource = AValue then
exit;
CheckColorSource(AValue);
if FColorSourceListener.IsListening then
ColorSource.Broadcaster.Unsubscribe(FColorSourceListener);
FColorSource := AValue;
ColorSource.Broadcaster.Subscribe(FColorSourceListener);
ColorSourceChanged(Self);
end;
procedure TColorMap.SetPaletteMax(AValue: Double);
begin
if AValue = FPaletteMax then exit;
FPaletteMax := AValue;
BuildPalette(FBuiltinPalette);
end;
procedure TColorMap.SetPaletteMin(AValue: Double);
begin
if AValue = FPaletteMin then exit;
FPaletteMin := AValue;
BuildPalette(FBuiltinPalette);
end;
procedure TColorMap.UpdateColorExtent;
var
ext: TDoubleRect;
begin
if (csDestroying in ComponentState) then
exit;
ext := ColorSource.Extent;
FColorExtentMin := ext.a.x;
FColorExtentMax := ext.b.x;
end;
end.

View File

@ -20,7 +20,7 @@ interface
uses uses
Classes, Graphics, typ, Types, Classes, Graphics, typ, Types,
TAChartUtils, TACustomFuncSeries, TACustomSeries, TACustomSource, TASources, TAChartUtils, TACustomFuncSeries, TACustomSeries, TACustomSource, TASources,
TADrawUtils, TAFitUtils, TALegend, TATypes, TAFitLib, TAStyles; TADrawUtils, TAFitUtils, TALegend, TATypes, TAFitLib, TAStyles, TAColorMap;
const const
DEF_FUNC_STEP = 2; DEF_FUNC_STEP = 2;
@ -406,7 +406,7 @@ type
property OnGetPointerStyle; property OnGetPointerStyle;
end; end;
TColorMapPalette = (cmpHot, cmpCold, cmpRainbow, cmpMonochrome); TColorMapPalette = TAColorMap.TColorMapPalette;
TFuncCalculate3DEvent = TFuncCalculate3DEvent =
procedure (const AX, AY: Double; out AZ: Double) of object; procedure (const AX, AY: Double; out AZ: Double) of object;
@ -417,17 +417,17 @@ type
TUseImage = (cmuiAuto, cmuiAlways, cmuiNever); TUseImage = (cmuiAuto, cmuiAlways, cmuiNever);
strict private strict private
FBrush: TBrush; FBrush: TBrush;
FColorMap: TColorMap;
FColorSource: TCustomChartSource; FColorSource: TCustomChartSource;
FColorSourceListener: TListener; FColorSourceListener: TListener;
FInterpolate: Boolean; FInterpolate: Boolean;
FStepX: TFuncSeriesStep; FStepX: TFuncSeriesStep;
FStepY: TFuncSeriesStep; FStepY: TFuncSeriesStep;
FUseImage: TUseImage; FUseImage: TUseImage;
FColorExtentMin, FColorExtentMax: Double;
FBuiltinColorSource: TListChartSource;
FBuiltinPalette: TColormapPalette;
FPaletteMax: Double; FPaletteMax: Double;
FPaletteMin: Double; FPaletteMin: Double;
function GetBuiltinColorSource: TListChartSource;
function GetBuiltinPalette: TColorMapPalette;
function GetColorSource: TCustomChartSource; function GetColorSource: TCustomChartSource;
function IsColorSourceStored: boolean; function IsColorSourceStored: boolean;
function IsPaletteMaxStored: Boolean; function IsPaletteMaxStored: Boolean;
@ -443,13 +443,10 @@ type
procedure SetUseImage(AValue: TUseImage); procedure SetUseImage(AValue: TUseImage);
protected protected
FMinZ, FMaxZ: Double; FMinZ, FMaxZ: Double;
procedure BuildPalette(APalette: TColorMapPalette);
procedure CheckColorSource(ASource: TCustomChartSource);
procedure ColorSourceChanged(ASender: TObject); virtual;
procedure GetLegendItems(AItems: TChartLegendItems); override; procedure GetLegendItems(AItems: TChartLegendItems); override;
procedure GetZRange(ARect: TRect; dx, dy: Integer); procedure GetZRange(ARect: TRect; dx, dy: Integer);
procedure UpdateColorExtent;
class procedure GetXYCountNeeded(out AXCount, AYCount: Cardinal); virtual; class procedure GetXYCountNeeded(out AXCount, AYCount: Cardinal); virtual;
property BuiltinColorSource: TListChartSource read GetBuiltinColorSource;
public public
procedure Assign(ASource: TPersistent); override; procedure Assign(ASource: TPersistent); override;
@ -457,7 +454,6 @@ type
destructor Destroy; override; destructor Destroy; override;
public public
function ColorByValue(AValue: Double): TColor;
function FunctionValue(AX, AY: Double): Double; virtual; function FunctionValue(AX, AY: Double): Double; virtual;
procedure Draw(ADrawer: IChartDrawer); override; procedure Draw(ADrawer: IChartDrawer); override;
function IsEmpty: Boolean; override; function IsEmpty: Boolean; override;
@ -466,7 +462,7 @@ type
property AxisIndexY; property AxisIndexY;
property Brush: TBrush read FBrush write SetBrush; property Brush: TBrush read FBrush write SetBrush;
property BuiltInPalette: TColorMapPalette property BuiltInPalette: TColorMapPalette
read FBuiltinPalette write SetBuiltinPalette default cmpHot; read GetBuiltinPalette write SetBuiltinPalette default cmpHot;
property BuiltInPaletteMax: Double property BuiltInPaletteMax: Double
read FPaletteMax write SetPaletteMax stored IsPaletteMaxStored; read FPaletteMax write SetPaletteMax stored IsPaletteMaxStored;
property BuiltInPaletteMin: Double property BuiltInPaletteMin: Double
@ -2461,163 +2457,42 @@ end;
{ TCustomColorMapSeries } { TCustomColorMapSeries }
procedure TCustomColorMapSeries.Assign(ASource: TPersistent);
begin
if ASource is TCustomColorMapSeries then
with TCustomColorMapSeries(ASource) do begin
Self.Brush := FBrush;
Self.BuiltinPalette := FBuiltinPalette;
Self.BuiltinPaletteMax := FPaletteMax;
Self.BuiltinPaletteMin := FPaletteMin;
Self.ColorSource := FColorSource;
Self.FInterpolate := FInterpolate;
Self.FStepX := FStepX;
Self.FStepY := FStepY;
end;
inherited Assign(ASource);
end;
procedure TCustomColorMapSeries.BuildPalette(APalette: TColorMapPalette);
var
i: Integer;
h, s, l: Byte;
cmax, cmin, factor: Double;
ex: TDoubleRect;
begin
with FBuiltinColorSource do begin
BeginUpdate;
try
Clear;
case APalette of
cmpHot:
begin
Add(0, 0, '', clBlack);
Add(1/3, 0, '', clRed);
Add(2/3, 0, '', clYellow);
Add(1, 0, '', clWhite);
end;
cmpCold:
begin
ColorToHLS(clBlue, h, l, s);
i := 0;
while i <= 255 do begin
Add(i, 0, '', HLSToColor(h, i, s));
inc(i, 32);
end;
Add(255, 0, '', clWhite);
end;
cmpRainbow:
begin
i := 0;
while i <= 255 do begin // i is hue
Add(i, 0, '', HLSToColor(i, 128, 255));
inc(i, 32);
end;
Add(255, 0, '', HLSToColor(255, 128, 255));
end;
cmpMonochrome:
begin
i := 0;
while i <= 255 do begin
Add(i, 0, '', RgbToColor(i, i, i));
inc(i, 32);
end;
Add(255, 0, '', clWhite);
end;
else
raise EChartError.CreateFmt('[%s.BuildPalette] Palette not supported', [NameOrClassName(Self)]){%H-};
end;
if FPaletteMin < FPaletteMax then begin
cmin := FPaletteMin;
cmax := FPaletteMax;
end else
if FPaletteMax < FPaletteMin then begin
cmin := FPaletteMax;
cmax := FPaletteMin;
end else
exit;
ex := Extent;
if (ex.a.x = ex.b.x) then
exit;
factor := (cmax - cmin) / (ex.b.x - ex.a.x);
for i:=0 to Count-1 do
Item[i]^.X := (Item[i]^.X - ex.a.x) * factor + cmin;
finally
EndUpdate;
end;
end;
end;
procedure TCustomColorMapSeries.CheckColorSource(ASource: TCustomChartSource);
var
nx, ny: Cardinal;
begin
if ASource = nil then
exit;
GetXYCountNeeded(nx, ny);
if ASource.XCount < nx then
raise EXCountError.CreateFmt(rsSourceCountError, [ClassName, nx, 'x']);
if ASource.YCount < ny then
raise EYCountError.CreateFmt(rsSourceCountError, [ClassName, ny, 'y']);
end;
function TCustomColorMapSeries.ColorByValue(AValue: Double): TColor;
var
lb, ub: Integer;
c1, c2: TColor;
v1, v2: Double;
begin
if (ColorSource = nil) or (ColorSource.Count = 0) then exit(clTAColor);
ColorSource.FindBounds(AValue, SafeInfinity, lb, ub);
if Interpolate and InRange(lb, 1, ColorSource.Count - 1) then begin
with ColorSource[lb - 1]^ do begin
v1 := X;
c1 := Color;
end;
with ColorSource[lb]^ do begin
v2 := X;
c2 := Color;
end;
if v2 <= v1 then
Result := c1
else
Result := InterpolateRGB(c1, c2, (AValue - v1) / (v2 - v1));
end
else
Result := ColorSource[EnsureRange(lb, 0, ColorSource.Count - 1)]^.Color;
end;
constructor TCustomColorMapSeries.Create(AOwner: TComponent); constructor TCustomColorMapSeries.Create(AOwner: TComponent);
const
BUILTIN_SOURCE_NAME = 'BuiltinColors';
var var
nx, ny: Cardinal; nx, ny: Cardinal;
begin begin
inherited Create(AOwner); inherited Create(AOwner);
FColorSourceListener := TListener.Create(@FColorSource, @ColorSourceChanged);
GetXYCountNeeded(nx, ny); GetXYCountNeeded(nx, ny);
FBuiltinColorSource := TBuiltinListChartSource.Create(self, nx, ny); FColorMap := TColorMap.Create(Self, nx, ny);
FBuiltinColorSource.XCount := nx; FColorMap.BuiltinPalette := cmpHot;
FBuiltinColorSource.YCount := ny; FColorMap.OnChanged := @StyleChanged;
FBuiltinColorSource.Name := BUILTIN_SOURCE_NAME;
FBuiltinColorSource.Broadcaster.Subscribe(FColorSourceListener);
FBrush := TBrush.Create; FBrush := TBrush.Create;
FBrush.OnChange := @StyleChanged; FBrush.OnChange := @StyleChanged;
FStepX := DEF_COLORMAP_STEP; FStepX := DEF_COLORMAP_STEP;
FStepY := DEF_COLORMAP_STEP; FStepY := DEF_COLORMAP_STEP;
SetBuiltinPalette(cmpHot);
end; end;
destructor TCustomColorMapSeries.Destroy; destructor TCustomColorMapSeries.Destroy;
begin begin
FreeAndNil(FColorSourceListener); FreeAndNil(FColorMap);
FreeAndNil(FBuiltinColorSource);
FreeAndNil(FBrush); FreeAndNil(FBrush);
inherited Destroy; inherited Destroy;
end; end;
procedure TCustomColorMapSeries.Assign(ASource: TPersistent);
begin
if ASource is TCustomColorMapSeries then
with TCustomColorMapSeries(ASource) do begin
Self.FColorMap := FColorMap;
Self.Brush := FBrush;
Self.FStepX := FStepX;
Self.FStepY := FStepY;
end;
inherited Assign(ASource);
end;
procedure TCustomColorMapSeries.Draw(ADrawer: IChartDrawer); procedure TCustomColorMapSeries.Draw(ADrawer: IChartDrawer);
var var
ext: TDoubleRect; ext: TDoubleRect;
@ -2666,7 +2541,7 @@ begin
GetZRange(r, scaled_stepX, scaled_stepY); GetZRange(r, scaled_stepX, scaled_stepY);
if FColorExtentMin = FColorExtentMax then begin if FColorMap.ColorExtentMin = FColorMap.ColorExtentMax then begin
ADrawer.FillRect(r.Left, r.Top, r.Right, r.Bottom); ADrawer.FillRect(r.Left, r.Top, r.Right, r.Bottom);
exit; exit;
end; end;
@ -2696,14 +2571,14 @@ begin
if ColorSource = nil then if ColorSource = nil then
cellColor := Brush.Color cellColor := Brush.Color
else else
cellColor := ColorByValue(v); cellColor := FColorMap.ColorByValue(v);
for y := cell.Top - r.Top to cell.Bottom - r.Top - 2 do for y := cell.Top - r.Top to cell.Bottom - r.Top - 2 do
for x := cell.Left - r.Left to cell.Right - r.Left - 2 do for x := cell.Left - r.Left to cell.Right - r.Left - 2 do
img.TColors[x, y] := cellColor; img.TColors[x, y] := cellColor;
end end
else begin else begin
if ColorSource <> nil then if ColorSource <> nil then
ADrawer.BrushColor := ColorByValue(v); ADrawer.BrushColor := FColorMap.ColorByValue(v);
ADrawer.Rectangle(cell); ADrawer.Rectangle(cell);
end; end;
pt.X := next.X; pt.X := next.X;
@ -2723,12 +2598,19 @@ begin
Result := 0.0; Result := 0.0;
end; end;
function TCustomColorMapSeries.GetBuiltinColorSource: TListChartSource;
begin
Result := FColorMap.BuiltinColorSource;
end;
function TCustomColorMapSeries.GetBuiltinPalette: TColorMapPalette;
begin
Result := FColorMap.BuiltinPalette;
end;
function TCustomColorMapSeries.GetColorSource: TCustomChartSource; function TCustomColorMapSeries.GetColorSource: TCustomChartSource;
begin begin
if Assigned(FColorSource) then Result := FColorMap.ColorSource;
Result := FColorSource
else
Result := FBuiltinColorSource;
end; end;
procedure TCustomColorMapSeries.GetLegendItems(AItems: TChartLegendItems); procedure TCustomColorMapSeries.GetLegendItems(AItems: TChartLegendItems);
@ -2854,17 +2736,17 @@ end;
function TCustomColorMapSeries.IsColorSourceStored: boolean; function TCustomColorMapSeries.IsColorSourceStored: boolean;
begin begin
Result := FColorSource <> nil; Result := FColorMap.IsColorSourceStored;
end; end;
function TCustomColorMapSeries.IsPaletteMaxStored: Boolean; function TCustomColorMapSeries.IsPaletteMaxStored: Boolean;
begin begin
Result := FPaletteMax <> 0; Result := FColorMap.IsPaletteMaxStored;
end; end;
function TCustomColorMapSeries.IsPaletteMinStored: Boolean; function TCustomColorMapSeries.IsPaletteMinStored: Boolean;
begin begin
Result := FPaletteMin <> 0; Result := FColorMap.IsPaletteMinStored;
end; end;
procedure TCustomColorMapSeries.SetBrush(AValue: TBrush); procedure TCustomColorMapSeries.SetBrush(AValue: TBrush);
@ -2876,43 +2758,29 @@ end;
procedure TCustomColorMapSeries.SetBuiltinPalette(AValue: TColorMapPalette); procedure TCustomColorMapSeries.SetBuiltinPalette(AValue: TColorMapPalette);
begin begin
FBuiltinPalette := AValue; FColorMap.BuiltinPalette := AValue;
BuildPalette(FBuiltinPalette);
end; end;
procedure TCustomColorMapSeries.SetColorSource(AValue: TCustomChartSource); procedure TCustomColorMapSeries.SetColorSource(AValue: TCustomChartSource);
begin begin
if AValue = FBuiltinColorSource then FColorMap.ColorSource := AValue;
AValue := nil;
if FColorSource = AValue then
exit;
CheckColorSource(AValue);
if FColorSourceListener.IsListening then
ColorSource.Broadcaster.Unsubscribe(FColorSourceListener);
FColorSource := AValue;
ColorSource.Broadcaster.Subscribe(FColorSourceListener);
ColorSourceChanged(Self);
end; end;
procedure TCustomColorMapSeries.SetInterpolate(AValue: Boolean); procedure TCustomColorMapSeries.SetInterpolate(AValue: Boolean);
begin begin
if FInterpolate = AValue then exit; if FInterpolate = AValue then exit;
FInterpolate := AValue; FColorMap.Interpolate := AValue;
UpdateParentChart; UpdateParentChart;
end; end;
procedure TCustomColorMapSeries.SetPaletteMax(AValue: Double); procedure TCustomColorMapSeries.SetPaletteMax(AValue: Double);
begin begin
if AValue = FPaletteMax then exit; FColorMap.PaletteMax := AValue;
FPaletteMax := AValue;
BuildPalette(FBuiltinPalette);
end; end;
procedure TCustomColorMapSeries.SetPaletteMin(AValue: Double); procedure TCustomColorMapSeries.SetPaletteMin(AValue: Double);
begin begin
if AValue = FPaletteMin then exit; FColorMap.PaletteMin := AValue;
FPaletteMin := AValue;
BuildPalette(FBuiltinPalette);
end; end;
procedure TCustomColorMapSeries.SetStepX(AValue: TFuncSeriesStep); procedure TCustomColorMapSeries.SetStepX(AValue: TFuncSeriesStep);
@ -2936,28 +2804,6 @@ begin
UpdateParentChart; UpdateParentChart;
end; end;
procedure TCustomColorMapSeries.ColorSourceChanged(ASender: TObject);
begin
if (ASender <> FBuiltinColorSource) and (ASender is TCustomChartSource) then
try
CheckColorSource(TCustomChartSource(ASender));
except
ColorSource := nil; // revert to built-in source
raise;
end;
UpdateColorExtent;
StyleChanged(ASender);
end;
procedure TCustomColorMapSeries.UpdateColorExtent;
var
ext: TDoubleRect;
begin
ext := ColorSource.Extent;
FColorExtentMin := ext.a.x;
FColorExtentMax := ext.b.x;
end;
{ TColorMapSeries } { TColorMapSeries }