TAChart: Fix TChartColorMapSeries legend items when BuiltinPalette is used: Add new properties BuiltInPaletteMax and BuildInPaletteMin, remove property AutoMapColors. Update "func" demo.

git-svn-id: trunk@58900 -
2025-04-23 01:39:31 +02:00 · 2018-09-07 09:00:16 +00:00 · 2018-09-07 09:00:16 +00:00 · 813b5366b2
commit 813b5366b2
parent 0c95cf6607
4 changed files with 185 additions and 47 deletions
--- a/components/tachart/demo/func/funcdemo.lpi
+++ b/components/tachart/demo/func/funcdemo.lpi
@ -1,7 +1,7 @@
 <?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
  <ProjectOptions>
-    <Version Value="10"/>
+    <Version Value="11"/>
    <PathDelim Value="\"/>
    <General>
      <Flags>
@ -18,15 +18,19 @@
    </BuildModes>
    <PublishOptions>
      <Version Value="2"/>
-      <IgnoreBinaries Value="False"/>
-      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
-      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
    </PublishOptions>
    <RunParams>
      <local>
-        <FormatVersion Value="1"/>
        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
      </local>
+      <FormatVersion Value="2"/>
+      <Modes Count="1">
+        <Mode0 Name="default">
+          <local>
+            <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+          </local>
+        </Mode0>
+      </Modes>
    </RunParams>
    <RequiredPackages Count="4">
      <Item1>
--- a/components/tachart/demo/func/main.lfm
+++ b/components/tachart/demo/func/main.lfm
@ -32,14 +32,18 @@ object Form1: TForm1
          item
            Grid.Color = clGray
            TickLength = 0
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
            Title.LabelFont.Orientation = 900
+            Title.LabelBrush.Style = bsClear
          end        
          item
            Grid.Color = clGray
            TickLength = 0
            Alignment = calBottom
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
+            Title.LabelBrush.Style = bsClear
          end>
        ExpandPercentage = 5
        Extent.UseYMax = True
@ -97,9 +101,9 @@ object Form1: TForm1
        end
      end
      object cbDomain: TCheckBox
-        Left = 470
+        Left = 464
        Height = 19
-        Top = 391
+        Top = 392
        Width = 62
        Anchors = [akRight, akBottom]
        Caption = 'Domain'
@ -107,7 +111,7 @@ object Form1: TForm1
        TabOrder = 1
      end
      object cbRotate: TCheckBox
-        Left = 470
+        Left = 464
        Height = 19
        Top = 367
        Width = 54
@ -129,14 +133,18 @@ object Form1: TForm1
        AxisList = <        
          item
            MarginsForMarks = False
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
            Title.LabelFont.Orientation = 900
+            Title.LabelBrush.Style = bsClear
            ZPosition = 1
          end        
          item
            Alignment = calBottom
            MarginsForMarks = False
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
+            Title.LabelBrush.Style = bsClear
            ZPosition = 1
          end>
        Extent.UseXMax = True
@ -161,6 +169,8 @@ object Form1: TForm1
          Extent.XMax = 0.5
          Extent.XMin = -0.5
          Title = 'sin(10x + 17y)'
+          BuiltInPaletteMax = 1
+          BuiltInPaletteMin = -1
          ColorSource = ListChartSource1
          OnCalculate = ChartColorMapColorMapSeries1Calculate
        end
@ -184,25 +194,75 @@ object Form1: TForm1
          Align = alTop
        end
        object cbInterpolate: TCheckBox
+          AnchorSideLeft.Control = Panel1
+          AnchorSideBottom.Control = lblPalette
          Left = 8
          Height = 19
-          Top = 399
+          Top = 354
          Width = 77
          Anchors = [akLeft, akBottom]
+          BorderSpacing.Left = 8
+          BorderSpacing.Bottom = 8
          Caption = 'Interpolate'
          OnChange = cbInterpolateChange
          TabOrder = 1
        end
        object cbMultLegend: TCheckBox
