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

LCL-GTK3: Implement Canvas.Pixels[]. Issue #36472, patch from CudaText man.

Browse Source 
git-svn-id: trunk@62472 -
This commit is contained in:
juha 2019-12-30 15:36:49 +00:00
parent 2bc8095d8d
commit 593915c4b3
2 changed files with 9 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lcl/interfaces/gtk3/gtk3object.inc
View File

@ -609,22 +609,10 @@ begin
end; end;
end; end;
procedure TGtk3WidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: integer; procedure TGtk3WidgetSet.DCSetPixel(CanvasHandle: HDC; X, Y: Integer; AColor: TGraphicsColor);
AColor: TGraphicsColor);
var
ASavedPenColor: TColor;
cr: PCairo_t;
begin begin
if IsValidDC(CanvasHandle) then if IsValidDC(CanvasHandle) then
begin TGtk3DeviceContext(CanvasHandle).drawPixel(X, Y, AColor);
cr := TGtk3DeviceContext(CanvasHandle).Widget;
ASavedPenColor := TGtk3DeviceContext(CanvasHandle).CurrentPen.Color;
TGtk3DeviceContext(CanvasHandle).CurrentPen.Color := AColor;
cairo_move_to(cr, X, Y);
cairo_line_to(cr, X, Y);
cairo_stroke(cr);
TGtk3DeviceContext(CanvasHandle).CurrentPen.Color := ASavedPenColor;
end;
end; end;
procedure TGtk3WidgetSet.DCRedraw(CanvasHandle: HDC); procedure TGtk3WidgetSet.DCRedraw(CanvasHandle: HDC);

12
lcl/interfaces/gtk3/gtk3objects.pas
View File

@ -212,7 +212,7 @@ type
procedure CreateObjects; procedure CreateObjects;
procedure DeleteObjects; procedure DeleteObjects;
public public
procedure drawPoint(x1: Integer; y1: Integer); procedure drawPixel(x, y: Integer; AColor: TColor);
procedure drawRect(x1, y1, w, h: Integer; const AFill, ABorder: Boolean); procedure drawRect(x1, y1, w, h: Integer; const AFill, ABorder: Boolean);
procedure drawRoundRect(x, y, w, h, rx, ry: Integer); procedure drawRoundRect(x, y, w, h, rx, ry: Integer);
procedure drawText(x: Integer; y: Integer; const s: String); overload; procedure drawText(x: Integer; y: Integer; const s: String); overload;
@ -1211,11 +1211,13 @@ begin
FreeAndNil(FvImage); FreeAndNil(FvImage);
end; end;
procedure TGtk3DeviceContext.drawPoint(x1: Integer; y1: Integer); procedure TGtk3DeviceContext.drawPixel(x, y: Integer; AColor: TColor);
// Seems that painting line from (a-1, b-1) to (a,b) gives one pixel
begin begin
applyPen; SetSourceColor(AColor);
cairo_move_to(Widget , x1, y1); cairo_set_line_width(Widget, 1);
cairo_line_to(Widget, x1, y1); cairo_move_to(Widget, x - PixelOffset, y - PixelOffset);
cairo_line_to(Widget, x + PixelOffset, y + PixelOffset);
cairo_stroke(Widget); cairo_stroke(Widget);
end; end;