File: gdkcairocanvas.pas

package info (click to toggle)
lazarus 2.0.0%2Bdfsg-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 214,460 kB
  • sloc: pascal: 1,862,622; xml: 265,709; cpp: 56,595; sh: 3,008; java: 609; makefile: 535; perl: 297; sql: 222; ansic: 137
file content (46 lines) | stat: -rw-r--r-- 889 bytes parent folder | download | duplicates (8)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
unit gdkcairocanvas;

{$mode objfpc}{$H+}

interface

uses
  gdk2, Gtk2Def, CairoGraphics, LCLType;

type
{ TGdkCairoCanvas }

  TGdkCairoCanvas = class(TCairoControlCanvas)
  protected
    procedure SetHandle(NewHandle: HDC); override;
    function CreateCairoHandle: HDC; override;
  end;

implementation

uses
  Classes;


{ TGdkCairoCanvas }

function TGdkCairoCanvas.CreateCairoHandle: HDC;
begin
  Result := 0; //Fake handle, right Handle is setted in SetHandle func
end;

procedure TGdkCairoCanvas.SetHandle(NewHandle: HDC);
begin
  if NewHandle <> 0 then begin
    NewHandle := {%H-}HDC(gdk_cairo_create(TGtkDeviceContext(NewHandle).Drawable));
    SetLazClipRect(Rect(Control.Left, Control.Top, Control.Left + Control.Width, Control.Top + Control.Height));
  end;
  inherited SetHandle(NewHandle);
end;

initialization
  CairoGraphicControlCanvasClass := TGdkCairoCanvas;

end.