+          AnchorSideLeft.Control = Panel1
+          AnchorSideBottom.Control = cbInterpolate
          Left = 8
          Height = 19
-          Top = 371
+          Top = 327
          Width = 97
          Anchors = [akLeft, akBottom]
+          BorderSpacing.Left = 8
+          BorderSpacing.Bottom = 8
          Caption = 'Expand legend'
          OnChange = cbMultLegendChange
          TabOrder = 2
        end
+        object cmbPalette: TComboBox
+          AnchorSideLeft.Control = Panel1
+          AnchorSideRight.Control = Panel1
+          AnchorSideRight.Side = asrBottom
+          AnchorSideBottom.Control = Panel1
+          AnchorSideBottom.Side = asrBottom
+          Left = 8
+          Height = 23
+          Top = 400
+          Width = 105
+          Anchors = [akLeft, akRight, akBottom]
+          BorderSpacing.Left = 8
+          BorderSpacing.Right = 8
+          BorderSpacing.Bottom = 8
+          ItemHeight = 15
+          ItemIndex = 4
+          Items.Strings = (
+            'cmpHot'
+            'cmpCold'
+            'cmpRainbow'
+            'cmpMonochrome'
+            '(ColorSource)'
+          )
+          OnChange = cmbPaletteChange
+          Style = csDropDownList
+          TabOrder = 3
+          Text = '(ColorSource)'
+        end
+        object lblPalette: TLabel
+          AnchorSideLeft.Control = Panel1
+          AnchorSideBottom.Control = cmbPalette
+          Left = 8
+          Height = 15
+          Top = 381
+          Width = 36
+          Anchors = [akLeft, akBottom]
+          BorderSpacing.Left = 8
+          BorderSpacing.Bottom = 4
+          Caption = 'Palette'
+          FocusControl = cmbPalette
+          ParentColor = False
+        end
      end
      object Splitter1: TSplitter
        Left = 416
@ -228,15 +288,19 @@ object Form1: TForm1
            Grid.Cosmetic = False
            Intervals.Options = [aipGraphCoords, aipUseCount, aipUseMinLength, aipUseNiceSteps]
            Intervals.Tolerance = 2
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
            Title.LabelFont.Orientation = 900
+            Title.LabelBrush.Style = bsClear
            Transformations = catSpline
          end        
          item
            Grid.Color = clGray
            Grid.Cosmetic = False
            Alignment = calBottom
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
+            Title.LabelBrush.Style = bsClear
          end>
        ExpandPercentage = 5
        Foot.Brush.Color = clBtnFace
@ -269,7 +333,7 @@ object Form1: TForm1
          AxisIndexY = 0
          Pointer.Brush.Color = clAqua
          Source = RandomChartSource1
-          Options = [csoDrawFewPoints, csoDrawUnorderedX]
+          Options = [csoDrawUnorderedX]
          Pen.Color = clAqua
          Pen.Width = 2
        end
@ -396,12 +460,16 @@ object Form1: TForm1
        Width = 542
        AxisList = <        
          item
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
            Title.LabelFont.Orientation = 900
+            Title.LabelBrush.Style = bsClear
          end        
          item
            Alignment = calBottom
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
+            Title.LabelBrush.Style = bsClear
          end>
        Foot.Brush.Color = clBtnFace
        Foot.Font.Color = clBlue
@ -462,12 +530,16 @@ object Form1: TForm1
        Width = 412
        AxisList = <        
          item
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
            Title.LabelFont.Orientation = 900
+            Title.LabelBrush.Style = bsClear
          end        
          item
            Alignment = calBottom
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
+            Title.LabelBrush.Style = bsClear
          end>
        Foot.Brush.Color = clBtnFace
        Foot.Font.Color = clBlue
