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

LCL gtk: override DrawGrid (using Pixels for gtk1)

Browse Source 
git-svn-id: trunk@14015 -
This commit is contained in:
tombo 2008-02-07 13:27:12 +00:00
parent 5bdc5f770f
commit 1760486308
4 changed files with 64 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
lcl/interfaces/gtk/gtklclintf.inc
View File

@ -65,6 +65,40 @@ begin
end;
end;
procedure TGTKWidgetSet.DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer);
var
X, Y: Integer;
W, H: Integer;
SavedDC: Integer;
Context: TGtkDeviceContext absolute DC;
DCOrigin: TPoint;
begin
if (Context = nil) or (Context.Drawable = nil) then Exit;
DCOrigin := Context.Offset;
SavedDC := SaveDC(DC);
try
Context.SelectPenProps;
if not (dcfPenSelected in Context.Flags) then Exit;
if Context.IsNullPen then Exit;
W := (R.Right - R.Left - 1) div DX;
H := (R.Bottom - R.Top - 1) div DY;
for Y := 0 to H do
begin
for X := 0 to W do
begin
gdk_draw_point(Context.Drawable, Context.GC,
DCOrigin.X + R.Left + X * DX, DCOrigin.Y + R.Top + Y * DY);
end;
end;
finally
RestoreDC(DC, SavedDC);
end;
end;
{------------------------------------------------------------------------------
function TGtkWidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint;
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;

1
lcl/interfaces/gtk/gtklclintfh.inc
View File

@ -38,6 +38,7 @@ function AddProcessEventHandler(AHandle: THandle;
function CreateStandardCursor(ACursor: SmallInt): hCursor; override;
procedure DrawDefaultDockImage(AOldRect, ANewRect: TRect; AOperation: TDockImageOperation); 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;

28
lcl/interfaces/gtk2/gtk2lclintf.inc
View File

@ -30,6 +30,34 @@
//##apiwiz##sps## // Do not remove
procedure TGtk2WidgetSet.DrawGrid(DC: HDC; const R: TRect; DX, DY: Integer);
var
X, Y: Integer;
W, H: Integer;
SavedDC: Integer;
begin
SavedDC := SaveDC(DC);
try
W := (R.Right - R.Left - 1) div DX;
H := (R.Bottom - R.Top - 1) div DY;
// remove rows from clip rect
for Y := 0 to H do
begin
ExcludeClipRect(DC, R.Left, R.Top + Y * DY + 1, R.Right + 1, R.Top + (Y + 1) * DY);
end;
// draw vertical lines cross excluded rows -> only grid cross points painted
for X := 0 to W do
begin
if MoveToEx(DC, R.Left + X * DX, R.Top, nil) then
LineTo(DC, R.Left + X * DX, R.Bottom + 1);
end;
finally
RestoreDC(DC, SavedDC);
end;
end;
function TGtk2WidgetSet.ExtUTF8Out(DC: HDC; X, Y: Integer; Options: Longint;
Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): Boolean;
begin

1
lcl/interfaces/gtk2/gtk2lclintfh.inc
View File

@ -29,6 +29,7 @@
}
//##apiwiz##sps## // Do not remove
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;
function TextUTF8Out(DC: HDC; X, Y: Integer; Str: PChar; Count: Longint): Boolean; override;