lazarus/lcl/interfaces/gtk/gtkdevicecontext.inc

{%MainUnit gtkdef.pp}

{******************************************************************************
                                   TGtkDeviceContext
 ******************************************************************************

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.modifiedLGPL.txt, included in this distribution,        *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

{$IFOPT C-}
// Uncomment for local trace
//  {$C+}
//  {$DEFINE ASSERT_IS_ON}
{$ENDIF}

{ TDeviceContext }

procedure TGtkDeviceContext.SetClipRegion(const AValue: PGdiObject);
begin
  ChangeGDIObject(fClipRegion, AValue);
end;

function TGtkDeviceContext.GetGDIObjects(ID: TGDIType): PGdiObject;
begin
  case ID of
  gdiBitmap: Result:=CurrentBitmap;
  gdiFont: Result:=CurrentFont;
  gdiBrush: Result:=CurrentBrush;
  gdiPen: Result:=CurrentPen;
  gdiPalette: Result:=CurrentPalette;
  gdiRegion: Result:=ClipRegion;
  end;
end;

{------------------------------------------------------------------------------
  function GetOffset

  Returns the DC offset for the DC Origin.
 ------------------------------------------------------------------------------}
function TGtkDeviceContext.GetOffset: TPoint;
var
  Fixed: Pointer;
  Adjustment: PGtkAdjustment;
begin
  if Self = nil
  then begin
    Result.X := 0;
    Result.Y := 0;
    Exit;
  end;

  Result := FOrigin;
  {$ifndef gtk1}
  if (FWidget <> nil) then
  begin
    Fixed := GetFixedWidget(FWidget);
    if GTK_WIDGET_NO_WINDOW(FWidget) and
       GTK_WIDGET_NO_WINDOW(Fixed) and
       not GtkWidgetIsA(FWidget, GTKAPIWidget_GetType) then
    begin
      Inc(Result.X, FWidget^.Allocation.x);
      Inc(Result.y, FWidget^.Allocation.y);
    end;
  end;
  {$endif}
  
  if not FSpecialOrigin then Exit;
  if FWidget = nil then Exit;
  
  {$ifdef gtk1}
  Fixed := GetFixedWidget(FWidget);
  {$endif}
  if not GtkWidgetIsA(Fixed, GTK_LAYOUT_GET_TYPE) then Exit;
  
  Adjustment := gtk_layout_get_hadjustment(Fixed);
  if Adjustment <> nil
  then Dec(Result.X, Trunc(Adjustment^.Value - Adjustment^.Lower));

  Adjustment := gtk_layout_get_vadjustment(Fixed);
  if Adjustment <> nil
  then Dec(Result.Y, Trunc(Adjustment^.Value-Adjustment^.Lower));
end;

function TGtkDeviceContext.GetOwnedGDIObjects(ID: TGDIType): PGdiObject;
begin
  Result:=fOwnedGDIObjects[ID];
end;

procedure TGtkDeviceContext.SetCurrentBitmap(const AValue: PGdiObject);
begin
  ChangeGDIObject(FCurrentBitmap,AValue);
end;

procedure TGtkDeviceContext.SetCurrentBrush(const AValue: PGdiObject);
begin
  ChangeGDIObject(FCurrentBrush,AValue);
  if FSelectedColors = dcscBrush
  then FSelectedColors := dcscCustom;
end;

procedure TGtkDeviceContext.SetCurrentFont(const AValue: PGdiObject);
begin
  ChangeGDIObject(FCurrentFont,AValue);
end;

procedure TGtkDeviceContext.SetCurrentPalette(const AValue: PGdiObject);
begin
  ChangeGDIObject(FCurrentPalette,AValue);
end;

procedure TGtkDeviceContext.SetCurrentPen(const AValue: PGdiObject);
begin
  ChangeGDIObject(FCurrentPen,AValue);
  if FSelectedColors = dcscPen
  then FSelectedColors := dcscCustom;
end;

procedure TGtkDeviceContext.ChangeGDIObject(var GDIObject: PGdiObject;
  const NewValue: PGdiObject);
begin
  if GdiObject = NewValue then exit;
  if GdiObject <> nil
  then begin
    dec(GdiObject^.DCCount);
    if GdiObject^.DCCount < 0 then
      RaiseGDBException('');
  end;

  GdiObject := NewValue;

  if GdiObject <> nil
  then begin
    inc(GdiObject^.DCCount);
  end;
end;

procedure TGtkDeviceContext.SetGDIObjects(ID: TGDIType; const AValue: PGdiObject);
begin
  case ID of
    gdiBitmap:  ChangeGDIObject(fCurrentBitmap,AValue);
    gdiFont:    ChangeGDIObject(fCurrentFont,AValue);
    gdiBrush:   ChangeGDIObject(fCurrentBrush,AValue);
    gdiPen:     ChangeGDIObject(fCurrentPen,AValue);
    gdiPalette: ChangeGDIObject(fCurrentPalette,AValue);
    gdiRegion:  ChangeGDIObject(fClipRegion,AValue);
  end;
end;

procedure TGtkDeviceContext.SetOwnedGDIObjects(ID: TGDIType;
  const AValue: PGdiObject);
begin
//MWE: this is not right. all objects except bitmaps can be selected in more than one DC

  if fOwnedGDIObjects[ID]=AValue then exit;
  if fOwnedGDIObjects[ID]<>nil then
    fOwnedGDIObjects[ID]^.Owner:=nil;
  fOwnedGDIObjects[ID]:=AValue;
  if fOwnedGDIObjects[ID]<>nil then
    fOwnedGDIObjects[ID]^.Owner:=Self;
end;

procedure TGtkDeviceContext.SetROP2(AROP: Integer);
var
  Func: TGdkFunction;
begin
  case AROP of
    R2_COPYPEN:     Func := GDK_COPY;
    R2_NOT:         Func := GDK_INVERT;
    R2_XORPEN:      Func := GDK_XOR;
    R2_BLACK:       Func := GDK_CLEAR;
    R2_MASKPEN:     Func := GDK_AND;
    R2_MASKPENNOT:  Func := GDK_AND_REVERSE;
    R2_MASKNOTPEN:  Func := GDK_AND_INVERT;
    R2_NOP:         Func := GDK_NOOP;
    R2_MERGEPEN:    Func := GDK_OR;
    R2_NOTXORPEN:   Func := GDK_EQUIV;
    R2_MERGEPENNOT: Func := GDK_OR_REVERSE;
    R2_NOTCOPYPEN:  Func := GDK_COPY_INVERT;
    R2_NOTMASKPEN:  Func := GDK_NAND;
    //R2_NOTMERGEPEN: Func := GDK_NOR;
    R2_WHITE:       Func := GDK_SET;
  else
    Func := GDK_COPY;
  end;
  
  gdk_gc_set_function(GC, Func);
end;

procedure TGtkDeviceContext.SetSelectedColors(AValue: TDevContextSelectedColorsType);
begin
  if FSelectedColors = AValue then Exit;
  FSelectedColors := AValue;
  
  case FSelectedColors of
    dcscPen: SelectPenProps;
    dcscBrush: SelectBrushProps;
    dcscFont: SelectTextProps;
  end;
end;

procedure TGtkDeviceContext.SetTextMetricsValid(AValid: Boolean);
begin
  if AValid
  then Include(FFlags, dcfTextMetricsValid)
  else Exclude(FFlags, dcfTextMetricsValid);
end;

procedure TGtkDeviceContext.SetWidget(AWidget: PGtkWidget; AWindow: PGdkWindow;
                                      AWithChildWindows: Boolean; ADoubleBuffer: PGdkDrawable);

  procedure RaiseWidgetWithoutClientArea;
  begin
    RaiseGDBException('TGtkDeviceContext.SetWidget: widget ' + DbgS(AWidget) + ' has no client area');
  end;

  procedure RaiseWidgetAlreadySet;
  begin
    RaiseGDBException('TGtkDeviceContext.SetWidget: widget already set');
  end;
  
  procedure RaiseUnableToRealize;
  begin
    RaiseGDBException('TGtkDeviceContext.SetWidget: Unable to realize GdkWindow');
  end;
  
var
  ClientWidget: PGtkWidget;
begin
  if FWidget <> nil
  then RaiseWidgetAlreadySet;

  FWithChildWindows := AWithChildWindows;
  FWidget := AWidget;

  if AWidget = nil
  then begin
    // screen: ToDo: multiple desktops
    {$ifdef gtk1}
    FDrawable := @gdk_root_parent;
    {$else}
    FDrawable := gdk_screen_get_root_window(gdk_screen_get_default);
    {$endif}
  end
  else begin
    if ADoubleBuffer <> nil
    then begin
      Include(FFlags, dcfDoubleBuffer);
      FOriginalDrawable := AWindow;
      FDrawable := ADoubleBuffer;
    end
    else begin
      // create a new devicecontext for this window
      Exclude(FFlags, dcfDoubleBuffer);
      
      if AWindow = nil
      then begin
        ClientWidget := GetFixedWidget(AWidget);
        if ClientWidget = nil then RaiseWidgetWithoutClientArea;

        AWindow := GetControlWindow(ClientWidget);
        if AWindow = nil
        then begin
          //force creation
          gtk_widget_realize(ClientWidget);
          AWindow := GetControlWindow(ClientWidget);
          if AWindow = nil then RaiseUnableToRealize;
        end;
      end
      else begin
        ClientWidget := AWidget;
      end;

      FSpecialOrigin := GtkWidgetIsA(ClientWidget, GTK_LAYOUT_GET_TYPE);
      FDrawable := AWindow;

      {$IFDEF Gtk1}
      {$IFDEF VerboseGtkToDos}{$note todo: check if this is still needed}{$ENDIF} // now gc is a property
      GetGC;
      {$ELSE}
      // GC is created on demand
      {$ENDIF}
    end;
  end;

  gdk_color_black(gdk_colormap_get_system, @CurrentTextColor.Color);
  BuildColorRefFromGDKColor(CurrentTextColor);
  gdk_color_white(gdk_colormap_get_system, @CurrentBackColor.Color);
  BuildColorRefFromGDKColor(CurrentBackColor);


  {$ifdef GTK1}
  GetFont;
  GetBrush;
  GetPen;
  {$else}
  // font, brush, pen are created on demand
  {$endIf}
end;

procedure TGtkDeviceContext.Clear;
var
  g: TGDIType;
  
  procedure WarnOwnedGDIObject;
  begin
    DebugLn(['TDeviceContext.Clear ',dbghex(PtrInt(Self)),' OwnedGDIObjects[',ord(g),']<>nil']);
  end;
  
begin
  FWidget := nil;
  FDrawable := nil;
  FGC := nil;
  FillChar(FGCValues, SizeOf(FGCValues), 0);

  FOrigin.X := 0;
  FOrigin.Y := 0;
  FSpecialOrigin := False;
  PenPos.X:=0;
  PenPos.Y:=0;
  
  CurrentBitmap:=nil;
  CurrentFont:=nil;
  CurrentPen:=nil;
  CurrentBrush:=nil;
  CurrentPalette:=nil;
  ClipRegion:=nil;
  FillChar(CurrentTextColor,SizeOf(CurrentTextColor),0);
  FillChar(CurrentBackColor,SizeOf(CurrentBackColor),0);

  SelectedColors:=dcscCustom;
  SavedContext:=nil;
  FFlags := [];
  
  for g:=Low(TGDIType) to high(TGDIType) do
    if OwnedGDIObjects[g]<>nil then
      WarnOwnedGDIObject;
end;

{------------------------------------------------------------------------------
  Function: CopyData - used by RestoreDC and SaveDC
  Params:  DestinationDC:  a dc to copy data to
           ClearSource: set true to make a move operation
           MoveGDIOwnerShip: set true to pass the ownership of the GDI objects
                             to Destination
  Returns: True if succesful

  Creates a copy DC from the given DC
 ------------------------------------------------------------------------------}
function TGtkDeviceContext.CopyDataFrom(ASource: TGtkDeviceContext; AClearSource, AMoveGDIOwnerShip, ARestore: Boolean): Boolean;
  procedure RaiseRestoreDifferentWidget;
  begin
    RaiseGDBException('TGtkDeviceContext.CopyDataFrom: restore widget differs');
  end;

  procedure RaiseWidgetAlreadySet;
  begin
    RaiseGDBException('TGtkDeviceContext.CopyDataFrom: widget already set');
  end;
  
var
  g: TGDIType;
  CurGDIObject: PGDIObject;
begin
  Result := (Self <> nil) and (ASource <> nil);
  if not Result then Exit;
  
  if ARestore
  then begin
    if FWidget <> ASource.FWidget
    then RaiseRestoreDifferentWidget;
  end
  else begin
    if FWidget <> nil
    then RaiseWidgetAlreadySet;
    FWidget := ASource.FWidget;
  end;

  FWithChildWindows := ASource.FWithChildWindows;
  FDrawable := ASource.FDrawable;
  FOriginalDrawable := ASource.FOriginalDrawable;

  if FGC <> nil
  then begin
    // free old GC
    gdk_gc_unref(FGC);
    FGC := nil;
    Exclude(FFlags, dcfPenSelected);
  end;

  if (ASource.FGC <> nil) and (FDrawable <> nil)
  then begin
    gdk_gc_get_values(ASource.FGC, @FGCValues);
    FGC := gdk_gc_new_with_values(FDrawable, @FGCValues, 3 { $3FF});
    Exclude(FFlags, dcfPenSelected);
  end;

  FOrigin := ASource.FOrigin;
  FSpecialOrigin := ASource.FSpecialOrigin;
  PenPos := ASource.PenPos;

  if dcfTextMetricsValid in ASource.Flags
  then begin
    Include(FFlags, dcfTextMetricsValid);
    DCTextMetric := ASource.DCTextMetric;
  end
  else
    Exclude(FFlags, dcfTextMetricsValid);

  for g:=Low(TGDIType) to High(TGDIType) do
  begin
    GDIObjects[g] := ASource.GDIObjects[g];
    if AClearSource then
      ASource.GDIObjects[g] := nil;

    if AMoveGDIOwnerShip
    then begin
      if OwnedGDIObjects[g]<>nil
      then begin
        DeleteObject(HGDIOBJ(PtrUInt(OwnedGDIObjects[g])));
      end;

      CurGDIObject := ASource.OwnedGDIObjects[g];
      
      if CurGDIObject<>nil
      then begin
        ASource.OwnedGDIObjects[g] := nil;
        OwnedGDIObjects[g] := CurGDIObject;
      end;
    end;
  end;
  CopyGDIColor(ASource.CurrentTextColor, CurrentTextColor);
  CopyGDIColor(ASource.CurrentBackColor, CurrentBackColor);

  SelectedColors := dcscCustom;
  SavedContext := nil;
end;

procedure TGtkDeviceContext.CreateBrush;
begin
  if FCurrentBrush <> nil then Exit;
  CurrentBrush := GtkWidgetset.CreateDefaultBrush;
  OwnedGDIObjects[gdiBrush] := FCurrentBrush;
end;

procedure TGtkDeviceContext.CreateFont;
{$IFDEF Gtk2}
var
  ClientWidget: PGtkWidget;
{$ENDIF}
begin
  if FCurrentFont <> nil then exit;

  // create font
  {$ifdef gtk1}
  if FGCValues.Font <> nil
  then begin
    CurrentFont := GtkWidgetset.NewGDIObject(gdiFont);
    FCurrentFont^.GDIFontObject := FGCValues.Font;
    FontCache.Reference(FCurrentFont^.GDIFontObject);
  end
  else
    CurrentFont := GtkWidgetset.CreateDefaultFont;
    
  {$else}
  if FWidget <> nil
  then begin
    ClientWidget := GetFixedWidget(FWidget);

    CurrentFont := GtkWidgetset.NewGDIObject(gdiFont);
    FCurrentFont^.GDIFontObject := gtk_widget_create_pango_layout(ClientWidget, nil);

    {$ifdef fontconsistencychecks}
    if FontCache.FindGTKFont(FCurrentFont^.GDIFontObject) <> nil then
      RaiseGDBException('inconsistency: font already in cache, maybe freed, but not removed from cache');
    {$endif}

    FontCache.AddWithoutName(FCurrentFont^.GDIFontObject);

    // the gtk internal reference count was increased by
    // gtk_widget_create_pango_layout and by FontCache.AddWithoutName
    // reduce it to one, because only this DC is using them at this point
    UnreferenceGtkIntfFont(FCurrentFont^.GDIFontObject);

    {$ifdef fontconsistencychecks}
    // MWE: are we paranoid or so ? (if you can't trust the cache, don't use it or stop coding)
    // MG: some people are coding without knowing about the cache
    if FontCache.FindGTKFont(FCurrentFont^.GDIFontObject) = nil then
      RaiseGDBException('inconsistency: font added to cache, but can not be found');
    {$endif}
  end
  else
    CurrentFont := GtkWidgetset.CreateDefaultFont;
  {$endif}
  OwnedGDIObjects[gdiFont] := FCurrentFont;
end;

function TGtkDeviceContext.CreateGC: PGdkGC;
{$IFDEF Gtk1}
var
  CurWidget: PGtkWidget;
  CurWindow: PGdkWindow;
{$ENDIF}
begin
  // create GC

  if Drawable <> nil
  then begin
    if FWithChildWindows
    then begin
      FillChar(FGCValues, SizeOf(FGCValues), 0);
      FGCValues.subwindow_mode := GDK_INCLUDE_INFERIORS;
      Result := gdk_gc_new_with_values(Drawable, @FGCValues, GDK_GC_FUNCTION or GDK_GC_SUBWINDOW);
    end
    else begin
      Result := gdk_gc_new(Drawable);
    end;
  end
  else begin
    // create default GC
    {$IFDEF Gtk1}
    CurWidget := GetStyleWidget(lgsWindow);
    CurWindow := CurWidget^.window;
    Result := gdk_gc_new(CurWindow);
    {$ELSE}
    Result := gdk_gc_new(gdk_screen_get_root_window(gdk_screen_get_default));
    {$ENDIF}
  end;
  if Result = nil then Exit;

  gdk_gc_set_function(Result, GDK_COPY);
  gdk_gc_get_values(Result, @FGCValues);
end;

procedure TGtkDeviceContext.CreateBitmap;
begin
  if FCurrentBitmap <> nil then Exit;
  CurrentBitmap := GTKWidgetset.CreateDefaultGDIBitmap;
  OwnedGDIObjects[gdiBitmap] := FCurrentBitmap;
end;

procedure TGtkDeviceContext.CreateGDIObject(AGDIType: TGDIType);
begin
  case AGDIType of
    gdiFont: CreateFont;
    gdiBrush: CreateBrush;
    gdiPen: CreatePen;
    gdiBitmap: CreateBitmap;
  else
    RaiseGDBException('TGtkDeviceContext.CreateGDIObject');
  end;
end;

procedure TGtkDeviceContext.CreatePen;
begin
  if FCurrentPen <> nil then exit;
  CurrentPen := GtkWidgetSet.CreateDefaultPen;
  OwnedGDIObjects[gdiPen] := FCurrentPen;
end;


function TGtkDeviceContext.GetGC: pgdkGC;
begin
  if FGC = nil
  then FGC := CreateGC;
  Result := FGC;
end;

function TGtkDeviceContext.GetFont: PGdiObject;
begin
  if FCurrentFont = nil
  then CreateFont;

  Result := FCurrentFont;
end;

function TGtkDeviceContext.GetBrush: PGdiObject;
begin
  if FCurrentBrush = nil
  then CreateBrush;

  Result := FCurrentBrush;
end;

function TGtkDeviceContext.GetPen: PGdiObject;
begin
  if FCurrentPen = nil
  then CreatePen;
  
  Result := FCurrentPen;
end;

function TGtkDeviceContext.GetROP2: Integer;
begin
  case GetFunction of
    GDK_COPY:         result := R2_COPYPEN;
    GDK_INVERT:       result := R2_NOT;
    GDK_XOR:          result := R2_XORPEN;
    GDK_CLEAR:        result := R2_BLACK;
    GDK_AND:          result := R2_MASKPEN;
    GDK_AND_REVERSE:  result := R2_MASKPENNOT;
    GDK_AND_INVERT:   result := R2_MASKNOTPEN;
    GDK_NOOP:         result := R2_NOP;
    GDK_OR:           result := R2_MERGEPEN;
    GDK_EQUIV:        result := R2_NOTXORPEN;
    GDK_OR_REVERSE:   result := R2_MERGEPENNOT;
    GDK_COPY_INVERT:  result := R2_NOTCOPYPEN;
    GDK_NAND:         result := R2_NOTMASKPEN;
    //GDK_NOR:          result := R2_NOTMERGEPEN;
    GDK_SET:          result := R2_WHITE;
  else
    result := R2_COPYPEN;
  end;
end;

function TGtkDeviceContext.HasGC: Boolean;
begin
  Result := FGC <> nil;
end;

function TGtkDeviceContext.IsNullBrush: boolean;
begin
  Result := (FCurrentBrush <> nil) and (FCurrentBrush^.IsNullBrush);
end;


function TGtkDeviceContext.IsNullPen: boolean;
begin
  Result := (FCurrentPen <> nil) and (FCurrentPen^.IsNullPen);
end;

procedure TGtkDeviceContext.ResetGCClipping;
begin
  if FGC = nil then Exit;

  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$endif}
  gdk_gc_set_clip_mask(FGC, nil);
  gdk_gc_set_clip_origin (FGC, 0,0);
  {$IFDEF DebugGDK}EndGDKErrorTrap;{$endif}

  SelectRegion;