@ -777,16 +849,20 @@ object Form1: TForm1
        Width = 542
        AxisList = <        
          item
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
            Title.LabelFont.Orientation = 900
            Title.Visible = True
            Title.Caption = 'y'
+            Title.LabelBrush.Style = bsClear
          end        
          item
            Alignment = calBottom
+            Marks.LabelBrush.Style = bsClear
            Minors = <>
            Title.Visible = True
            Title.Caption = 'x'
+            Title.LabelBrush.Style = bsClear
          end>
        Foot.Brush.Color = clBtnFace
        Foot.Font.Color = clBlue
@ -842,6 +918,7 @@ object Form1: TForm1
    top = 180
    object chtsColorMapZoomDragTool1: TZoomDragTool
      Shift = [ssLeft]
+      Brush.Style = bsClear
    end
    object chtsColorMapPanDragTool1: TPanDragTool
      Shift = [ssRight]
@ -868,7 +945,7 @@ object Form1: TForm1
  object Timer1: TTimer
    Interval = 200
    OnTimer = Timer1Timer
-    left = 448
-    top = 296
+    left = 440
+    top = 248
  end
 end
--- a/components/tachart/demo/func/main.pas
+++ b/components/tachart/demo/func/main.pas
@ -28,6 +28,7 @@ type
    Chart1YAxis: TConstantLine;
    catSpline: TChartAxisTransformations;
    catSplineLogarithmAxisTransform: TLogarithmAxisTransform;
+    cmbPalette: TComboBox;
    ExpressionChart: TChart;
    ExpressionSeries: TExpressionSeries;
    chParametric: TChart;
@ -49,6 +50,7 @@ type
    EdExprDomain: TEdit;
    EdExprParamA: TEdit;
    EdExprParamB: TEdit;
+    lblPalette: TLabel;
    LblExpression: TLabel;
    LblExprDomain: TLabel;
    LblExprParamA: TLabel;
@ -100,6 +102,7 @@ type
      AY: Double);
    procedure chParametricParametricCurveSeries1Calculate(const AT: Double; out
      AX, AY: Double);
+    procedure cmbPaletteChange(Sender: TObject);
    procedure EdExprDomainEditingDone(Sender: TObject);
    procedure EdExpressionEditingDone(Sender: TObject);
    procedure EdExprParamAEditingDone(Sender: TObject);
@ -219,6 +222,15 @@ begin
  AY := Sin(c * AT) - IntPower(Sin(d * AT), seK.Value);
 end;

+procedure TForm1.cmbPaletteChange(Sender: TObject);
+begin
+  if cmbPalette.ItemIndex < cmbPalette.Items.Count-1 then begin
+    ChartColorMapColorMapSeries1.ColorSource := nil;
+    ChartColorMapColorMapSeries1.BuiltinPalette := TColorMapPalette(cmbPalette.ItemIndex);
+  end else
+    ChartColorMapColorMapSeries1.ColorSource := ListChartSource1;
+end;
+
 procedure TForm1.EdExprDomainEditingDone(Sender: TObject);
 begin
  ExpressionSeries.Domain := EdExprDomain.Text;
--- a/components/tachart/tafuncseries.pas
+++ b/components/tachart/tafuncseries.pas
@ -412,17 +412,21 @@ type
    FStepX: TFuncSeriesStep;
    FStepY: TFuncSeriesStep;
    FUseImage: TUseImage;
-    FAutoMapColors: Boolean;
    FColorExtentMin, FColorExtentMax: Double;
    FBuiltinColorSource: TCustomChartSource;
    FBuiltinPalette: TColormapPalette;
+    FPaletteMax: Double;
+    FPaletteMin: Double;
    function GetColorSource: TCustomChartSource;
    function IsColorSourceStored: boolean;
-    procedure SetAutoMapColors(AValue: Boolean);
+    function IsPaletteMaxStored: Boolean;
+    function IsPaletteMinStored: Boolean;
    procedure SetBrush(AValue: TBrush);
    procedure SetBuiltinPalette(AValue: TColorMapPalette);
    procedure SetColorSource(AValue: TCustomChartSource);
    procedure SetInterpolate(AValue: Boolean);
