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

LCL carbon: DrawGrid implementation

Browse Source 
git-svn-id: trunk@14014 -
This commit is contained in:
tombo 2008-02-07 10:57:02 +00:00
parent 1e6ae967a2
commit 5bdc5f770f
3 changed files with 56 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
lcl/interfaces/carbon/carboncanvas.pp
View File

@ -110,6 +110,7 @@ type
function DrawCGImage(X, Y, Width, Height: Integer; CGImage: CGImageRef): Boolean;
public
procedure DrawFocusRect(const ARect: TRect);
procedure DrawGrid(const ARect: TRect; DX, DY: Integer);
procedure Ellipse(X1, Y1, X2, Y2: Integer);
procedure ExcludeClipRect(Left, Top, Right, Bottom: Integer);
@ -696,6 +697,41 @@ begin
Self, 'DrawFocusRect', 'HIThemeDrawFocusRect');
end;
{------------------------------------------------------------------------------
Method: TCarbonDeviceContext.DrawGrid
Params: Arect - Grid rectangle
DX, DY - Grid cell width and height
Draws the point grid
------------------------------------------------------------------------------}
procedure TCarbonDeviceContext.DrawGrid(const ARect: TRect; DX, DY: Integer);
var
Y: Integer;
GridLine: Array [0..1] of Single;
begin
CGContextSaveGState(CGContext);
try
CGContextSetShouldAntialias(CGContext, 0);
GridLine[0] := 1;
GridLine[1] := DX - 1;
CGContextSetLineDash(CGContext, 0, @GridLine[0], Length(GridLine));
CGContextBeginPath(CGContext);
// draw horzontal dotted lines
for Y := 0 to (ARect.Bottom - ARect.Top - 1) div DY do
begin
CGContextMoveToPoint(CGContext, ARect.Left, ARect.Top + Y * DY + 1);
CGContextAddLineToPoint(CGContext, ARect.Right, ARect.Top + Y * DY + 1);
end;
CGContextStrokePath(CGContext);
finally
CGContextRestoreGState(CGContext);
end;
end;
{------------------------------------------------------------------------------
Method: TCarbonDeviceContext.Ellipse
Params:

19
lcl/interfaces/carbon/carbonlclintf.inc
View File

@ -115,6 +115,25 @@ begin
ArrowCanvas.Polygon(P);
end;
{------------------------------------------------------------------------------
Method: DrawGrid
Params: DC - Handle to device context
R - Grid rectangle
DX, DY - Grid cell width and height
Draws the point grid
------------------------------------------------------------------------------}
procedure TCarbonWidgetSet.DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer);
begin
{$IFDEF VerboseLCLIntf}
DebugLn('TCarbonWidgetSet.DrawGrid Rect: ' + DbgS(R));
{$ENDIF}
if not CheckDC(DC, 'DrawGrid') then Exit;
TCarbonDeviceContext(DC).DrawGrid(R, DX, DY);
end;
function TCarbonWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint;
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
begin

1
lcl/interfaces/carbon/carbonlclintfh.inc
View File

@ -29,6 +29,7 @@
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
procedure DrawArrow(Arrow: TComponent; Canvas: TPersistent); override;
procedure DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer); override;
function ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect;
Str: PChar; Count: Longint; Dx: PInteger): Boolean; override;