Hi,
Attached is a patch for the types.pp unit. I also include some Unit
Tests for InflateRect() function in a separate file (uses fpcUnit) by
wasn't sure how or where to incorporate them. The patch needs to be
applied in the root FPC source directory.
Changes:
* Added a new InflateRect() function, which does the same as the
Windows API call, but is cross-platform.
* Added two Size() functions with different parameters that return a
TSize record. It works the same as the Point() function that returns a
TPoint record.
Regards,
Graeme.
--
There's no place like 127.0.0.1
Index: rtl/objpas/types.pp
===================================================================
--- rtl/objpas/types.pp (revision 4294)
+++ rtl/objpas/types.pp (working copy)
@@ -263,7 +263,11 @@
function IsRectEmpty(const Rect : TRect) : Boolean;
function OffsetRect(var Rect : TRect;DX : Integer;DY : Integer) : Boolean;
function CenterPoint(const Rect: TRect): TPoint;
+function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+function Size(AWidth, AHeight: Integer): TSize;
+function Size(ARect: TRect): TSize;
+
implementation
@@ -391,5 +395,36 @@
end;
+function InflateRect(var Rect: TRect; dx: Integer; dy: Integer): Boolean;
+begin
+ if Assigned(@Rect) then
+ begin
+ with Rect do
+ begin
+ dec(Left, dx);
+ dec(Top, dy);
+ inc(Right, dx);
+ inc(Bottom, dy);
+ end;
+ Result := True;
+ end
+ else
+ Result := False;
+end;
+
+function Size(AWidth, AHeight: Integer): TSize;
+begin
+ Result.cx := AWidth;
+ Result.cy := AHeight;
+end;
+
+
+function Size(ARect: TRect): TSize;
+begin
+ Result.cx := ARect.Right - ARect.Left;
+ Result.cy := ARect.Bottom - ARect.Top;
+end;
+
+
end.
unit InfateRectTest;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, fpcunit, testregistry;
type
TTestInflateRect= class(TTestCase)
private
FRect: TRect;
protected
procedure SetUp; override;
published
procedure InflateOne;
procedure InflateTwo;
procedure InflateNegativeOne;
procedure InflateNegativeTwo;
procedure InflateMixed1;
procedure InflateMixed2;
procedure InflateLarge;
procedure TestResult;
end;
implementation
uses
Types;
procedure TTestInflateRect.SetUp;
begin
FRect.TopLeft := Point(10, 10);
FRect.BottomRight := Point(50, 50);
end;
procedure TTestInflateRect.InflateOne;
begin
InflateRect(FRect, 1, 1);
AssertEquals('Failed on 1', 9, FRect.Left); {x1}
AssertEquals('Failed on 2', 9, FRect.Top); {y1}
AssertEquals('Failed on 3', 51, FRect.Right); {x2}
AssertEquals('Failed on 4', 51, FRect.Bottom); {y2}
end;
procedure TTestInflateRect.InflateTwo;
begin
InflateRect(FRect, 2, 2);
AssertEquals('Failed on 1', 8, FRect.Left); {x1}
AssertEquals('Failed on 2', 8, FRect.Top); {y1}
AssertEquals('Failed on 3', 52, FRect.Right); {x2}
AssertEquals('Failed on 4', 52, FRect.Bottom); {y2}
Setup; { Reset Rectangle }
InflateRect(FRect, 1, 2);
AssertEquals('Failed on 1', 9, FRect.Left); {x1}
AssertEquals('Failed on 2', 8, FRect.Top); {y1}
AssertEquals('Failed on 3', 51, FRect.Right); {x2}
AssertEquals('Failed on 4', 52, FRect.Bottom); {y2}
end;
procedure TTestInflateRect.InflateNegativeOne;
begin
InflateRect(FRect, -1, -1);
AssertEquals('Failed on 1', 11, FRect.Left); {x1}
AssertEquals('Failed on 2', 11, FRect.Top); {y1}
AssertEquals('Failed on 3', 49, FRect.Right); {x2}
AssertEquals('Failed on 4', 49, FRect.Bottom); {y2}
end;
procedure TTestInflateRect.InflateNegativeTwo;
begin
InflateRect(FRect, -2, -2);
AssertEquals('Failed on 1', 12, FRect.Left); {x1}
AssertEquals('Failed on 2', 12, FRect.Top); {y1}
AssertEquals('Failed on 3', 48, FRect.Right); {x2}
AssertEquals('Failed on 4', 48, FRect.Bottom); {y2}
Setup; { Reset Rectangle }
InflateRect(FRect, -1, -2);
AssertEquals('Failed on 1', 11, FRect.Left); {x1}
AssertEquals('Failed on 2', 12, FRect.Top); {y1}
AssertEquals('Failed on 3', 49, FRect.Right); {x2}
AssertEquals('Failed on 4', 48, FRect.Bottom); {y2}
end;
procedure TTestInflateRect.InflateMixed1;
begin
InflateRect(FRect, 0, -2);
AssertEquals('Failed on 1', 10, FRect.Left); {x1}
AssertEquals('Failed on 2', 12, FRect.Top); {y1}
AssertEquals('Failed on 3', 50, FRect.Right); {x2}
AssertEquals('Failed on 4', 48, FRect.Bottom); {y2}
end;
procedure TTestInflateRect.InflateMixed2;
begin
InflateRect(FRect, -2, 0);
AssertEquals('Failed on 1', 12, FRect.Left); {x1}
AssertEquals('Failed on 2', 10, FRect.Top); {y1}
AssertEquals('Failed on 3', 48, FRect.Right); {x2}
AssertEquals('Failed on 4', 50, FRect.Bottom); {y2}
end;
procedure TTestInflateRect.InflateLarge;
begin
InflateRect(FRect, 20, 0);
AssertEquals('Failed on 1', -10, FRect.Left); {x1}
AssertEquals('Failed on 2', 10, FRect.Top); {y1}
AssertEquals('Failed on 3', 70, FRect.Right); {x2}
AssertEquals('Failed on 4', 50, FRect.Bottom); {y2}
end;
procedure TTestInflateRect.TestResult;
begin
AssertTrue('Failed on 1', True = InflateRect(FRect, 1, 1));
{ Not sure how to get a False result? }
end;
initialization
RegisterTest(TTestInflateRect);
end.
_______________________________________________
fpc-devel maillist - [email protected]
http://lists.freepascal.org/mailman/listinfo/fpc-devel