+    procedure SetPaletteMax(AValue: Double);
+    procedure SetPaletteMin(AValue: Double);
    procedure SetStepX(AValue: TFuncSeriesStep);
    procedure SetStepY(AValue: TFuncSeriesStep);
    procedure SetUseImage(AValue: TUseImage);
@ -431,6 +435,7 @@ type
    procedure BuildPalette(APalette: TColorMapPalette);
    procedure GetLegendItems(AItems: TChartLegendItems); override;
    procedure GetZRange(ARect: TRect; dx, dy: Integer);
+    procedure UpdateColorExtent;

  public
    procedure Assign(ASource: TPersistent); override;
@ -443,13 +448,15 @@ type
    procedure Draw(ADrawer: IChartDrawer); override;
    function IsEmpty: Boolean; override;
  published
-    property AutoMapColors: Boolean
-      read FAutoMapColors write SetAutoMapColors default false;
    property AxisIndexX;
    property AxisIndexY;
    property Brush: TBrush read FBrush write SetBrush;
    property BuiltInPalette: TColorMapPalette
      read FBuiltinPalette write SetBuiltinPalette default cmpHot;
+    property BuiltInPaletteMax: Double
+      read FPaletteMax write SetPaletteMax stored IsPaletteMaxStored;
+    property BuiltInPaletteMin: Double
+      read FPaletteMin write SetPaletteMin stored IsPaletteMinStored;
    property ColorSource: TCustomChartSource
      read GetColorSource write SetColorSource stored IsColorSourceStored;
    property Interpolate: Boolean
@ -2079,9 +2086,10 @@ procedure TCustomColorMapSeries.Assign(ASource: TPersistent);
 begin
  if ASource is TCustomColorMapSeries then
    with TCustomColorMapSeries(ASource) do begin
-      Self.AutoMapColors := FAutoMapColors;
      Self.Brush := FBrush;
      Self.BuiltinPalette := FBuiltinPalette;
+      Self.BuiltinPaletteMax := FPaletteMax;
+      Self.BuiltinPaletteMin := FPaletteMin;
      Self.ColorSource := FColorSource;
      Self.FInterpolate := FInterpolate;
      Self.FStepX := FStepX;
@ -2093,7 +2101,9 @@ end;
 procedure TCustomColorMapSeries.BuildPalette(APalette: TColorMapPalette);
 var
  i: Integer;
-  h,s,l: Byte;
+  h, s, l: Byte;
+  cmax, cmin, factor: Double;
+  ex: TDoubleRect;
 begin
  with FBuiltinColorSource as TListChartSource do begin
    BeginUpdate;
