paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-09 02:48:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* fixed CenterPoint() function (patch by Alexander S. Klenin, mantis #13972)

Browse Source 
git-svn-id: trunk@13274 -
This commit is contained in:
Jonas Maebe 2009-06-14 14:12:09 +00:00
parent 10e26f6bf8
commit 79e6ed5047
3 changed files with 48 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9157,6 +9157,7 @@ tests/webtbs/tw1376.pp svneol=native#text/plain
tests/webtbs/tw13763.pp svneol=native#text/plain
tests/webtbs/tw13813.pp svneol=native#text/plain
tests/webtbs/tw13820.pp svneol=native#text/plain
tests/webtbs/tw13872.pp svneol=native#text/plain
tests/webtbs/tw13890.pp svneol=native#text/plain
tests/webtbs/tw13948.pp svneol=native#text/plain
tests/webtbs/tw1398.pp svneol=native#text/plain

17
rtl/objpas/types.pp
View File

@ -406,13 +406,20 @@ begin
OffsetRect:=false;
end;
function CenterPoint(const Rect: TRect): TPoint;
function Avg(a, b: Longint): Longint;
begin
With Rect do
if a < b then
Result := a + ((b - a) shr 1)
else
Result := b + ((a - b) shr 1);
end;
function CenterPoint(const Rect: TRect): TPoint;
begin
with Rect do
begin
Result.X:=(Left+Right) div 2;
Result.Y:=(Top+Bottom) div 2;
Result.X := Avg(Left, Right);
Result.Y := Avg(Top, Bottom);
end;
end;

35
tests/webtbs/tw13872.pp Normal file
View File

@ -0,0 +1,35 @@
uses
types;
procedure TestAvg(const r: trect);
var
res: tpoint;
o1, o2: int64;
begin
res:=centerpoint(r);
o1 := (int64(r.left) + r.right) div 2;
o2 := (int64(r.top) + r.bottom) div 2;
if (res.x <> o1) or
(res.y <> o2) then
halt(1);
end;
var
r: trect;
begin
r.left := 1;
r.right := 3;
r.top := 3;
r.bottom := 1;
testavg(r);
r.left:=2000000000;
r.right:=2000000002;
r.top:=-2000000000;
r.bottom:=-2000000002;
testavg(r);
r.left:=-2000000000;
r.right:=2000000002;
r.top:=2000000000;
r.bottom:=-2000000002;
end.