Added cairocanvas package, long delayed patch from Petr Kristan

git-svn-id: trunk@40596 -

.gitattributes

@@ -563,6 +563,13 @@ components/anchordocking/restoredebugger/ADRestoreDebugger.lpr svneol=native#tex
 components/anchordocking/restoredebugger/adlayoutviewer.pas svneol=native#text/plain
 components/anchordocking/restoredebugger/mainunit.lfm svneol=native#text/plain
 components/anchordocking/restoredebugger/mainunit.pas svneol=native#text/plain
+components/cairocanvas/README.txt svneol=native#text/plain
+components/cairocanvas/cairocanvas.pas svneol=native#text/plain
+components/cairocanvas/cairocanvas_pkg.lpk svneol=native#text/plain
+components/cairocanvas/cairocanvas_pkg.pas svneol=native#text/plain
+components/cairocanvas/cairographics.pas svneol=native#text/plain
+components/cairocanvas/unix/gdkcairocanvas.pas svneol=native#text/plain
+components/cairocanvas/win/win32cairocanvas.pas svneol=native#text/plain
 components/chmhelp/README.txt svneol=native#text/plain
 components/chmhelp/democontrol/ContextHelpDemo.lpi svneol=native#text/plain
 components/chmhelp/democontrol/ContextHelpDemo.lpr svneol=native#text/plain

components/cairocanvas/README.txt

@@ -0,0 +1,19 @@
+Package for use libcairo in fpc.
+
+Author: Petr Kristan  (petr.kristan@epos.cz)
+
+Licence: LGPL 
+
+Base is TCairoPrinterCanvas class which implements TCanvas interface using 
+cairo calls.
+
+Their descendants TCairoPdfCanvas, TCairoPsCanvas, TCairoSvgCanvas, TCairoPngCanvas 
+renders to file.
+
+TCairoPaintBox can be used as TPaintBoxReplacement. 
+One of Win32CairoCanvas or GdkCairoCanvas must be in uses clausule
+
+To use TCairoPsCanvas as default Printer.Canvas set
+CupsCanvasClass := TCairoPsCanvas
+
+

components/cairocanvas/cairocanvas_pkg.lpk

@@ -0,0 +1,39 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <Package Version="4">
+    <Name Value="cairocanvas_pkg"/>
+    <CompilerOptions>
+      <Version Value="11"/>
+      <SearchPaths>
+        <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+      </SearchPaths>
+      <Other>
+        <CompilerMessages>
+          <MsgFileName Value=""/>
+        </CompilerMessages>
+        <CompilerPath Value="$(CompPath)"/>
+      </Other>
+    </CompilerOptions>
+    <Files Count="1">
+      <Item1>
+        <Filename Value="cairocanvas.pas"/>
+        <UnitName Value="CairoCanvas"/>
+      </Item1>
+    </Files>
+    <Type Value="RunTimeOnly"/>
+    <RequiredPkgs Count="2">
+      <Item1>
+        <PackageName Value="LCL"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="FCL"/>
+      </Item2>
+    </RequiredPkgs>
+    <UsageOptions>
+      <UnitPath Value="$(PkgOutDir)"/>
+    </UsageOptions>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+  </Package>
+</CONFIG>

components/cairocanvas/cairocanvas_pkg.pas

@@ -0,0 +1,14 @@
+{ This file was automatically created by Lazarus. Do not edit!
+  This source is only used to compile and install the package.
+ }
+
+unit cairocanvas_pkg;
+
+interface
+
+uses
+  CairoCanvas;
+
+implementation
+
+end.

components/cairocanvas/cairographics.pas