end;

function TGtkDeviceContext.SelectBitmap(AGdiObject: PGdiObject): PGdiObject;
var
  NewDrawable: PGdkPixmap;
begin
  // always create, because a valid GDIObject is needed to restore
  Result := GetBitmap;
  if CurrentBitmap = AGDIObject then Exit;

  CurrentBitmap := AGDIObject;
  with FCurrentBitmap^ do
    case GDIBitmapType of
      gbPixmap: NewDrawable := GDIPixmapObject.Image;
      gbBitmap: NewDrawable := GDIBitmapObject;
    else
      DebugLn('[TGtkDeviceContext.SelectBitmap] - Unknown bitmaptype, DC=0x%p', [Pointer(Self)]);
      Exit;
    end;

  // no drawable: this is normal, when restoring the default bitmap (FreeDC)
  if NewDrawable = nil then Exit;
  

  if FGC <> nil
  then gdk_gc_unref(FGC);
  FDrawable := NewDrawable;
  FGC := gdk_gc_new(FDrawable);
  gdk_gc_set_function(FGC, GDK_COPY);
  SelectedColors := dcscCustom;
end;

{------------------------------------------------------------------------------
  Procedure: TGtkDeviceContext.SelectBrushProps
  Params:
  Returns: Nothing

  Sets the forecolor and fill according to the brush
 ------------------------------------------------------------------------------}
