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

MG: added patch from Andrew

Browse Source 
git-svn-id: trunk@1159 -
This commit is contained in:
lazarus 2002-02-09 01:48:00 +00:00
parent 651ca005e0
commit 9fe5a56c15
1 changed files with 84 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
lcl/include/interfacebase.inc
View File

@ -1082,6 +1082,87 @@ begin
Result := False;
end;
function TInterfaceBase.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;
begin
Result := False;
If X2 < X1 then
Switch(X2,X1);
If Y2 < Y1 then
Switch(Y2,Y1);
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));
Pie(DC, X1, Y1, RX, RY, 90*16,90*16);
Pie(DC, X2 - RX, Y1, RX, RY, 0, 90*16);
Pie(DC, X1, Y2 - RY, RX, RY, 180*16,90*16);
Pie(DC, X2 - RX, Y2 - RY, RX, RY, 270*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, RX, RY, 90*16,90*16);
Arc(DC, X2 - RX, Y1, RX, RY, 0, 90*16);
Arc(DC, X1, Y2 - RY, RX, RY, 180*16,90*16);
Arc(DC, X2 - RX, Y2 - RY, RX, RY, 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);
end
else
Rectangle(DC, X1, Y1, X2, Y2);
Result := True;
end;
function TInterfaceBase.SaveDC(DC: HDC) : Integer;
begin
Result := 0;
@ -1264,6 +1345,9 @@ end;
{ =============================================================================
$Log$
Revision 1.48 2002/09/18 17:07:24 lazarus
MG: added patch from Andrew
Revision 1.47 2002/09/12 05:56:15 lazarus
MG: gradient fill, minor issues from Andrew