@@ -0,0 +1,269 @@
+unit CairoGraphics;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Types, CairoCanvas, Cairo, LCLType, LCLIntf, LMessages,
+  Classes, Controls, ExtCtrls, Graphics;
+
+type
+  { TCairoGraphicControl }
+
+  TCairoGraphicControl = class(TControl)
+  private
+    FCanvas: TCanvas;
+    FOnPaint: TNotifyEvent;
+    procedure WMPaint(var Message: TLMPaint); message LM_PAINT;
+  protected
+    //class procedure WSRegisterClass; override;
+    procedure FontChanged(Sender: TObject); override;
+    procedure Paint; virtual;
+    procedure DoOnChangeBounds; override;
+    procedure DoOnParentHandleDestruction; override;
+
+    property OnPaint: TNotifyEvent read FOnPaint write FOnPaint;
+    function GetDCHandle: HDC;
+    procedure ReleaseDCHandle(DC: HDC);
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    property Canvas: TCanvas read FCanvas;
+  end;
+
+  { TCairoPaintBox }
+
+  TCairoPaintBox = class(TCairoGraphicControl)
+  protected
+    //class procedure WSRegisterClass; override;
+    procedure Paint; override;
+    class function GetControlClassDefaultSize: TSize; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    property Canvas;
+  published
+    property Align;
+    property Anchors;
+    property BorderSpacing;
+    property Color;
+    property Constraints;
+    property DragCursor;
+    property DragMode;
+    property Enabled;
+    property Font;
+    property Hint;
+    property ParentColor;
+    property ParentFont;
+    property ParentShowHint;
+    property PopupMenu;
+    property ShowHint;
+    property Visible;
+    property OnChangeBounds;
+    property OnClick;
+    property OnDblClick;
+    property OnDragDrop;
+    property OnDragOver;
+    property OnEndDrag;
+    property OnMouseDown;
+    property OnMouseMove;
+    property OnMouseUp;
+    property OnMouseEnter;
+    property OnMouseLeave;
+    property OnMouseWheel;
+    property OnMouseWheelDown;
+    property OnMouseWheelUp;
+    property OnPaint;
+    property OnResize;
+    property OnStartDrag;
+  end;
+
+  { TCairoControlCanvas }
+
+  TCairoControlCanvas = class(TCairoPrinterCanvas)
+  private
+    procedure SetControl(const AValue: TCairoGraphicControl);
+  protected
+    sf: Pcairo_surface_t;
+    FControl: TCairoGraphicControl;
+    FDeviceContext: HDC;
+    procedure CreateCairoHandle(BaseHandle: HDC); override;
+    procedure DestroyCairoHandle; override;
+  public
+    procedure CreateHandle; override;
+    procedure FreeHandle; override;
+    property Control: TCairoGraphicControl read FControl write SetControl;
+    destructor Destroy; override;
+  end;
+
+  TCairoControlCanvasClass = class of TCairoControlCanvas;
+
+var
+  CairoGraphicControlCanvasClass: TCairoControlCanvasClass = nil;
+
+implementation
+
+uses
+    SysUtils;
+
+{ TCairoGraphicControl }
+
+procedure TCairoGraphicControl.WMPaint(var Message: TLMPaint);
+begin
+  if Message.DC <> 0 then
+  begin
+    Canvas.Lock;
+    try
+      Canvas.Handle := Message.DC;
+      try
+        Paint;
+      finally
+        Canvas.Handle := 0;
+      end;
+    finally
+      Canvas.Unlock;
+    end;
+  end;
+end;
+
+{class procedure TCairoGraphicControl.WSRegisterClass;
+begin
+  inherited WSRegisterClass;
+end;}
+
+procedure TCairoGraphicControl.FontChanged(Sender: TObject);
+begin
+  Canvas.Font:=Font;
+  inherited FontChanged(Sender);
+end;
+
+procedure TCairoGraphicControl.Paint;
+begin
+  if Assigned(FOnPaint) then FOnPaint(Self);
+end;
+
+procedure TCairoGraphicControl.DoOnChangeBounds;
+begin
+  inherited DoOnChangeBounds;
+  // reset canvas handle in next access
+  if Canvas.HandleAllocated then
+    TCairoControlCanvas(Canvas).FreeHandle;
+end;
+
+procedure TCairoGraphicControl.DoOnParentHandleDestruction;
+begin
+  inherited DoOnParentHandleDestruction;
+  if Canvas.HandleAllocated then
+    TCairoControlCanvas(Canvas).FreeHandle;
+end;
+
+function TCairoGraphicControl.GetDCHandle: HDC;
+begin
+  Result := GetDC(Parent.Handle);
+  MoveWindowOrgEx(Result, Left, Top);
+  IntersectClipRect(Result, 0, 0, Width, Height);
+end;
+
+procedure TCairoGraphicControl.ReleaseDCHandle(DC: HDC);
+begin
+  ReleaseDC(Parent.Handle, DC);
+end;
+
+constructor TCairoGraphicControl.Create(AOwner: TComponent);
+begin
+  FCanvas := CairoGraphicControlCanvasClass.Create;
+  TCairoControlCanvas(FCanvas).FControl := Self;
+  inherited Create(AOwner);
+end;
+
+destructor TCairoGraphicControl.Destroy;
+begin
+  FreeAndNil(FCanvas);
+  inherited Destroy;
+end;
+
+{ TCairoControlCanvas }
+
+procedure TCairoControlCanvas.SetControl(const AValue: TCairoGraphicControl);
+begin
+  if FControl <> AValue then begin
+    FreeHandle;
+    FControl := AValue;
+  end;
+end;
+
+procedure TCairoControlCanvas.CreateCairoHandle(BaseHandle: HDC);
+begin
+  inherited CreateCairoHandle(BaseHandle);
+  SurfaceXDPI := GetDeviceCaps(BaseHandle, LOGPIXELSX);
+  SurfaceYDPI := GetDeviceCaps(BaseHandle, LOGPIXELSY);
+  XDPI := SurfaceXDPI;
+  YDPI := SurfaceXDPI;
+end;
+
+procedure TCairoControlCanvas.DestroyCairoHandle;
+begin
+  cairo_surface_destroy(sf);
+  sf := nil;
+  inherited DestroyCairoHandle;
+end;
+
+procedure TCairoControlCanvas.CreateHandle;
+begin
+  inherited CreateHandle;
+  if FDeviceContext = 0 then //Store it locally, what was Geted must be Released
+    FDeviceContext := FControl.GetDCHandle;
+  Handle := FDeviceContext;
+end;
+
+procedure TCairoControlCanvas.FreeHandle;
+begin
+  if FDeviceContext <> 0 then
+    FControl.ReleaseDCHandle(FDeviceContext);
+  inherited FreeHandle;
+end;
+
+destructor TCairoControlCanvas.Destroy;
+begin
+  FreeHandle;
+  inherited Destroy;
+end;
+
+{ TCairoPaintBox }
+
+procedure TCairoPaintBox.Paint;
+begin
+  if csDesigning in ComponentState then begin
+    Canvas.Brush.Color := Color;
+    with Canvas do
+    begin
+      Pen.Style := psDash;
+      Pen.Color:=clBlack;
+      Brush.Style := bsClear;
+      Rectangle(0, 0, Self.Width - 1, Self.Height - 1);
+      Line(0,0,Self.Width-1,Self.Height-1);
+      Line(Self.Width-1,0,0,Self.Height-1);
+    end;
+    exit;
+  end;
+  if Assigned(OnPaint) then begin
+    Canvas.Font := Font;
+    Canvas.Brush.Color := Color;
+    inherited Paint;
+  end;
+end;
+
+class function TCairoPaintBox.GetControlClassDefaultSize: TSize;
+begin
+  Result.Cx:=105;
+  Result.Cy:=105;
+end;
+
+constructor TCairoPaintBox.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  ControlStyle := ControlStyle + [csReplicatable];
+  SetInitialBounds(0,0,GetControlClassDefaultSize.Cx,GetControlClassDefaultSize.Cx);
+end;
+
+end.

