TAChart: Improved drawing speed of TColorMapSeries

components/tachart/tafuncseries.pas

@@ -18,7 +18,7 @@ unit TAFuncSeries;
 interface
 
 uses
-  Classes, Graphics, typ, Types,
+  Classes, Graphics, typ, Types, IntfGraphics,
   TAChartUtils, TACustomFuncSeries, TACustomSeries, TACustomSource, TASources,
   TADrawUtils, TAFitUtils, TALegend, TATypes, TAFitLib, TAStyles, TAColorMap;
 
@@ -421,6 +421,7 @@ type
     FStepX: TFuncSeriesStep;
     FStepY: TFuncSeriesStep;
     FUseImage: TUseImage;
+    FBufferImage: TLazIntfImage;
     function GetBuiltinColorSource: TListChartSource;
     function GetBuiltinPalette: TColorMapPalette;
     function GetColorSource: TCustomChartSource;
@@ -441,9 +442,11 @@ type
     procedure SetUseImage(AValue: TUseImage);
   protected
     FMinZ, FMaxZ: Double;
+    function BufferImageValid: Boolean;
     procedure GetLegendItems(AItems: TChartLegendItems); override;
     procedure GetZRange(ARect: TRect; dx, dy: Integer);
     class procedure GetXYCountNeeded(out AXCount, AYCount: Cardinal); virtual;
+    procedure InvalidateBufferImage;
     property BuiltinColorSource: TListChartSource read GetBuiltinColorSource;
 
   public
@@ -452,8 +455,9 @@ type
     procedure Assign(ASource: TPersistent); override;
 
   public
-    function FunctionValue(AX, AY: Double): Double; virtual;
+    procedure ClipRectChanged; override;
     procedure Draw(ADrawer: IChartDrawer); override;
+    function FunctionValue(AX, AY: Double): Double; virtual;
     function IsEmpty: Boolean; override;
   published
     property AxisIndexX;
@@ -501,7 +505,7 @@ implementation
 
 uses
   {$IF FPC_FullVersion >= 30101}ipf{$ELSE}ipf_fix{$ENDIF},
-  GraphType, GraphUtil, IntfGraphics, Math, spe, StrUtils, SysUtils,
+  GraphType, GraphUtil, Math, spe, StrUtils, SysUtils,
   TAChartStrConsts, TAGeometry, TAGraph, TAMath;
 
 const
@@ -2474,6 +2478,7 @@ end;
 
 destructor TCustomColorMapSeries.Destroy;
 begin
+  FreeAndNil(FBufferImage);
   FreeAndNil(FColorMap);
   FreeAndNil(FBrush);
   inherited Destroy;
@@ -2491,6 +2496,20 @@ begin
   inherited Assign(ASource);
 end;
 
+{ Returns whether there exists a buffer image of the color map at the moment. }
+function TCustomColorMapSeries.BufferImageValid: Boolean;
+begin
+  Result := Assigned(FBufferImage);
+end;
+
+{ Is called by the chart when it detects a change in the clip rect (series area).
+  The ColorMapSeries must recalculate the buffer image afterwards in the
+  next paint event. }
+procedure TCustomColorMapSeries.ClipRectChanged;
+begin
+  InvalidateBufferImage;
+end;
+
 procedure TCustomColorMapSeries.Draw(ADrawer: IChartDrawer);
 var
   ext: TDoubleRect;
@@ -2500,7 +2519,6 @@ var
   pt, next, offset: TPoint;
   gp: TDoublePoint;
   v: Double;
-  img: TLazIntfImage = nil;
   rawImage: TRawImage;
   optimize: Boolean;
   x, y: Integer;
@@ -2528,8 +2546,18 @@ begin
     cmuiNever: optimize := false;
   end;
   if optimize then