procedure TGtkDeviceContext.SelectBrushProps;
begin
  if IsNullBrush then Exit;
  
  // Force brush
  GetBrush;

  EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor
  EnsureGCColor(HDC(Self), dccGDIBrushColor, CurrentBrush^.GDIBrushFill = GDK_Solid, False);//Brush Color

  if CurrentBrush^.GDIBrushFill = GDK_Solid then Exit;
  if CurrentBrush^.GDIBrushPixmap = nil then Exit;

  gdk_gc_set_fill(GC, CurrentBrush^.GDIBrushFill);
  if CurrentBrush^.GDIBrushFill = GDK_STIPPLED
  then gdk_gc_set_stipple(GC, CurrentBrush^.GDIBrushPixmap)
  else gdk_gc_set_tile(GC, CurrentBrush^.GDIBrushPixmap);

  gdk_gc_get_values(GC, @FGCValues);
end;

function TGtkDeviceContext.SelectObject(AGdiObject: PGdiObject): PGdiObject;
begin
  case AGdiObject^.GDIType of
    gdiBitmap: Result := SelectBitmap(AGdiObject);
    gdiPen:    Result := SelectPen(AGdiObject);
  else
    // we only handle bitmaps here atm
    Result := PGdiObject(GTKWidgetSet.SelectObject(HDC(Self), HGDIOBJ(AGdiObject)));
  end;
