paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-12 10:19:15 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Use in-memory image to draw TColorMapSeries with StepX = StepY = 1

Browse Source 
git-svn-id: trunk@40059 -
This commit is contained in:
ask 2013-01-30 14:24:44 +00:00
parent 77e515b5c3
commit 1158e7e27a
1 changed files with 48 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
components/tachart/tafuncseries.pas
View File

@ -303,7 +303,8 @@ type
implementation implementation
uses uses
ipf, Math, StrUtils, SysUtils, TAGeometry, TAGraph, TAMath; ipf, GraphType, IntfGraphics, Math, StrUtils, SysUtils,
TAGeometry, TAGraph, TAMath;
type type
TFitSeriesRange = class(TChartRange) TFitSeriesRange = class(TChartRange)
@ -1249,6 +1250,9 @@ var
pt, next, offset: TPoint; pt, next, offset: TPoint;
gp: TDoublePoint; gp: TDoublePoint;
v: Double; v: Double;
img: TLazIntfImage;
rawImage: TRawImage;
optimize: Boolean;
begin begin
if not (csDesigning in ComponentState) and IsEmpty then exit; if not (csDesigning in ComponentState) and IsEmpty then exit;
@ -1267,30 +1271,52 @@ begin
ADrawer.Brush := Brush; ADrawer.Brush := Brush;
ADrawer.SetPenParams(psClear, clTAColor); ADrawer.SetPenParams(psClear, clTAColor);
pt.Y := (r.Top div StepY - 1) * StepY + offset.Y mod StepY; pt.Y := (r.Top div StepY - 1) * StepY + offset.Y mod StepY;
while pt.Y <= r.Bottom do begin
next.Y := pt.Y + StepY; optimize := (StepX = 1) and (StepY = 1);
if next.Y <= r.Top then begin if optimize then begin
pt.Y := next.Y; rawImage.Init;
continue; rawImage.Description.Init_BPP32_B8G8R8A8_BIO_TTB(
end; r.Right - r.Left, r.Bottom - r.Top);
pt.X := (r.Left div StepX - 1) * StepX + offset.X mod StepX; rawImage.CreateData(true);
while pt.X <= r.Right do begin img := TLazIntfImage.Create(0, 0);
next.X := pt.X + StepX; img.SetRawImage(rawImage);
if next.X <= r.Left then begin end;
pt.X := next.X; try
while pt.Y <= r.Bottom do begin
next.Y := pt.Y + StepY;
if next.Y <= r.Top then begin
pt.Y := next.Y;
continue; continue;
end; end;
gp := GraphToAxis(ParentChart.ImageToGraph((pt + next) div 2)); pt.X := (r.Left div StepX - 1) * StepX + offset.X mod StepX;
if not (csDesigning in ComponentState) then while pt.X <= r.Right do begin
OnCalculate(gp.X, gp.Y, v); next.X := pt.X + StepX;
if ColorSource <> nil then if next.X <= r.Left then begin
ADrawer.BrushColor := ColorByValue(v); pt.X := next.X;
ADrawer.Rectangle( continue;
Max(pt.X, r.Left), Max(pt.Y, r.Top), end;
Min(next.X, r.Right) + 1, Min(next.Y, r.Bottom) + 1); gp := GraphToAxis(ParentChart.ImageToGraph((pt + next) div 2));
pt.X := next.X; if not (csDesigning in ComponentState) then
OnCalculate(gp.X, gp.Y, v);
if ColorSource <> nil then
ADrawer.BrushColor := ColorByValue(v);
if optimize then begin
if PtInRect(r, pt) then
img.TColors[pt.X - r.Left, pt.Y - r.Top] := ADrawer.GetBrushColor;
end
else
ADrawer.Rectangle(
Max(pt.X, r.Left), Max(pt.Y, r.Top),
Min(next.X, r.Right) + 1, Min(next.Y, r.Bottom) + 1);
pt.X := next.X;
end;
pt.Y := next.Y;
end;
finally
if optimize then begin
ADrawer.PutImage(r.Left, r.Top, img);
img.Free;
end; end;
pt.Y := next.Y;
end; end;
end; end;