-    img := CreateLazIntfImage(rawImage, r.BottomRight - r.TopLeft)
+  begin
-  else begin
+    if BufferImageValid then
+    begin
+      ADrawer.PutImage(r.Left, r.Top, FBufferImage);
+      exit;
+    end else
+    begin
+      FBufferImage.Free;
+      FBufferImage := CreateLazIntfImage(rawImage, r.BottomRight - r.TopLeft)
+    end;
+  end else
+  begin
     ADrawer.Brush := Brush;
     ADrawer.SetPenParams(psClear, clTAColor);
   end;
@@ -2544,50 +2572,45 @@ begin
     exit;
   end;
 
-  try
+  pt.Y := (r.Top div scaled_stepY - 1) * scaled_stepY + offset.Y mod scaled_stepY;
-    pt.Y := (r.Top div scaled_stepY - 1) * scaled_stepY + offset.Y mod scaled_stepY;
+  while pt.Y <= r.Bottom do begin
-    while pt.Y <= r.Bottom do begin
+    next.Y := pt.Y + scaled_stepY;
-      next.Y := pt.Y + scaled_stepY;
+    if next.Y <= r.Top then begin
-      if next.Y <= r.Top then begin
+      pt.Y := next.Y;
-        pt.Y := next.Y;
+      continue;
+    end;
+    pt.X := (r.Left div scaled_stepX - 1) * scaled_stepX + offset.X mod scaled_stepX;
+    while pt.X <= r.Right do begin
+      next.X := pt.X + scaled_stepX;
+      if next.X <= r.Left then begin
+        pt.X := next.X;
         continue;
       end;
-      pt.X := (r.Left div scaled_stepX - 1) * scaled_stepX + offset.X mod scaled_stepX;
+      gp := GraphToAxis(ParentChart.ImageToGraph((pt + next) div 2));
-      while pt.X <= r.Right do begin
+      v := FunctionValue(gp.X, gp.Y);
-        next.X := pt.X + scaled_stepX;
+      cell := Rect(
-        if next.X <= r.Left then begin
+        Max(pt.X, r.Left), Max(pt.Y, r.Top),
-          pt.X := next.X;
+        Min(next.X, r.Right) + 1, Min(next.Y, r.Bottom) + 1);
-          continue;
+      if optimize then begin
-        end;
+        if ColorSource = nil then
-        gp := GraphToAxis(ParentChart.ImageToGraph((pt + next) div 2));
+          cellColor := Brush.Color
-//        if not (csDesigning in ComponentState) then
+        else
-          v := FunctionValue(gp.X, gp.Y);
+          cellColor := FColorMap.ColorByValue(v);
-        cell := Rect(
+        for y := cell.Top - r.Top to cell.Bottom - r.Top - 2 do
-          Max(pt.X, r.Left), Max(pt.Y, r.Top),
+          for x := cell.Left - r.Left to cell.Right - r.Left - 2 do
-          Min(next.X, r.Right) + 1, Min(next.Y, r.Bottom) + 1);
+            FBufferImage.TColors[x, y] := cellColor;
-        if optimize then begin
+      end
-          if ColorSource = nil then
+      else begin
-            cellColor := Brush.Color
+        if ColorSource <> nil then
-          else
+          ADrawer.BrushColor := FColorMap.ColorByValue(v);
-            cellColor := FColorMap.ColorByValue(v);
+        ADrawer.Rectangle(cell);
-          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
-              img.TColors[x, y] := cellColor;
-        end
-        else begin
-          if ColorSource <> nil then
-            ADrawer.BrushColor := FColorMap.ColorByValue(v);
-          ADrawer.Rectangle(cell);
-        end;
-        pt.X := next.X;
       end;
-      pt.Y := next.Y;
+      pt.X := next.X;
     end;
-    if optimize then
+    pt.Y := next.Y;
-      ADrawer.PutImage(r.Left, r.Top, img);
-  finally
-    FreeAndNil(img);
   end;
+  if optimize and BufferImageValid then
+    ADrawer.PutImage(r.Left, r.Top, FBufferImage);
 end;
 
 function TCustomColorMapSeries.FunctionValue(AX, AY: Double): Double;
@@ -2742,6 +2765,14 @@ begin
   end;
 end;
 
