CairoCanvas, updates from Petr-K, issue #24657

git-svn-id: trunk@43193 -

components/cairocanvas/cairocanvas.pas

@@ -77,6 +77,7 @@ type
     procedure CreateFont; override;
     procedure CreateHandle; override;
     procedure CreatePen; override;
+    procedure CreateRegion; override;
     procedure RealizeAntialiasing; override;
     procedure DestroyHandle;
   public
@@ -221,9 +222,10 @@ procedure TCairoPrinterCanvas.SetPenProperties;
   end;
 var
   cap: cairo_line_cap_t;
+   w: double;
 begin
   SetSourceColor(Pen.Color);
-(*  case Pen.Mode of
+  case Pen.Mode of
     pmBlack: begin
       SetSourceColor(clBlack);
       cairo_set_operator(cr, CAIRO_OPERATOR_OVER);
@@ -249,8 +251,12 @@ begin
     pmNotMask,}
   else
     cairo_set_operator(cr, CAIRO_OPERATOR_OVER);
-  end;*)
+  end;
-  cairo_set_line_width(cr, Pen.Width*ScaleX); //line_width is diameter of the pen circle
+  w := Pen.Width;
+  if w = 0 then
+    w := 0.5;
+  w := w * ScaleY;
+  cairo_set_line_width(cr, w); //line_width is diameter of the pen circle
 
   case Pen.Style of
     psSolid:      cairo_set_dash(cr, nil, 0, 0);
@@ -341,6 +347,7 @@ procedure TCairoPrinterCanvas.EndDoc;
 begin
   inherited EndDoc;
   cairo_show_page(cr);
+  FLazClipRect := Rect(0, 0, 0, 0);
   //if caller is printer, then at the end destroy cairo handles (flush output)
   //and establishes CreateCairoHandle call on the next print
   Handle := 0;
@@ -371,6 +378,10 @@ procedure TCairoPrinterCanvas.CreatePen;
 begin
 end;
 
+procedure TCairoPrinterCanvas.CreateRegion;
+begin
+end;
+
 procedure TCairoPrinterCanvas.RealizeAntialiasing;
 begin
 end;
@@ -979,24 +990,24 @@ var
     te: cairo_text_extents_t;
   begin
     if en>=0 then begin
-      if en>1 then begin
+      //if en>1 then begin
         if en <= len then
           CurLine.EndL := en
         else
           CurLine.EndL := len;
-      end else
+      //end else
-        CurLine.EndL := 1;
+        //CurLine.EndL := 1;
       s1 := Copy(s, CurLine.Start, CurLine.EndL-CurLine.Start+1);
       cairo_text_extents(cr, PChar(s1), @te);
-      CurLine.Width := te.width + te.x_bearing;
+      CurLine.Width := te.width;
     end;
     if st > 0 then begin
       CurLine := TLine.Create;
       Lines.Add(CurLine);
-      if st <= len then
+      //if st <= len then
-        CurLine.Start := st
+        CurLine.Start := st;
-      else
+      //else
-        CurLine.Start := len;
+      //  CurLine.Start := len;
       CurLine.EndL := 0;
     end;
     LastBreakEndL := 0;
@@ -1250,6 +1261,7 @@ var
   theRect: TPangoRectangle;
   {$endif}
 begin
+  RequiredState([csHandleValid, csFontValid]);
   SelectFont;
   {$ifdef pangocairo}
   Layout := Pango_Cairo_Create_Layout(cr);
@@ -1271,6 +1283,7 @@ function TCairoPrinterCanvas.GetTextMetrics(out M: TLCLTextMetric): boolean;
 var
   e: cairo_font_extents_t;
 begin
+  RequiredState([csHandleValid, csFontValid]);
   SelectFont;
   cairo_font_extents(cr, @e); //transformation matrix is here ignored
   FillChar(M{%H-}, SizeOf(M), 0);
@@ -1412,8 +1425,7 @@ var
   W, H: Double;
   acr: Pcairo_t;
 begin
-
+  if Orientation in [poLandscape, poReverseLandscape] then begin
-  if Orientation = poLandscape then begin
     s := '%%PageOrientation: Landscape';
     W := PaperHeight*ScaleY; //switch H, W
     H := PaperWidth*ScaleX;
@@ -1433,11 +1445,21 @@ begin
   cairo_ps_surface_dsc_begin_setup(sf);
   cairo_ps_surface_dsc_comment(sf, PChar(s));
 
