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

gtk intf: fixed RoundRect with widht/height=0 from tombo

Browse Source 
git-svn-id: trunk@10029 -
This commit is contained in:
mattias 2006-10-03 20:10:44 +00:00
parent 58e54288e5
commit 58a6aead84
2 changed files with 57 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/graphmath.pp
View File

@ -385,7 +385,7 @@ begin
B := Extended(Height) / 2;
A := Extended(Width) / 2;
If A <> B then begin
If (A <> B) and (A <> 0) and (B <> 0) then begin
If A > B then begin
ScaleX := Extended(Width) / Height;
ScaleY := 1;
@ -770,8 +770,9 @@ begin
a := (Rect.Right - Rect.Left) div 2;
b := (Rect.Bottom - Rect.Top) div 2;
R := Sqr(a)*Sqr(b);
R := Sqrt(R / ((Sqr(b)*Sqr(Cos(DegToRad(EccentricAngle/16)))) +
(Sqr(a)*Sqr(Sin(DegToRad(EccentricAngle/16))))));
if R <> 0 then
R := Sqrt(R / ((Sqr(b)*Sqr(Cos(DegToRad(EccentricAngle/16)))) +
(Sqr(a)*Sqr(Sin(DegToRad(EccentricAngle/16))))));
Result := TruncToInt(R);
end;

117
lcl/include/intfbasewinapi.inc
View File

@ -1166,80 +1166,69 @@ begin
end;
function TWidgetSet.RoundRect(DC : hDC; X1, Y1, X2, Y2: Integer; RX,RY : Integer) : Boolean;
Procedure Switch(Var F,T : Integer);
var
Tmp : Integer;
begin
Tmp := F;
F := T;
T := Tmp
end;
var
pt : TPoint;
Pen : hPen;
Brush : hBrush;
T: Integer;
Points: PPoint;
Count: Integer;
procedure AddArcPoints(Left, Top, Right, Bottom, Angle1, Angle2: Integer);
var
P: PPoint;
C: Integer;
I: Integer;
begin
P := nil;
try
PolyBezierArcPoints(Left, Top, Right - Left, Bottom - Top, Angle1, Angle2,
0, P, C);
ReallocMem(Points, (Count + C) * SizeOf(TPoint));
for I := 0 to Pred(C) do
Points[Count + Pred(C) - I] := P[I];
Inc(Count, C);
finally
FreeMem(P);
end;
end;
begin
Result := False;
If X2 < X1 then
Switch(X2,X1);
if X2 < X1 then
begin
T := X1;
X1 := X2;
X2 := T;
end;
If Y2 < Y1 then
Switch(Y2,Y1);
if Y2 < Y1 then
begin
T := Y1;
Y1 := Y2;
Y2 := T;
end;
If ((X2 - X1) < 0) or ((Y2 - Y1) < 0) then
exit;
if (X2 - X1 < 0) or (Y2 - Y1 < 0) then Exit;
If not ((RX <= 0) or (RY <= 0)) then begin
If ((X2 - X1) <= RX) or ((X2 - X1) div 2 < RX) then
RX := (X2 - X1) div 2;
If ((Y2 - Y1) <= RY) or ((Y2 - Y1) div 2 < RY) then
RY := (Y2 - Y1) div 2;
Pen := SelectObject(DC, GetStockObject(NULL_PEN));
if not ((RX <= 0) or (RY <= 0)) then
begin
if X2 - X1 < RX then RX := X2 - X1;
if Y2 - Y1 < RY then RY := Y2 - Y1;
//debugln('TWidgetSet.RoundRect ',dbgs(Rect(X1,Y1,X2,Y2)),' ',dbgs(Point(RX,RY)));
RadialPieWithAngles(DC, X1, Y1, X1 + RX, Y1 + RY, 90*16,90*16);
RadialPieWithAngles(DC, X2 - RX, Y1, X2, Y1 + RY, 0, 90*16);
RadialPieWithAngles(DC, X1, Y2 - RY, X1 + RX, Y2, 180*16,90*16);
RadialPieWithAngles(DC, X2 - RX, Y2 - RY, X2, Y2, 270*16,90*16);
Points := nil;
Count := 0;
try
AddArcPoints(X1, Y1, X1 + RX, Y1 + RY, 90 * 16, 90 * 16);
AddArcPoints(X2 - RX, Y1, X2, Y1 + RY, 0 * 16, 90 * 16);
AddArcPoints(X2 - RX, Y2 - RY, X2, Y2, 270 * 16, 90 * 16);
AddArcPoints(X1, Y2 - RY, X1 + RX, Y2, 180 * 16, 90 * 16);
Rectangle(DC, X1 + (RX div 2) - 1, Y1, X2 - (RX div 2) + 1, Y2 + 1);
Rectangle(DC, X1, Y1 + (RY div 2) - 1, X2 + 1, Y2 - (RY div 2) + 1);
SelectObject(DC, Pen);
Brush := SelectObject(DC, GetStockObject(NULL_BRUSH));
Arc(DC, X1, Y1, X1 + RX, Y1 + RY, 90*16,90*16);
Arc(DC, X2 - RX, Y1, X2, Y1 + RY, 0, 90*16);
Arc(DC, X1, Y2 - RY, X1 + RX, Y2, 180*16,90*16);
Arc(DC, X2 - RX, Y2 - RY, X2, Y2, 270*16,90*16);
RY := RY div 2;
RX := RX div 2;
MoveToEx(DC, X1 + RX, Y1, @pt);
LineTo(DC, X2 - RX,Y1);
MoveToEx(DC, X1 + RX, Y1, nil);
LineTo(DC, X2 - RX, Y1);
MoveToEx(DC, X1, Y1 + RY - 1,nil);
LineTo(DC, X1, Y2 - RY);
MoveToEx(DC, X1 + RX, Y2, nil);
LineTo(DC, X2 - RX, Y2);
MoveToEx(DC, X2, Y1 + RY, nil);
LineTo(DC, X2, Y2 - RY);
MoveToEx(DC, pt.X, pt.Y, nil);
SelectObject(DC, Brush);
Polygon(DC, Points, Count, False);
finally
FreeMem(Points);
end;
end
else
Rectangle(DC, X1, Y1, X2, Y2);