@ -2138,6 +2148,29 @@ begin
      else
        raise Exception.Create('Palette 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;
+
+      with FBuiltInColorSource do begin
+        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;
+      end;
+
+      if FColorSource = nil then
+        UpdateColorExtent;
+
    finally
      EndUpdate;
    end;
@ -2151,16 +2184,6 @@ var
  v1, v2: Double;
 begin
  if (ColorSource = nil) or (ColorSource.Count = 0) then exit(clTAColor);
-
-  if FAutoMapColors then begin
-    // Transform data value to the values assigned to the colorsource
-    if FMinZ <> FMaxZ then begin
-      AValue := (AValue - FMinZ) / (FMaxZ - FMinZ);
-      AValue := AValue * (FColorExtentMax - FColorExtentMin) + FColorExtentMin;
-    end else
-      AValue := FColorExtentMin;
-  end;
-
  ColorSource.FindBounds(AValue, SafeInfinity, lb, ub);
  if Interpolate and InRange(lb, 1, ColorSource.Count - 1) then begin
    with ColorSource[lb - 1]^ do begin
@ -2207,6 +2230,7 @@ end;
 procedure TCustomColorMapSeries.Draw(ADrawer: IChartDrawer);
 var
  ext: TDoubleRect;
+//  cext: TDoubleRect;
  bounds: TDoubleRect;
  r, cell: TRect;
  pt, next, offset: TPoint;
@ -2251,6 +2275,11 @@ begin

  GetZRange(r, scaled_stepX, scaled_stepY);

+  if FColorExtentMin = FColorExtentMax then begin
+    ADrawer.FillRect(r.Left, r.Top, r.Right, r.Bottom);
+    exit;
+  end;
+
  try
    pt.Y := (r.Top div scaled_stepY - 1) * scaled_stepY + offset.Y mod scaled_stepY;
    while pt.Y <= r.Bottom do begin
@ -2429,11 +2458,14 @@ begin
  Result := FColorSource <> nil;
 end;

-procedure TCustomColorMapSeries.SetAutoMapColors(AValue: Boolean);
+function TCustomColorMapSeries.IsPaletteMaxStored: Boolean;
 begin
-  if FAutoMapColors = AValue then exit;
-  FAutoMapColors := AValue;
-  UpdateParentChart;
+  Result := FPaletteMax <> 0;
+end;
+
+function TCustomColorMapSeries.IsPaletteMinStored: Boolean;
+begin
+  Result := FPaletteMin <> 0;
 end;

 procedure TCustomColorMapSeries.SetBrush(AValue: TBrush);
@ -2444,32 +2476,20 @@ begin
 end;

 procedure TCustomColorMapSeries.SetBuiltinPalette(AValue: TColorMapPalette);
-var
-  ex: TDoubleRect;
 begin
-//  if FBuiltinPalette = AValue then exit;
  FBuiltinPalette := AValue;
  BuildPalette(FBuiltinPalette);
-  if FColorSource = nil then begin
-    ex := FBuiltinColorSource.Extent;
-    FColorExtentMin := ex.a.x;
-    FColorExtentMax := ex.b.x;
-    UpdateParentChart;
-  end;
+  UpdateParentChart;
 end;

 procedure TCustomColorMapSeries.SetColorSource(AValue: TCustomChartSource);
-var
-  ex: TDoubleRect;
 begin
  if FColorSource = AValue then exit;
  if FColorSourceListener.IsListening then
    ColorSource.Broadcaster.Unsubscribe(FColorSourceListener);
  FColorSource := AValue;
  ColorSource.Broadcaster.Subscribe(FColorSourceListener);
-  ex := ColorSource.Extent;
-  FColorExtentMin := ex.a.x;
-  FColorExtentMax := ex.b.x;
+  UpdateColorExtent;
  UpdateParentChart;
 end;

@ -2480,6 +2500,22 @@ begin
  UpdateParentChart;
 end;

+procedure TCustomColorMapSeries.SetPaletteMax(AValue: Double);
+begin
+  if AValue = FPaletteMax then exit;
+  FPaletteMax := AValue;
+  BuildPalette(FBuiltinPalette);
+  UpdateParentChart;
+end;
+
+procedure TCustomColorMapSeries.SetPaletteMin(AValue: Double);
+begin
+  if AValue = FPaletteMin then exit;
+  FPaletteMin := AValue;
+  BuildPalette(FBuiltinPalette);
+  UpdateParentChart;
+end;
+
 procedure TCustomColorMapSeries.SetStepX(AValue: TFuncSeriesStep);
 begin
  if FStepX = AValue then exit;
@ -2501,6 +2537,15 @@ begin
  UpdateParentChart;
 end;

+procedure TCustomColorMapSeries.UpdateColorExtent;
+var
+  ext: TDoubleRect;
+begin
+  ext := ColorSource.Extent;
+  FColorExtentMin := ext.a.x;
+  FColorExtentMax := ext.b.x;
+end;
+

 { TColorMapSeries }