components/cairocanvas/unix/gdkcairocanvas.pas

@@ -0,0 +1,33 @@
+unit gdkcairocanvas;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  gdk2, Gtk2Def, CairoGraphics, LCLType;
+
+type
+{ TGdkCairoCanvas }
+
+  TGdkCairoCanvas = class(TCairoControlCanvas)
+  protected
+    procedure CreateCairoHandle(BaseHandle: HDC); override;
+  end;
+
+implementation
+
+{ TGdkCairoCanvas }
+
+procedure TGdkCairoCanvas.CreateCairoHandle(BaseHandle: HDC);
+begin
+  inherited;
+  cr := gdk_cairo_create(TGtk2DeviceContext(BaseHandle).Drawable);
+end;
+
+initialization
+  CairoGraphicControlCanvasClass := TGdkCairoCanvas;
+
+end.
+
+

components/cairocanvas/win/win32cairocanvas.pas

@@ -0,0 +1,35 @@
+unit Win32CairoCanvas;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  LCLType, Cairo, CairoWin32, CairoGraphics;
+
+type
+  { TWin32CairoCanvas }
+
+  TWin32CairoCanvas = class(TCairoControlCanvas)
+  protected
+    procedure CreateCairoHandle(BaseHandle: HDC); override;
+  end;
+
+implementation
+
+uses
+  SysUtils;
+
+{ TWin32CairoCanvas }
+
+procedure TWin32CairoCanvas.CreateCairoHandle(BaseHandle: HDC);
+begin
+  inherited;
+  sf := cairo_win32_surface_create(BaseHandle);
+  cr := cairo_create(sf);
+end;
+
+initialization
+  CairoGraphicControlCanvasClass := TWin32CairoCanvas;
+
+end.