paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-11 10:09:44 +01:00
Code Issues Packages Projects Releases Wiki Activity

LCL: Implemented TCanvas.Frame3D with Delphi compatible parameter signature + a wrapper func. Patch by Stephano, issue #8328

Browse Source 
git-svn-id: trunk@30305 -
This commit is contained in:
juha 2011-04-16 09:55:42 +00:00
parent 09bbd30552
commit 6e67aa98e8
3 changed files with 51 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
lcl/extctrls.pp
View File

@ -1311,6 +1311,9 @@ const
TCN_SELCHANGE = TCN_FIRST - 1; TCN_SELCHANGE = TCN_FIRST - 1;
TCN_SELCHANGING = TCN_FIRST - 2; TCN_SELCHANGING = TCN_FIRST - 2;
procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
TopColor, BottomColor: TColor; const FrameWidth: integer);
procedure Register; procedure Register;
implementation implementation
@ -1321,6 +1324,13 @@ uses
{.$define INSTALL_TUNTABBEDNOTEBOOK} {.$define INSTALL_TUNTABBEDNOTEBOOK}
// Wrapper function for TCanvas.Frame3D.
procedure Frame3D(ACanvas: TCanvas; var ARect: TRect;
TopColor, BottomColor: TColor; const FrameWidth: integer);
begin
ACanvas.Frame3D(ARect, TopColor, BottomColor, FrameWidth);
end;
procedure Register; procedure Register;
begin begin
RegisterComponents('Standard',[TRadioGroup,TCheckGroup,TPanel]); RegisterComponents('Standard',[TRadioGroup,TCheckGroup,TPanel]);

2
lcl/graphics.pp
View File

@ -1104,6 +1104,8 @@ type
FillStyle: TFillStyle); virtual; FillStyle: TFillStyle); virtual;
procedure Frame3d(var ARect: TRect; const FrameWidth: integer; procedure Frame3d(var ARect: TRect; const FrameWidth: integer;
const Style: TGraphicsBevelCut); virtual; const Style: TGraphicsBevelCut); virtual;
procedure Frame3D(var ARect: TRect; TopColor, BottomColor: TColor;
const FrameWidth: integer); overload;
procedure Frame(const ARect: TRect); virtual; // border using pen procedure Frame(const ARect: TRect); virtual; // border using pen
procedure Frame(X1,Y1,X2,Y2: Integer); // border using pen procedure Frame(X1,Y1,X2,Y2: Integer); // border using pen
procedure FrameRect(const ARect: TRect); virtual; // border using brush procedure FrameRect(const ARect: TRect); virtual; // border using brush

39
lcl/include/canvas.inc
View File

@ -970,6 +970,45 @@ begin
Changed; Changed;
end; end;
{------------------------------------------------------------------------------
Method: TCanvas.Frame3D
Params: Rect
Returns: the inflated rectangle (the inner rectangle without the frame)
------------------------------------------------------------------------------}
procedure TCanvas.Frame3D(var ARect: TRect; TopColor, BottomColor: TColor;
const FrameWidth: integer);
var
Delta, W, ii : Integer;
begin
if ARect.Bottom-ARect.Top > ARect.Right-ARect.Left
then
W := ARect.Right-ARect.Left+1
else
W := ARect.Bottom-ARect.Top+1;
if FrameWidth > W then
W := W-1
else
W := FrameWidth;
for ii := 1 to W do
begin
Pen.Color := TopColor;
MoveTo(ARect.Left, ARect.Bottom-1);
LineTo(ARect.Left, ARect.Top);
LineTo(ARect.Right-1, ARect.Top);
Pen.Color := BottomColor;
LineTo(ARect.Right-1, ARect.Bottom-1);
LineTo(ARect.Left, ARect.Bottom-1);
Inc(ARect.Left);
Inc(ARect.Top);
Dec(ARect.Right);
Dec(ARect.Bottom);
end;
end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
procedure TCanvas.Frame(const ARect: TRect); procedure TCanvas.Frame(const ARect: TRect);