-  if Orientation = poLandscape then begin //rotate and move
+  //rotate and move
-    cairo_translate(acr, 0, H);
+  case Orientation of
-    cairo_rotate(acr, -PI/2);
+    poLandscape: begin
+      cairo_translate(acr, 0, H);
+      cairo_rotate(acr, -PI/2);
+    end;
+    poReverseLandscape: begin
+      cairo_translate(acr, W, 0);
+      cairo_rotate(acr, PI/2);
+    end;
+    poReversePortrait: begin
+      cairo_translate(acr, W, H);
+      cairo_rotate(acr, PI);
+    end;
   end;
-
   result := {%H-}HDC(acr);
 end;
 

components/cairocanvas/cairographics.pas

@@ -87,7 +87,6 @@ type
     sf: Pcairo_surface_t;
     FControl: TCairoGraphicControl;
     FDeviceContext: HDC;
-    procedure CreateCairoHandle(BaseHandle: HDC); override;
     procedure DestroyCairoHandle; override;
   public
     procedure CreateHandle; override;
@@ -192,15 +191,6 @@ begin
   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);
@@ -213,13 +203,19 @@ begin
   inherited CreateHandle;
   if FDeviceContext = 0 then //Store it locally, what was Geted must be Released
     FDeviceContext := FControl.GetDCHandle;
-  Handle := FDeviceContext;
+  SetHandle(FDeviceContext);
+  SurfaceXDPI := GetDeviceCaps(FDeviceContext, LOGPIXELSX);
+  SurfaceYDPI := GetDeviceCaps(FDeviceContext, LOGPIXELSY);
+  XDPI := SurfaceXDPI;
+  YDPI := SurfaceXDPI;
 end;
 
 procedure TCairoControlCanvas.FreeHandle;
 begin
-  if FDeviceContext <> 0 then
+  if FDeviceContext <> 0 then begin
     FControl.ReleaseDCHandle(FDeviceContext);
+    FDeviceContext := 0;
+  end;
   inherited FreeHandle;
 end;
 

components/cairocanvas/unix/gdkcairocanvas.pas

@@ -12,17 +12,24 @@ type
 
   TGdkCairoCanvas = class(TCairoControlCanvas)
   protected
-    procedure CreateCairoHandle(BaseHandle: HDC); override;
+    procedure SetHandle(NewHandle: HDC); override;
+    function CreateCairoHandle: HDC; override;
   end;
 
 implementation
 
 { TGdkCairoCanvas }
 
-procedure TGdkCairoCanvas.CreateCairoHandle(BaseHandle: HDC);
+function TGdkCairoCanvas.CreateCairoHandle: HDC;
 begin
-  inherited;
+  Result := 0; //Fake handle, right Handle is setted in SetHandle func
-  cr := gdk_cairo_create(TGtk2DeviceContext(BaseHandle).Drawable);
+end;
+
+procedure TGdkCairoCanvas.SetHandle(NewHandle: HDC);
+begin
+  if NewHandle <> 0 then
+    NewHandle := {%H-}HDC(gdk_cairo_create(TGtk2DeviceContext(NewHandle).Drawable));
+  inherited SetHandle(NewHandle);
 end;
 
 initialization

components/cairocanvas/win/win32cairocanvas.pas

@@ -12,7 +12,8 @@ type
 
   TWin32CairoCanvas = class(TCairoControlCanvas)
   protected
-    procedure CreateCairoHandle(BaseHandle: HDC); override;
+    function CreateCairoHandle: HDC; override;
+    procedure SetHandle(NewHandle: HDC); override;
   end;
 
 implementation
@@ -22,11 +23,18 @@ uses
 
 { TWin32CairoCanvas }
 
-procedure TWin32CairoCanvas.CreateCairoHandle(BaseHandle: HDC);
+function TWin32CairoCanvas.CreateCairoHandle: HDC;
 begin
-  inherited;
+  Result := 0; //Fake handle, right Handle is setted in SetHandle func
-  sf := cairo_win32_surface_create(BaseHandle);
+end;
-  cr := cairo_create(sf);
+
+procedure TWin32CairoCanvas.SetHandle(NewHandle: HDC);
+begin
+  if NewHandle <> 0 then begin
+    sf := cairo_win32_surface_create(NewHandle);
+    NewHandle := {%H-}HDC(cairo_create(sf));
+  end;
+  inherited SetHandle(NewHandle);
 end;
 
 initialization