paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-02 06:23:41 +02:00
Code Issues Packages Projects Releases Wiki Activity

TAChart: Add InterpolateRGB utility function

Browse Source 
git-svn-id: trunk@27736 -
This commit is contained in:
ask 2010-10-17 09:05:09 +00:00
parent 198c23805f
commit 18dbaee9bd
2 changed files with 42 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
components/tachart/tachartutils.pas
View File

@ -219,6 +219,8 @@ procedure ExpandRect(var ARect: TDoubleRect; const APoint: TDoublePoint); inline
function GetIntervals(AMin, AMax: Double; AInverted: Boolean): TDoubleDynArray;
function InterpolateRGB(AColor1, AColor2: Integer; ACoeff: Double): Integer;
function IsPointOnLine(const AP, A1, A2: TPoint): Boolean; inline;
function IsPointInPolygon(
const AP: TPoint; const APolygon: array of TPoint): Boolean;
@ -478,6 +480,20 @@ begin
end;
end;
function InterpolateRGB(AColor1, AColor2: Integer; ACoeff: Double): Integer;
type
TBytes = packed array [1..4] of Byte;
var
c1: TBytes absolute AColor1;
c2: TBytes absolute AColor2;
r: TBytes absolute Result;
i: Integer;
begin
ACoeff := EnsureRange(ACoeff, 0.0, 1.0);
for i := 1 to 4 do
r[i] := Round(c1[i] + (c2[i] - c1[i]) * ACoeff);
end;
function IsPointOnLine(const AP, A1, A2: TPoint): Boolean;
begin
Result := IsPointInRect(AP, A1, A2) and (PointLineSide(AP, A1, A2) = 0);

27
components/tachart/test/UtilsTest.pas
View File

@ -55,6 +55,14 @@ type
procedure TestPolygonIntersectsPolygon;
end;
{ TColorTest }
TColorTest = class(TTestCase)
private
procedure AssertEqualsHex(Expected, Actual: Integer); overload;
published
procedure TestInterpolate;
end;
implementation
@ -256,9 +264,26 @@ begin
AssertFalse(IsPolygonIntersectsPolygon(p1, OffsetPolygon(p1, Point(0, -6))));
end;
{ TColorTest }
procedure TColorTest.AssertEqualsHex(Expected, Actual: Integer);
begin
AssertTrue(
ComparisonMsg(IntToHex(Expected, 8), IntToHex(Actual, 8)),
Expected = Actual);
end;
procedure TColorTest.TestInterpolate;
begin
AssertEqualsHex($01020304, InterpolateRGB($01020304, $00787980, 0.0));
AssertEqualsHex($00787980, InterpolateRGB($01020304, $00787980, 1.0));
AssertEqualsHex($003D3E42, InterpolateRGB($01020304, $00787980, 0.5));
AssertEqualsHex($01010102, InterpolateRGB($01010100, $02020214, 0.1));
end;
initialization
RegisterTests([TIntervalListTest, TGeometryTest]);
RegisterTests([TIntervalListTest, TGeometryTest, TColorTest]);
end.