+{ Destroys the current buffer image because some parameter affecting it has
+  changed. The buffer image will be recreated when the series is painted the
+  next time. }
+procedure TCustomColorMapSeries.InvalidateBufferImage;
+begin
+  FreeAndNil(FBufferImage);
+end;
+
 function TCustomColorMapSeries.IsEmpty: Boolean;
 begin
   Result := true;
@@ -2766,33 +2797,40 @@ procedure TCustomColorMapSeries.SetBrush(AValue: TBrush);
 begin
   if FBrush = AValue then exit;
   FBrush := AValue;
+  InvalidateBufferImage;
   UpdateParentChart;
 end;
 
 procedure TCustomColorMapSeries.SetBuiltinPalette(AValue: TColorMapPalette);
 begin
+  InvalidateBufferImage;
   FColorMap.BuiltinPalette := AValue;
+  UpdateParentChart;
 end;
 
 procedure TCustomColorMapSeries.SetColorSource(AValue: TCustomChartSource);
 begin
+  InvalidateBufferImage;
   FColorMap.ColorSource := AValue;
 end;
 
 procedure TCustomColorMapSeries.SetInterpolate(AValue: Boolean);
 begin
   if GetInterpolate = AValue then exit;
+  InvalidateBufferImage;
   FColorMap.Interpolate := AValue;
   UpdateParentChart;
 end;
 
 procedure TCustomColorMapSeries.SetPaletteMax(AValue: Double);
 begin
+  InvalidateBufferImage;
   FColorMap.PaletteMax := AValue;
 end;
 
 procedure TCustomColorMapSeries.SetPaletteMin(AValue: Double);
 begin
+  InvalidateBufferImage;
   FColorMap.PaletteMin := AValue;
 end;
 
@@ -2800,6 +2838,7 @@ procedure TCustomColorMapSeries.SetStepX(AValue: TFuncSeriesStep);
 begin
   if FStepX = AValue then exit;
   FStepX := AValue;
+  InvalidateBufferImage;
   UpdateParentChart;
 end;
 
@@ -2807,6 +2846,7 @@ procedure TCustomColorMapSeries.SetStepY(AValue: TFuncSeriesStep);
 begin
   if FStepY = AValue then exit;
   FStepY := AValue;
+  InvalidateBufferImage;
   UpdateParentChart;
 end;
 
@@ -2814,6 +2854,7 @@ procedure TCustomColorMapSeries.SetUseImage(AValue: TUseImage);
 begin
   if FUseImage = AValue then exit;
   FUseImage := AValue;
+  InvalidateBufferImage;
   UpdateParentChart;
 end;
 
@@ -2846,6 +2887,7 @@ procedure TColorMapSeries.SetOnCalculate(AValue: TFuncCalculate3DEvent);
 begin
   if TMethod(FOnCalculate) = TMethod(AValue) then exit;
   FOnCalculate := AValue;
+  InvalidateBufferImage;
   UpdateParentChart;
 end;
 

components/tachart/tagraph.pas

@@ -75,6 +75,7 @@ type
     destructor Destroy; override;
 
   public
+    procedure ClipRectChanged; virtual; virtual;
     procedure Draw(ADrawer: IChartDrawer); virtual; abstract;
     function GetAxisBounds(AAxis: TChartAxis; out AMin, AMax: Double): boolean; virtual; abstract;
     function GetGraphBounds: TDoubleRect; virtual; abstract;
@@ -835,6 +836,8 @@ procedure TChart.DisplaySeries(ADrawer: IChartDrawer);
   begin
     try
       ADrawer.SetTransparency(ATransparency);
+      if FClipRect <> FOldClipRect then
+        ASeries.ClipRectChanged;
       ASeries.Draw(ADrawer);
     except
       ASeries.Active := false;
@@ -2052,6 +2055,11 @@ begin
   // empty
 end;
 
+procedure TBasicChartSeries.ClipRectChanged;
+begin
+  // empty
+end;
+
 destructor TBasicChartSeries.Destroy;
 begin
   if FChart <> nil then