paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-14 15:19:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

Fixes LCLIntf.FrameRect under Carbon

Browse Source 
git-svn-id: trunk@19534 -
This commit is contained in:
sekelsenmat 2009-04-20 23:04:30 +00:00
parent de190884ee
commit b8cf817014
1 changed files with 28 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
lcl/interfaces/carbon/carbonwinapi.inc
View File

@ -1051,11 +1051,14 @@ end;
hBr - Border brush (ignored)
Returns: > 0 if the function succeeds
Draws a border with the specified brush in Carbon native style
TODO: use brush
Draws a border with the specified brush color in Carbon native style
The width of the border of this rectangle is always 1
------------------------------------------------------------------------------}
function TCarbonWidgetSet.FrameRect(DC: HDC; const ARect: TRect;
hBr: HBRUSH): Integer;
var
NewPen, OldPen: TCarbonPen;
CarbonDC: TCarbonDeviceContext absolute DC;
begin
Result := 0;
@ -1066,7 +1069,29 @@ begin
if not CheckDC(DC, 'FrameRect') then Exit;
Result := Integer(Rectangle(DC, ARect.Left, ARect.Top, ARect.Right, ARect.Bottom));
// Create a new Pen with default values and the color of the brush
NewPen := TCarbonPen.Create(False);
try
NewPen.SetColor(CarbonDC.CurrentBrush.ColorRef, True);
OldPen := CarbonDC.CurrentPen;
CarbonDC.CurrentPen := NewPen;
MoveToEx(DC, ARect.Left, ARect.Top, nil);
LineTo(DC, ARect.Right - 1, ARect.Top);
MoveToEx(DC, ARect.Left, ARect.Bottom - 1, nil);
LineTo(Dc, ARect.Right - 1, ARect.Bottom - 1);
MoveToEx(DC, ARect.Right - 1, ARect.Top, nil);
LineTo(DC, ARect.Right - 1, ARect.Bottom - 1);
MoveToEx(DC, ARect.Left, ARect.Top, nil);
LineTo(DC, ARect.Left, ARect.Bottom - 1);
Result := -1;
CarbonDC.CurrentPen := OldPen;
finally
NewPen.Free;
end;
end;
{------------------------------------------------------------------------------