end;

function TGtkDeviceContext.SelectPen(AGdiObject: PGdiObject): PGdiObject;
begin
  Result := GetPen;// always create, because a valid GDIObject is needed to restore
  if CurrentPen = AGDIObject then Exit;

  CurrentPen := AGDIObject;
  Exclude(FFlags, dcfPenSelected);
  if FGC <> nil
  then SelectPenProps;
  SelectedColors := dcscCustom;
end;

constructor TGtkDeviceContext.Create;
begin
  // nothing
end;

{------------------------------------------------------------------------------
  Procedure: TGtkDeviceContext.SelectPenProps
  Params:  DC: a (LCL)devicecontext
  Returns: Nothing

  Sets the forecolor and fill according to the pen
 ------------------------------------------------------------------------------}
procedure TGtkDeviceContext.SelectPenProps;
const
{$ifdef windows}
  OS_multiplier = 1;
{$else}
  OS_multiplier = 3;
{$endif}

  procedure SetDashes(const ADashes: array of gint8);
  begin
    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
    laz_gdk_gc_set_dashes(GC, 0, @ADashes[0], Length(ADashes));
    {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
  end;

begin
//  if IsNullPen then Exit;

  EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor
  EnsureGCColor(HDC(Self), dccGDIPenColor, False, False);//Pen Color

  if dcfPenSelected in FFlags then Exit;
  Exclude(FFlags, dcfPenInvalid);
  if GC = nil then Exit;

  // force pen
  GetPen;

  CurrentPen^.IsNullPen := CurrentPen^.GDIPenStyle = PS_NULL;
  
  if (CurrentPen^.GDIPenStyle = PS_SOLID)
  or (CurrentPen^.GDIPenStyle = PS_INSIDEFRAME)
  then begin
    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
    gdk_gc_set_line_attributes(GC, CurrentPen^.GDIPenWidth, GDK_LINE_SOLID, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);
    {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
  end
  else begin
    {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
    gdk_gc_set_line_attributes(GC, CurrentPen^.GDIPenWidth, GDK_LINE_ON_OFF_DASH, GDK_CAP_NOT_LAST, GDK_JOIN_MITER);

    // Paul Ishenin: I comparet patterns with windows and changed numbers to make them the same
    // but under linux dot is thinner than in windows, so I added os_multiplier to make them the same
    // in resulting image

    case CurrentPen^.GDIPenStyle of
      PS_DASH:       SetDashes([6*OS_multiplier,2*OS_multiplier]);
      PS_DOT:        SetDashes([1*OS_multiplier,1*OS_multiplier]);
      PS_DASHDOT:    SetDashes([3*OS_multiplier,2*OS_multiplier,1*OS_multiplier,2*OS_multiplier]);
      PS_DASHDOTDOT: SetDashes([3*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier,1*OS_multiplier]);
      //This is DEADLY!!!
      //PS_NULL:       gdk_gc_set_dashes(GC, 0, [0,4], 2);
    end;
    {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
  end;
  gdk_gc_get_values(GC,@FGCValues);
  Include(FFlags, dcfPenSelected);
end;

{------------------------------------------------------------------------------
  procedure SelectRegion

  Applies the current clipping region of the DC (DeviceContext) to the
  gc (GDK Graphic context - pgdkGC)
 ------------------------------------------------------------------------------}
procedure TGtkDeviceContext.SelectRegion;
var
  RGNType : Longint;
begin
  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}

  // force GC
  GetGC;
  
  // Clear
  gdk_gc_set_clip_region(FGC,  nil);
  gdk_gc_set_clip_rectangle(FGC,  nil);

  if ClipRegion <> nil
  then begin
    RGNType := RegionType(ClipRegion^.GDIRegionObject);
    if (RGNType <> ERROR) and (RGNType <> NULLREGION)
    then gdk_gc_set_clip_region(FGC,  ClipRegion^.GDIRegionObject);
  end;

  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
end;

{------------------------------------------------------------------------------
  Procedure: TGtkDeviceContext.SelectTextProps
  Params:
  Returns: Nothing

  Sets the forecolor and fill according to the Textcolor
 ------------------------------------------------------------------------------}
procedure TGtkDeviceContext.SelectTextProps;
begin
  EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor
  EnsureGCColor(HDC(Self), dccCurrentTextColor, False, False);//Font Color
end;

function TGtkDeviceContext.GetBitmap: PGdiObject;
begin
  if FCurrentBitmap = nil
  then CreateBitmap;

  Result := FCurrentBitmap;
end;