1{%MainUnit gtk2def.pp}
2
3{******************************************************************************
4                                   TGtk2DeviceContext
5 ******************************************************************************
6
7 *****************************************************************************
8  This file is part of the Lazarus Component Library (LCL)
9
10  See the file COPYING.modifiedLGPL.txt, included in this distribution,
11  for details about the license.
12 *****************************************************************************
13}
14
15{$IFOPT C-}
16// Uncomment for local trace
17//  {$C+}
18//  {$DEFINE ASSERT_IS_ON}
19{$ENDIF}
20
21{ TDeviceContext }
22
23procedure TGtkDeviceContext.SetClipRegion(const AValue: PGdiObject);
24begin
25  ChangeGDIObject(fClipRegion, AValue);
26end;
27
28function TGtkDeviceContext.GetGDIObjects(ID: TGDIType): PGdiObject;
29begin
30  case ID of
31    gdiBitmap: Result:=CurrentBitmap;
32    gdiFont: Result:=CurrentFont;
33    gdiBrush: Result:=CurrentBrush;
34    gdiPen: Result:=CurrentPen;
35    gdiPalette: Result:=CurrentPalette;
36    gdiRegion: Result:=ClipRegion;
37  end;
38end;
39
40function TGtkDeviceContext.GetClipRectangle: TGdkRectangle;
41var
42  X,Y: gint;
43begin
44  if FClipRegion = nil then
45  begin
46    if (PaintRectangle.Left<>0) or (PaintRectangle.Top<>0) or
47      (PaintRectangle.Right<>0) or (PaintRectangle.Bottom<>0) then
48      Result := GdkRectFromRect(PaintRectangle)
49    else
50    begin
51      gdk_window_get_size(Drawable, @X, @Y);
52      Result := GdkRectFromRect(Rect(0,0, X, Y));
53    end;
54  end else
55    gdk_region_get_clipbox(FClipRegion^.GDIRegionObject, @Result);
56end;
57
58function TGtkDeviceContext.GetOffset: TPoint;
59var
60  Fixed: Pointer;
61  AChild: PGtkWidget;
62  AColumn: PGtkTreeViewColumn;
63  Area: TGdkRectangle;
64  h: gint;
65  w: gint;
66  yoffs: gint;
67  xoffs: gint;
68begin
69  Result := Point(0, 0);
70  if Assigned(FWidget) then
71  begin
72    Fixed := GetFixedWidget(FWidget);
73    if GTK_WIDGET_NO_WINDOW(FWidget) and
74       GTK_WIDGET_NO_WINDOW(Fixed) and
75       not GtkWidgetIsA(FWidget, GTKAPIWidget_GetType) then
76    begin
77      Inc(Result.X, FWidget^.Allocation.x);
78      Inc(Result.y, FWidget^.Allocation.y);
79    end;
80    if (GTK_IS_SCROLLED_WINDOW(FWidget) and GTK_IS_BIN(FWidget)) or (GTK_IS_TREE_VIEW(FWidget)) then
81    begin
82      if GTK_IS_TREE_VIEW(FWidget) then
83        AChild := FWidget
84      else
85        AChild := gtk_bin_get_child(PGtkBin(FWidget));
86      if GTK_IS_TREE_VIEW(AChild) and gtk_tree_view_get_headers_visible(PGtkTreeView(AChild)) then
87      begin
88        AColumn := gtk_tree_view_get_column(PGtkTreeView(AChild), 0);
89        gtk_tree_view_column_cell_get_size(AColumn, @Area, @xoffs, @yoffs, @w, @h);
90        // borders are 2px
91        dec(Result.y, h - 2);
92      end;
93    end;
94  end;
95end;
96
97function TGtkDeviceContext.GetOwnedGDIObjects(ID: TGDIType): PGdiObject;
98begin
99  Result:=fOwnedGDIObjects[ID];
100end;
101
102procedure TGtkDeviceContext.SetCurrentBitmap(const AValue: PGdiObject);
103begin
104  ChangeGDIObject(FCurrentBitmap,AValue);
105end;
106
107procedure TGtkDeviceContext.SetCurrentBrush(const AValue: PGdiObject);
108begin
109  ChangeGDIObject(FCurrentBrush,AValue);
110  if FSelectedColors = dcscBrush then
111    FSelectedColors := dcscCustom;
112end;
113
114procedure TGtkDeviceContext.SetCurrentFont(const AValue: PGdiObject);
115begin
116  ChangeGDIObject(FCurrentFont,AValue);
117  if FHasTransf then
118    TransfUpdateFont;
119end;
120
121procedure TGtkDeviceContext.SetCurrentPalette(const AValue: PGdiObject);
122begin
123  ChangeGDIObject(FCurrentPalette,AValue);
124end;
125
126procedure TGtkDeviceContext.SetCurrentPen(const AValue: PGdiObject);
127begin
128  ChangeGDIObject(FCurrentPen,AValue);
129  if FSelectedColors = dcscPen then
130    FSelectedColors := dcscCustom;
131  if FHasTransf then
132    TransfUpdatePen;
133end;
134
135procedure TGtkDeviceContext.ChangeGDIObject(var GDIObject: PGdiObject;
136  const NewValue: PGdiObject);
137begin
138  if GdiObject = NewValue then exit;
139  if GdiObject <> nil then
140  begin
141    dec(GdiObject^.DCCount);
142    if GdiObject^.DCCount < 0 then
143      RaiseGDBException('');
144    ReleaseGDIObject(GDIObject);
145  end;
146
147  GdiObject := NewValue;
148
149  if GdiObject <> nil then
150  begin
151    inc(GdiObject^.DCCount);
152    ReferenceGDIObject(GDIObject);
153  end;
154end;
155
156procedure TGtkDeviceContext.SetGDIObjects(ID: TGDIType; const AValue: PGdiObject);
157begin
158  case ID of
159    gdiBitmap:  ChangeGDIObject(fCurrentBitmap,AValue);
160    gdiFont:    ChangeGDIObject(fCurrentFont,AValue);
161    gdiBrush:   ChangeGDIObject(fCurrentBrush,AValue);
162    gdiPen:     ChangeGDIObject(fCurrentPen,AValue);
163    gdiPalette: ChangeGDIObject(fCurrentPalette,AValue);
164    gdiRegion:  ChangeGDIObject(fClipRegion,AValue);
165  end;
166end;
167
168procedure TGtkDeviceContext.SetMapMode(AValue: Integer);
169begin
170  if AValue <> FMapMode then
171  begin
172    case AValue of
173      MM_ANISOTROPIC:; // user's choice
174      MM_ISOTROPIC:; // adjusted after each SetViewPortExtEx call (see MSDN for details)
175      MM_HIENGLISH: FWindowExt := Point(1000, -1000);
176      MM_HIMETRIC: FWindowExt := Point(2540, -2540);
177      MM_LOENGLISH: FWindowExt := Point(100, -100);
178      MM_LOMETRIC: FWindowExt := Point(254, -254);
179      MM_TWIPS: FWindowExt := Point(1440, -1440);
180    else
181      AValue := MM_TEXT;
182      FWindowExt := Point(1, 1);
183      FViewPortExt := Point(1, 1);
184    end;
185    FMapMode := AValue;
186    // to do: combine with affine transformations here when they get implemented
187    FHasTransf :=
188      (FMapMode <> MM_TEXT) or
189      (FViewPortOrg.x <> 0) or
190      (FViewPortOrg.y <> 0) or
191      (FWindowOrg.x <> 0) or
192      (FWindowOrg.y <> 0);
193    if not (FMapMode in [MM_TEXT, MM_ANISOTROPIC, MM_ISOTROPIC]) then
194    begin
195      FViewPortExt.X := Gtk2WidgetSet.GetDeviceCaps(HDC(Self), LOGPIXELSX);
196      FViewPortExt.Y := Gtk2WidgetSet.GetDeviceCaps(HDC(Self), LOGPIXELSY);
197    end;
198    TransfUpdateFont;
199    TransfUpdatePen;
200  end;
201end;
202
203procedure TGtkDeviceContext.SetOwnedGDIObjects(ID: TGDIType;
204  const AValue: PGdiObject);
205begin
206//MWE: this is not right. all objects except bitmaps can be selected in more than one DC
207
208  if fOwnedGDIObjects[ID]=AValue then exit;
209  if fOwnedGDIObjects[ID]<>nil then
210    fOwnedGDIObjects[ID]^.Owner:=nil;
211  fOwnedGDIObjects[ID]:=AValue;
212  if fOwnedGDIObjects[ID]<>nil then
213    fOwnedGDIObjects[ID]^.Owner:=Self;
214end;
215
216procedure TGtkDeviceContext.SetROP2(AROP: Integer);
217var
218  Func: TGdkFunction;
219begin
220  case AROP of
221    R2_COPYPEN:     Func := GDK_COPY;
222    R2_NOT:         Func := GDK_INVERT;
223    R2_XORPEN:      Func := GDK_XOR;
224    R2_BLACK:       Func := GDK_CLEAR;
225    R2_MASKPEN:     Func := GDK_AND;
226    R2_MASKPENNOT:  Func := GDK_AND_REVERSE;
227    R2_MASKNOTPEN:  Func := GDK_AND_INVERT;
228    R2_NOP:         Func := GDK_NOOP;
229    R2_MERGEPEN:    Func := GDK_OR;
230    R2_NOTXORPEN:   Func := GDK_EQUIV;
231    R2_MERGEPENNOT: Func := GDK_OR_REVERSE;
232    R2_NOTCOPYPEN:  Func := GDK_COPY_INVERT;
233    R2_NOTMASKPEN:  Func := GDK_NAND;
234    //R2_NOTMERGEPEN: Func := GDK_NOR;
235    R2_WHITE:       Func := GDK_SET;
236  else
237    Func := GDK_COPY;
238  end;
239
240  gdk_gc_set_function(GC, Func);
241  gdk_gc_get_values(GC, @FGCValues);
242end;
243
244procedure TGtkDeviceContext.SetViewPortExt(const AValue: TPoint);
245var
246  Ratio: Single;
247begin
248  if (AValue.x <> FViewPortExt.x) or (AValue.y <> FViewPortExt.y) and
249    (FMapMode in [MM_ISOTROPIC, MM_ANISOTROPIC]) then
250  begin
251    if FMapMode = MM_ISOTROPIC then
252    begin
253      // TK: Is here also an adjustment on Windows if DPIX and DPIY are different?
254      Ratio := FWindowExt.x / FWindowExt.y; // no check, programmer cannot put nonsense
255      if AValue.y * Ratio > AValue.x then
256        FViewPortExt := Point(AValue.x, RoundToInt(AValue.x / Ratio))
257      else if AValue.y * Ratio < AValue.x then
258        FViewPortExt := Point(RoundToInt(AValue.y * Ratio), AValue.y)
259      else
260        FViewPortExt := AValue;
261    end else
262      FViewPortExt := AValue;
263    TransfUpdateFont;
264    TransfUpdatePen;
265  end;
266end;
267
268procedure TGtkDeviceContext.SetViewPortOrg(const AValue: TPoint);
269begin
270  if (FViewPortOrg.x <> AValue.x) or
271     (FViewPortOrg.y <> AValue.y) then
272  begin
273    FViewPortOrg := AValue;
274    FHasTransf := True;
275  end;
276end;
277
278procedure TGtkDeviceContext.SetWindowExt(const AValue: TPoint);
279begin
280  if (AValue.x <> FWindowExt.x) or (AValue.y <> FWindowExt.y) and
281    (FMapMode in [MM_ISOTROPIC, MM_ANISOTROPIC]) then
282  begin
283    FWindowExt := AValue;
284    if FMapMode = MM_ANISOTROPIC then
285    begin
286      TransfUpdateFont;
287      TransfUpdatePen;
288    end;
289  end;
290end;
291
292procedure TGtkDeviceContext.SetWindowOrg(AValue: TPoint);
293begin
294  if (FWindowOrg.x <> AValue.x) or
295     (FWindowOrg.y <> AValue.y) then
296  begin
297    FWindowOrg := AValue;
298    FHasTransf := True;
299  end;
300end;
301
302procedure TGtkDeviceContext.SetSelectedColors(AValue: TDevContextSelectedColorsType);
303begin
304  if FSelectedColors = AValue then Exit;
305  FSelectedColors := AValue;
306
307  case FSelectedColors of
308    dcscPen: SelectPenProps;
309    dcscBrush: SelectBrushProps;
310    dcscFont: SelectTextProps;
311  end;
312end;
313
314procedure TGtkDeviceContext.SetTextMetricsValid(AValid: Boolean);
315begin
316  if AValid then
317    Include(FFlags, dcfTextMetricsValid)
318  else
319    Exclude(FFlags, dcfTextMetricsValid);
320end;
321
322procedure TGtkDeviceContext.RemovePixbuf;
323begin
324  if Assigned(FPixbuf) then
325  begin
326    gdk_pixbuf_unref(FPixbuf);
327    FPixbuf := nil;
328  end;
329end;
330
331procedure TGtkDeviceContext.InvTransfPoint(var X1, Y1: Integer);
332begin
333  X1 := MulDiv(X1 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
334  Y1 := MulDiv(Y1 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
335  // to do: put affine inverse transformation here (for all Inv.. methods)
336end;
337
338function TGtkDeviceContext.InvTransfPointIndirect(const P: TPoint): TPoint;
339begin
340  Result.X := MulDiv(P.X + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
341  Result.Y := MulDiv(P.Y + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
342end;
343
344procedure TGtkDeviceContext.InvTransfRect(var X1, Y1, X2, Y2: Integer);
345begin
346  X1 := MulDiv(X1 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
347  Y1 := MulDiv(Y1 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
348  X2 := MulDiv(X2 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
349  Y2 := MulDiv(Y2 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
350end;
351
352function TGtkDeviceContext.InvTransfRectIndirect(const R: TRect): TRect;
353begin
354  Result.Left := MulDiv(R.Left + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
355  Result.Top := MulDiv(R.Top + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
356  Result.Right := MulDiv(R.Right + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
357  Result.Bottom := MulDiv(R.Bottom + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
358end;
359
360procedure TGtkDeviceContext.InvTransfExtent(var ExtX, ExtY: Integer);
361begin
362  ExtX := MulDiv(ExtX, FWindowExt.x, FViewPortExt.x);
363  ExtY := MulDiv(ExtY, FWindowExt.y, FViewPortExt.y);
364end;
365
366function TGtkDeviceContext.InvTransfExtentIndirect(const Extent: TPoint): TPoint;
367begin
368  Result.X := MulDiv(Extent.X, FWindowExt.x, FViewPortExt.x);
369  Result.Y := MulDiv(Extent.Y, FWindowExt.y, FViewPortExt.y);
370end;
371
372procedure TGtkDeviceContext.TransfAngles(var Angle1, Angle2: Integer);
373begin
374  if FWindowExt.x * FViewPortExt.x < 0 then
375  begin
376    // flip angles along 90-270 degree axis
377    Angle1 := 2880 - Angle1;
378    Angle2 := 2880 - Angle2;
379  end;
380  if FWindowExt.y * FViewPortExt.y < 0 then
381  begin
382    // flip angles along 0-180 degree axis
383    Angle1 := 5760 - Angle1;
384    Angle2 := 5760 - Angle2;
385  end;
386end;
387
388procedure TGtkDeviceContext.TransfNormalize(var Lower, Higher: Integer);
389var
390  Tmp: Integer;
391begin
392  if Lower > Higher then
393  begin
394    Tmp := Lower;
395    Lower := Higher;
396    Higher := Tmp;
397  end;
398end;
399
400procedure TGtkDeviceContext.TransfPoint(var X1, Y1: Integer);
401begin
402  // to do: put affine transformation here (for all Transf.. methods)
403  X1 := MulDiv(X1, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
404  Y1 := MulDiv(Y1, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
405end;
406
407function TGtkDeviceContext.TransfPointIndirect(const P: TPoint): TPoint;
408begin
409  Result.x := MulDiv(P.x, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
410  Result.Y := MulDiv(P.y, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
411end;
412
413procedure TGtkDeviceContext.TransfRect(var X1, Y1, X2, Y2: Integer);
414begin
415  X1 := MulDiv(X1, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
416  Y1 := MulDiv(Y1, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
417  X2 := MulDiv(X2, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
418  Y2 := MulDiv(Y2, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
419end;
420
421function TGtkDeviceContext.TransfRectIndirect(const R: TRect): TRect;
422begin
423  Result.Left := MulDiv(R.Left, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
424  Result.Top := MulDiv(R.Top, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
425  Result.Right := MulDiv(R.Right, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
426  Result.Bottom := MulDiv(R.Bottom, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
427end;
428
429procedure TGtkDeviceContext.TransfExtent(var ExtX, ExtY: Integer);
430begin
431  ExtX := MulDiv(ExtX, FViewPortExt.x, FWindowExt.x);
432  ExtY := MulDiv(ExtY, FViewPortExt.y, FWindowExt.y);
433end;
434
435function TGtkDeviceContext.TransfExtentIndirect(const Extent: TPoint): TPoint;
436begin
437  Result.X := MulDiv(Extent.X, FViewPortExt.x, FWindowExt.x);
438  Result.Y := MulDiv(Extent.Y, FViewPortExt.y, FWindowExt.y);
439end;
440
441procedure TGtkDeviceContext.TransfUpdateFont;
442var
443  AWidth, AHeight: Integer;
444  TmpObj: PGdiObject;
445begin
446  if (FCurrentFont <> nil) and (FCurrentFont^.GDIFontObject <> nil) and (FCurrentFont^.LogFont.lfFaceName[0] <> #0) then
447  begin
448    if FCurrentFont^.UntransfFontHeight = 0 then
449      FCurrentFont^.UntransfFontHeight := FCurrentFont^.LogFont.lfHeight;
450    AWidth := 0; AHeight := FCurrentFont^.UntransfFontHeight;
451    TransfExtent(AWidth, AHeight);
452    if FCurrentFont^.UntransfFontHeight > 0 then
453      AHeight := Abs(AHeight)
454    else
455      AHeight := -Abs(AHeight);
456    if AHeight = 0 then
457      if FCurrentFont^.LogFont.lfHeight > 0 then
458        AHeight := 1
459      else
460      if FCurrentFont^.LogFont.lfHeight < 0 then
461        AHeight := -1
462      else
463        AHeight := 0;
464    if FCurrentFont^.LogFont.lfHeight <> AHeight then
465    begin
466      FontCache.Unreference(FCurrentFont^.GDIFontObject);
467      FCurrentFont^.LogFont.lfHeight := AHeight;
468      TmpObj := {%H-}PGdiObject(PtrUInt(GTK2WidgetSet.CreateFontIndirect(FCurrentFont^.LogFont)));
469      FCurrentFont^.GDIFontObject := TmpObj^.GDIFontObject;
470      TmpObj^.GDIFontObject := nil;
471      TmpObj^.RefCount := 0;
472      GTK2WidgetSet.DisposeGDIObject(TmpObj);
473    end;
474  end;
475end;
476
477procedure TGtkDeviceContext.TransfUpdatePen;
478var
479  AWidth, AHeight: Integer;
480begin
481  if FCurrentPen <> nil then
482  begin
483    if FCurrentPen^.UnTransfPenWidth = 0 then
484      FCurrentPen^.UnTransfPenWidth := FCurrentPen^.GDIPenWidth;
485    AWidth := FCurrentPen^.UnTransfPenWidth;
486    AHeight := FCurrentPen^.UnTransfPenWidth;
487    TransfExtent(AWidth, AHeight);
488    AWidth := Abs(AWidth);
489    AHeight := Abs(AHeight);
490    if AWidth > AHeight then AWidth := AHeight;
491    if AWidth <= 0 then AWidth := 1;
492    if FCurrentPen^.GDIPenWidth <> DWord(AWidth) then
493    begin
494      FCurrentPen^.GDIPenWidth := AWidth;
495      Exclude(FFlags, dcfPenSelected);
496      SelectPenProps;
497    end;
498  end;
499end;
500
501procedure TGtkDeviceContext.SetWidget(AWidget: PGtkWidget; AWindow: PGdkWindow;
502                                      AWithChildWindows: Boolean; ADoubleBuffer: PGdkDrawable);
503
504  procedure RaiseWidgetWithoutClientArea;
505  begin
506    RaiseGDBException('TGtkDeviceContext.SetWidget: widget ' + DbgS(AWidget) + ' has no client area');
507  end;
508
509  procedure RaiseWidgetAlreadySet;
510  begin
511    RaiseGDBException('TGtkDeviceContext.SetWidget: widget already set');
512  end;
513
514  procedure RaiseUnableToRealize;
515  begin
516    RaiseGDBException('TGtkDeviceContext.SetWidget: Unable to realize GdkWindow');
517  end;
518
519var
520  ClientWidget: PGtkWidget;
521  W, TopLvlW: PGtkWidget;
522begin
523  if FWidget <> nil then
524    RaiseWidgetAlreadySet;
525
526  FWithChildWindows := AWithChildWindows;
527  FWidget := AWidget;
528  FPixbuf := nil;
529
530  if (AWidget = nil) then
531  begin
532    // screen: ToDo: multiple desktops
533    FDrawable := gdk_screen_get_root_window(gdk_screen_get_default);
534  end else
535  begin
536    if ADoubleBuffer <> nil then
537    begin
538      Include(FFlags, dcfDoubleBuffer);
539      FOriginalDrawable := AWindow;
540      FDrawable := ADoubleBuffer;
541    end else
542    begin
543      // create a new devicecontext for this window
544      Exclude(FFlags, dcfDoubleBuffer);
545
546      if AWindow = nil then
547      begin
548        ClientWidget := GetFixedWidget(AWidget);
549        if ClientWidget = nil then RaiseWidgetWithoutClientArea;
550
551        AWindow := GetControlWindow(ClientWidget);
552        if AWindow = nil then
553        begin
554          W := gtk_widget_get_parent(AWidget);
555          TopLvlW := gtk_widget_get_toplevel(AWidget);
556          if (W <> nil) and GTK_IS_WINDOW(TopLvlW) then
557          begin
558            //debugln(['TGtkDeviceContext.SetWidget gtk-class=',GetWidgetClassName(W),' lcl-obj=',DbgSName(GetLCLObject(W))]);
559            //we are forcing window creation but not for GtkNotebook
560            //see issue #18754 and #20126
561            //Zeljko:This part should be NOT BE REMOVED since TToolbar, TFrame
562            //TGroupBox etc...depend on this. eg.TToolbar will lock
563            //mouse without realizing clientWidget.Also if THintWindow is
564            //visible it crashes sometimes. SO JUST NOTEBOOK !
565            if not GTK_IS_NOTEBOOK(W) then
566              gtk_widget_realize(ClientWidget);
567          end;
568
569          AWindow := GetControlWindow(ClientWidget);
570          // Don't raise an exception. Not all operations needs drawable. For example font metrics:
571          // http://bugs.freepascal.org/view.php?id=14035
572          //if AWindow = nil then RaiseUnableToRealize;
573        end;
574      end else
575      begin
576        ClientWidget := AWidget;
577      end;
578
579      FDrawable := AWindow;
580      // GC is created on demand
581      if (FDrawable = nil) and not GTK_WIDGET_MAPPED(AWidget) then
582        FDrawable := gdk_screen_get_root_window(gdk_screen_get_default);
583    end;
584  end;
585
586  gdk_color_black(gdk_colormap_get_system, @CurrentTextColor.Color);
587  BuildColorRefFromGDKColor(CurrentTextColor);
588  gdk_color_white(gdk_colormap_get_system, @CurrentBackColor.Color);
589  BuildColorRefFromGDKColor(CurrentBackColor);
590  // font, brush, pen are created on demand
591end;
592
593procedure TGtkDeviceContext.Clear;
594var
595  g: TGDIType;
596
597  procedure WarnOwnedGDIObject;
598  begin
599    DebugLn(['TDeviceContext.Clear ',dbghex(PtrInt(Self)),' OwnedGDIObjects[',ord(g),']<>nil']);
600  end;
601
602begin
603  if Assigned(FPixbuf) then gdk_pixbuf_unref(FPixbuf);
604  FWidget := nil;
605  FDrawable := nil;
606  FPixbuf := nil;
607  FGC := nil;
608  FillChar(FGCValues, SizeOf(FGCValues), 0);
609
610  FViewPortExt := Point(1, 1);
611  FViewPortOrg := Point(0, 0);
612  FWindowExt := Point(1, 1);
613  FWindowOrg := Point(0, 0);
614  FMapMode := MM_TEXT;
615  if FHasTransf then
616  begin
617    FHasTransf := False;
618    TransfUpdateFont;
619    TransfUpdatePen;
620  end;
621
622  PenPos := Point(0, 0);
623
624  CurrentBitmap:=nil;
625  CurrentFont:=nil;
626  CurrentPen:=nil;
627  CurrentBrush:=nil;
628  CurrentPalette:=nil;
629  ClipRegion:=nil;
630  FillChar(CurrentTextColor,SizeOf(CurrentTextColor),0);
631  FillChar(CurrentBackColor,SizeOf(CurrentBackColor),0);
632  FillChar(PaintRectangle, SizeOf(PaintRectangle), 0);
633
634  SelectedColors:=dcscCustom;
635  SavedContext:=nil;
636  FFlags := [];
637
638  for g:=Low(TGDIType) to high(TGDIType) do
639    if OwnedGDIObjects[g]<>nil then
640      WarnOwnedGDIObject;
641end;
642
643{------------------------------------------------------------------------------
644  Function: CopyData - used by RestoreDC and SaveDC
645  Params:  DestinationDC:  a dc to copy data to
646           ClearSource: set true to make a move operation
647           MoveGDIOwnerShip: set true to pass the ownership of the GDI objects
648                             to Destination
649  Returns: True if succesful
650
651  Creates a copy DC from the given DC
652 ------------------------------------------------------------------------------}
653function TGtkDeviceContext.CopyDataFrom(ASource: TGtkDeviceContext; AClearSource, AMoveGDIOwnerShip, ARestore: Boolean): Boolean;
654  procedure RaiseRestoreDifferentWidget;
655  begin
656    RaiseGDBException('TGtkDeviceContext.CopyDataFrom: restore widget differs');
657  end;
658
659  procedure RaiseWidgetAlreadySet;
660  begin
661    RaiseGDBException('TGtkDeviceContext.CopyDataFrom: widget already set');
662  end;
663
664var
665  g: TGDIType;
666  CurGDIObject: PGDIObject;
667begin
668  Result := Assigned(Self) and Assigned(ASource);
669  if not Result then Exit;
670
671  if ARestore then
672  begin
673    if FWidget <> ASource.FWidget then
674      RaiseRestoreDifferentWidget;
675  end else
676  begin
677    if Assigned(FWidget) then
678      RaiseWidgetAlreadySet;
679    FWidget := ASource.FWidget;
680  end;
681
682  FWithChildWindows := ASource.FWithChildWindows;
683  FDrawable := ASource.FDrawable;
684  FPixbuf := ASource.Pixbuf;
685  FOriginalDrawable := ASource.FOriginalDrawable;
686
687  if Assigned(FGC) then
688  begin
689    // free old GC
690    gdk_gc_unref(FGC);
691    FGC := nil;
692    Exclude(FFlags, dcfPenSelected);
693  end;
694
695  if Assigned(ASource.FGC) and Assigned(FDrawable) then
696  begin
697    gdk_gc_get_values(ASource.FGC, @FGCValues);
698    FGC := gdk_gc_new_with_values(FDrawable, @FGCValues,
699      GDK_GC_FOREGROUND or GDK_GC_BACKGROUND or GDK_GC_SUBWINDOW);
700    Exclude(FFlags, dcfPenSelected);
701  end;
702
703  if dcfTextMetricsValid in ASource.Flags then
704  begin
705    Include(FFlags, dcfTextMetricsValid);
706    DCTextMetric := ASource.DCTextMetric;
707  end
708  else
709    Exclude(FFlags, dcfTextMetricsValid);
710
711  for g := Low(TGDIType) to High(TGDIType) do
712  begin
713    GDIObjects[g] := ASource.GDIObjects[g];
714    if AClearSource then
715      ASource.GDIObjects[g] := nil;
716
717    if AMoveGDIOwnerShip then
718    begin
719      if Assigned(OwnedGDIObjects[g]) then
720        DeleteObject(HGDIOBJ({%H-}PtrUInt(OwnedGDIObjects[g])));
721
722      CurGDIObject := ASource.OwnedGDIObjects[g];
723
724      if Assigned(CurGDIObject) then
725      begin
726        ASource.OwnedGDIObjects[g] := nil;
727        OwnedGDIObjects[g] := CurGDIObject;
728      end;
729    end;
730  end;
731  CopyGDIColor(ASource.CurrentTextColor, CurrentTextColor);
732  CopyGDIColor(ASource.CurrentBackColor, CurrentBackColor);
733
734  SelectedColors := dcscCustom;
735  PenPos := ASource.PenPos;
736
737  if FHasTransf then
738  begin
739    FHasTransf := False;
740    FMapMode := MM_TEXT;
741    FViewPortExt := Point(1, 1);
742    FViewPortOrg := Point(0, 0);
743    FWindowExt := Point(1, 1);
744    FWindowOrg := Point(0, 0);
745    TransfUpdateFont;
746    TransfUpdatePen;
747  end;
748
749  FHasTransf := ASource.HasTransf;
750  if FHasTransf then
751  begin
752    FMapMode := ASource.MapMode;
753    FViewPortExt := ASource.ViewPortExt;
754    FViewPortOrg := ASource.ViewPortOrg;
755    FWindowExt := ASource.WindowExt;
756    FWindowOrg := ASource.WindowOrg;
757    TransfUpdateFont;
758    TransfUpdatePen;
759  end;
760
761  SavedContext := nil;
762end;
763
764function TGtkDeviceContext.FillRect(ARect: TRect; ABrush: HBrush; SkipRop: Boolean): Boolean;
765var
766  Width, Height: Integer;
767  OldCurrentBrush: PGdiObject;
768  DCOrigin: TPoint;
769  BrushChanged: Boolean;
770  ClipArea: TGdkRectangle;
771begin
772  BrushChanged := False;
773  if not IsNullBrush then
774  begin
775    if FHasTransf then
776    begin
777      ARect := TransfRectIndirect(ARect);
778      TransfNormalize(ARect.Left, ARect.Right);
779      TransfNormalize(ARect.Top, ARect.Bottom);
780    end;
781
782    Width := ARect.Right - ARect.Left;
783    Height := ARect.Bottom - ARect.Top;
784
785    // Temporary hold the old brush to replace it with the given brush
786    OldCurrentBrush := GetBrush;
787    if not CompareGDIBrushes({%H-}PGdiObject(ABrush), OldCurrentBrush) then
788    begin
789      BrushChanged := True;
790      CurrentBrush := {%H-}PGdiObject(ABrush);
791      SelectedColors := dcscCustom;
792    end;
793
794    SelectBrushProps;
795    if SkipRop then
796      gdk_gc_set_function(GC, GDK_COPY);
797
798    DCOrigin := Offset;
799    ClipArea := ClipRect;
800    RemovePixbuf;
801    if (CurrentBrush^.GDIBrushFill = GDK_SOLID) and
802       (IsBackgroundColor(TColor(CurrentBrush^.GDIBrushColor.ColorRef))) then
803      StyleFillRectangle(Drawable, GC,
804                         CurrentBrush^.GDIBrushColor.ColorRef,
805                         ARect.Left + DCOrigin.X, ARect.Top + DCOrigin.Y,
806                         Width, Height, @ClipArea)
807    else
808      gdk_draw_rectangle(Drawable, GC, 1,
809                         ARect.Left + DCOrigin.X, ARect.Top + DCOrigin.Y,
810                         Width, Height);
811
812    if SkipRop then
813      gdk_gc_set_function(GC, GetFunction);
814
815    // Restore current brush
816    if BrushChanged then
817    begin
818      SelectedColors := dcscCustom;
819      CurrentBrush := OldCurrentBrush;
820    end;
821  end;
822
823  Result := True;
824end;
825
826procedure TGtkDeviceContext.CreateBrush;
827begin
828  if FCurrentBrush <> nil then Exit;
829  CurrentBrush := Gtk2Widgetset.CreateDefaultBrush;
830  OwnedGDIObjects[gdiBrush] := FCurrentBrush;
831end;
832
833procedure TGtkDeviceContext.CreateFont;
834var
835  NewFont: PGDIObject;
836  ClientWidget: PGtkWidget;
837begin
838  if FCurrentFont <> nil then exit;
839
840  // create font
841  if FWidget <> nil then
842  begin
843    ClientWidget := GetFixedWidget(FWidget);
844
845    NewFont := Gtk2Widgetset.NewGDIObject(gdiFont);
846    NewFont^.UntransfFontHeight := 0;
847    CurrentFont := NewFont;
848    FCurrentFont^.GDIFontObject := gtk_widget_create_pango_layout(ClientWidget, nil);
849
850    {$ifdef fontconsistencychecks}
851    if FontCache.FindGTKFont(FCurrentFont^.GDIFontObject) <> nil then
852      RaiseGDBException('inconsistency: font already in cache, maybe freed, but not removed from cache');
853    {$endif}
854
855    FontCache.AddWithoutName(FCurrentFont^.GDIFontObject);
856
857    // the gtk internal reference count was increased by
858    // gtk_widget_create_pango_layout and by FontCache.AddWithoutName
859    // reduce it to one, because only this DC is using them at this point
860    UnreferenceGtkIntfFont(FCurrentFont^.GDIFontObject);
861
862    {$ifdef fontconsistencychecks}
863    // MWE: are we paranoid or so ? (if you can't trust the cache, don't use it or stop coding)
864    // MG: some people are coding without knowing about the cache
865    if FontCache.FindGTKFont(FCurrentFont^.GDIFontObject) = nil then
866      RaiseGDBException('inconsistency: font added to cache, but can not be found');
867    {$endif}
868  end
869  else
870    CurrentFont := Gtk2Widgetset.CreateDefaultFont;
871  OwnedGDIObjects[gdiFont] := FCurrentFont;
872end;
873
874function TGtkDeviceContext.CreateGC: PGdkGC;
875begin
876  // create GC
877
878  if (Drawable <> nil) and (Drawable^.parent_instance.ref_count>0) then
879  begin
880    if FWithChildWindows then
881    begin
882      FillChar(FGCValues, SizeOf(FGCValues), 0);
883      FGCValues.subwindow_mode := GDK_INCLUDE_INFERIORS;
884      Result := gdk_gc_new_with_values(Drawable, @FGCValues, GDK_GC_FUNCTION or GDK_GC_SUBWINDOW);
885    end else
886    begin
887      Result := gdk_gc_new(Drawable);
888    end;
889  end else
890  begin
891    // create default GC
892    Result := gdk_gc_new(gdk_screen_get_root_window(gdk_screen_get_default));
893  end;
894  if Result = nil then Exit;
895
896  gdk_gc_set_function(Result, GDK_COPY);
897  gdk_gc_get_values(Result, @FGCValues);
898end;
899
900procedure TGtkDeviceContext.CreateBitmap;
901begin
902  if FCurrentBitmap <> nil then Exit;
903  CurrentBitmap := GTK2Widgetset.CreateDefaultGDIBitmap;
904  OwnedGDIObjects[gdiBitmap] := FCurrentBitmap;
905end;
906
907procedure TGtkDeviceContext.CreateGDIObject(AGDIType: TGDIType);
908begin
909  case AGDIType of
910    gdiFont: CreateFont;
911    gdiBrush: CreateBrush;
912    gdiPen: CreatePen;
913    gdiBitmap: CreateBitmap;
914  else
915    RaiseGDBException('TGtkDeviceContext.CreateGDIObject');
916  end;
917end;
918
919procedure TGtkDeviceContext.CreatePen;
920begin
921  if FCurrentPen <> nil then exit;
922  CurrentPen := Gtk2WidgetSet.CreateDefaultPen;
923  OwnedGDIObjects[gdiPen] := FCurrentPen;
924end;
925
926
927function TGtkDeviceContext.GetGC: pgdkGC;
928begin
929  if FGC = nil then
930    FGC := CreateGC;
931  Result := FGC;
932end;
933
934function TGtkDeviceContext.GetFont: PGdiObject;
935begin
936  if FCurrentFont = nil then
937    CreateFont;
938
939  Result := FCurrentFont;
940end;
941
942function TGtkDeviceContext.GetBrush: PGdiObject;
943begin
944  if FCurrentBrush = nil then
945    CreateBrush;
946
947  Result := FCurrentBrush;
948end;
949
950function TGtkDeviceContext.GetPen: PGdiObject;
951begin
952  if FCurrentPen = nil then
953    CreatePen;
954
955  Result := FCurrentPen;
956end;
957
958function TGtkDeviceContext.GetROP2: Integer;
959begin
960  case GetFunction of
961    GDK_COPY:         result := R2_COPYPEN;
962    GDK_INVERT:       result := R2_NOT;
963    GDK_XOR:          result := R2_XORPEN;
964    GDK_CLEAR:        result := R2_BLACK;
965    GDK_AND:          result := R2_MASKPEN;
966    GDK_AND_REVERSE:  result := R2_MASKPENNOT;
967    GDK_AND_INVERT:   result := R2_MASKNOTPEN;
968    GDK_NOOP:         result := R2_NOP;
969    GDK_OR:           result := R2_MERGEPEN;
970    GDK_EQUIV:        result := R2_NOTXORPEN;
971    GDK_OR_REVERSE:   result := R2_MERGEPENNOT;
972    GDK_COPY_INVERT:  result := R2_NOTCOPYPEN;
973    GDK_NAND:         result := R2_NOTMASKPEN;
974    //GDK_NOR:          result := R2_NOTMERGEPEN;
975    GDK_SET:          result := R2_WHITE;
976  else
977    result := R2_COPYPEN;
978  end;
979end;
980
981function TGtkDeviceContext.HasGC: Boolean;
982begin
983  Result := FGC <> nil;
984end;
985
986function TGtkDeviceContext.IsNullBrush: boolean;
987begin
988  Result := (FCurrentBrush <> nil) and (FCurrentBrush^.IsNullBrush);
989end;
990
991
992function TGtkDeviceContext.IsNullPen: boolean;
993begin
994  Result := (FCurrentPen <> nil) and (FCurrentPen^.IsNullPen);
995end;
996
997procedure TGtkDeviceContext.ResetGCClipping;
998begin
999  if FGC = nil then Exit;
1000
1001  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$endif}
1002  gdk_gc_set_clip_mask(FGC, nil);
1003  gdk_gc_set_clip_origin (FGC, 0,0);
1004  {$IFDEF DebugGDK}EndGDKErrorTrap;{$endif}
1005
1006  SelectRegion;
1007end;
1008
1009function TGtkDeviceContext.SelectBitmap(AGdiObject: PGdiObject): PGdiObject;
1010var
1011  NewPixbuf: PGdkPixbuf;
1012  NewDrawable: PGdkPixmap;
1013  Mask: PGdkBitmap;
1014begin
1015  // always create, because a valid GDIObject is needed to restore
1016  Result := GetBitmap;
1017  if CurrentBitmap = AGDIObject then Exit;
1018
1019  NewPixbuf := nil;
1020  CurrentBitmap := AGDIObject;
1021  with FCurrentBitmap^ do
1022    case GDIBitmapType of
1023      gbPixmap: NewDrawable := GDIPixmapObject.Image;
1024      gbBitmap: NewDrawable := GDIBitmapObject;
1025      gbPixbuf:
1026        begin
1027          NewDrawable := nil;
1028          Mask := nil;
1029          NewPixbuf := GDIPixbufObject;
1030          gdk_pixbuf_render_pixmap_and_mask(GDIPixbufObject, NewDrawable, Mask, $80);
1031          GDIBitmapType := gbPixmap;
1032          GDIPixmapObject.Image := NewDrawable;
1033          GDIPixmapObject.Mask := Mask;
1034          if Visual <> nil then
1035            gdk_visual_unref(Visual);
1036          Visual := gdk_window_get_visual(NewDrawable);
1037          gdk_visual_ref(Visual);
1038        end;
1039    else
1040      DebugLn('[TGtkDeviceContext.SelectBitmap] - Unknown bitmaptype, DC=0x%p', [Pointer(Self)]);
1041      Exit;
1042    end;
1043
1044  // no drawable: this is normal, when restoring the default bitmap (FreeDC)
1045  if NewDrawable = nil then Exit;
1046
1047  if FGC <> nil then
1048    gdk_gc_unref(FGC);
1049  FDrawable := NewDrawable;
1050  FPixbuf := NewPixbuf;
1051  FGC := gdk_gc_new(FDrawable);
1052  gdk_gc_set_function(FGC, GDK_COPY);
1053  SelectedColors := dcscCustom;
1054end;
1055
1056{------------------------------------------------------------------------------
1057  Procedure: TGtkDeviceContext.SelectBrushProps
1058  Params:
1059  Returns: Nothing
1060
1061  Sets the forecolor and fill according to the brush
1062 ------------------------------------------------------------------------------}
1063procedure TGtkDeviceContext.SelectBrushProps;
1064begin
1065  if IsNullBrush then Exit;
1066
1067  // Force brush
1068  GetBrush;
1069
1070  EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor
1071  EnsureGCColor(HDC(Self), dccGDIBrushColor, CurrentBrush^.GDIBrushFill = GDK_Solid, False);//Brush Color
1072
1073  if CurrentBrush^.GDIBrushFill = GDK_Solid then Exit;
1074  if CurrentBrush^.GDIBrushPixmap = nil then Exit;
1075
1076  if CurrentBrush^.GDIBrushFill = GDK_STIPPLED then
1077  begin
1078    //invert background / foreground colors to match Windows.FillRect behavior
1079    //with a 1bit bitmap pattern brush (bit set -> back color, bit unset -> text color)
1080    EnsureGCColor(HDC(Self), dccCurrentTextColor, False, True);
1081    EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);
1082    gdk_gc_set_stipple(GC, CurrentBrush^.GDIBrushPixmap);
1083    //use GDK_OPAQUE_STIPPLED to draw both background and foreground color
1084    gdk_gc_set_fill(GC, GDK_OPAQUE_STIPPLED);
1085  end
1086  else
1087  begin
1088    gdk_gc_set_tile(GC, CurrentBrush^.GDIBrushPixmap);
1089    gdk_gc_set_fill(GC, GDK_TILED);
1090  end;
1091
1092  gdk_gc_get_values(GC, @FGCValues);
1093end;
1094
1095function TGtkDeviceContext.SelectObject(AGdiObject: PGdiObject): PGdiObject;
1096begin
1097  case AGdiObject^.GDIType of
1098    gdiBitmap: Result := SelectBitmap(AGdiObject);
1099    gdiPen:    Result := SelectPen(AGdiObject);
1100  else
1101    // we only handle bitmaps here atm
1102    Result := {%H-}PGdiObject(GTK2WidgetSet.SelectObject(HDC(Self), {%H-}HGDIOBJ(AGdiObject)));
1103  end;
1104end;
1105
1106function TGtkDeviceContext.SelectPen(AGdiObject: PGdiObject): PGdiObject;
1107begin
1108  Result := GetPen;// always create, because a valid GDIObject is needed to restore
1109  if CurrentPen = AGDIObject then Exit;
1110
1111  CurrentPen := AGDIObject;
1112  Exclude(FFlags, dcfPenSelected);
1113  if FGC <> nil then
1114    SelectPenProps;
1115  SelectedColors := dcscCustom;
1116end;
1117
1118constructor TGtkDeviceContext.Create;
1119begin
1120  Clear;
1121  BkMode := OPAQUE;
1122end;
1123
1124destructor TGtkDeviceContext.Destroy;
1125begin
1126  if Assigned(FPixbuf) then gdk_pixbuf_unref(FPixbuf);
1127  inherited Destroy;
1128end;
1129
1130{------------------------------------------------------------------------------
1131  Procedure: TGtkDeviceContext.SelectPenProps
1132  Params:  DC: a (LCL)devicecontext
1133  Returns: Nothing
1134
1135  Sets the forecolor and fill according to the pen
1136 ------------------------------------------------------------------------------}
1137procedure TGtkDeviceContext.SelectPenProps;
1138var
1139  PenStyle: DWord;
1140  LineStyle: TGdkLineStyle;
1141  JoinStyle: TGdkJoinStyle;
1142  CapStyle: TGdkCapStyle;
1143  IsGeometric, IsExtPen: Boolean;
1144  PenWidth: gint;
1145
1146  procedure SetDashes(ADashes: array of gint8);
1147  var
1148    Multiplier: gint;
1149    i: integer;
1150  begin
1151    Multiplier := PenWidth;
1152    if Multiplier = 0 then
1153      Multiplier := 1;
1154
1155    // this works very well for geometric pens
1156    for i := Low(ADashes) to High(ADashes) do
1157      ADashes[i] := ADashes[i] * Multiplier;
1158
1159    laz_gdk_gc_set_dashes(GC, 4096, @ADashes[0], Length(ADashes))
1160  end;
1161
1162begin
1163//  if IsNullPen then Exit;
1164
1165  EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True); // BKColor
1166  EnsureGCColor(HDC(Self), dccGDIPenColor, False, False);    // Pen Color
1167
1168  if dcfPenSelected in FFlags then Exit;
1169  Exclude(FFlags, dcfPenInvalid);
1170  if GC = nil then Exit;
1171
1172  // force pen
1173  GetPen;
1174
1175  PenStyle := CurrentPen^.GDIPenStyle and PS_STYLE_MASK;
1176  IsExtPen := CurrentPen^.IsExtPen;
1177  PenWidth := CurrentPen^.GDIPenWidth;
1178
1179  if IsExtPen then
1180    IsGeometric := (CurrentPen^.GDIPenStyle and PS_TYPE_MASK) = PS_GEOMETRIC
1181  else
1182    IsGeometric := PenWidth > 1;
1183
1184  if not IsGeometric then
1185    PenWidth := 0;
1186
1187  CurrentPen^.IsNullPen := PenStyle = PS_NULL;
1188
1189  if IsExtPen and IsGeometric then
1190  begin
1191    case CurrentPen^.GDIPenStyle and PS_JOIN_MASK of
1192      PS_JOIN_ROUND: JoinStyle := GDK_JOIN_ROUND;
1193      PS_JOIN_BEVEL: JoinStyle := GDK_JOIN_BEVEL;
1194      PS_JOIN_MITER: JoinStyle := GDK_JOIN_MITER;
1195    end;
1196
1197    case CurrentPen^.GDIPenStyle and PS_ENDCAP_MASK of
1198      PS_ENDCAP_ROUND: CapStyle := GDK_CAP_ROUND;
1199      PS_ENDCAP_SQUARE: CapStyle := GDK_CAP_PROJECTING;
1200      PS_ENDCAP_FLAT: CapStyle := GDK_CAP_NOT_LAST;
1201    end;
1202  end
1203  else
1204  begin
1205    JoinStyle := GDK_JOIN_ROUND;
1206    if IsGeometric then
1207      CapStyle := GDK_CAP_ROUND
1208    else
1209      CapStyle := GDK_CAP_NOT_LAST;
1210  end;
1211
1212  if (PenStyle = PS_USERSTYLE) and (not IsExtPen or (CurrentPen^.GDIPenDashesCount = 0)) then
1213    PenStyle := PS_SOLID;
1214
1215  if (PenStyle = PS_SOLID) or (PenStyle = PS_INSIDEFRAME) then
1216    LineStyle := GDK_LINE_SOLID
1217  else
1218    LineStyle := GDK_LINE_ON_OFF_DASH;
1219
1220  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
1221  gdk_gc_set_line_attributes(GC, PenWidth, LineStyle, CapStyle, JoinStyle);
1222  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
1223
1224  // Paul Ishenin: I compared patterns with windows
1225  case PenStyle of
1226    PS_DASH:       SetDashes([4,2]);
1227    PS_DOT:        SetDashes([1,2]);
1228    PS_DASHDOT:    SetDashes([4,2,1,2]);
1229    PS_DASHDOTDOT: SetDashes([4,2,1,2,1,2]);
1230    PS_USERSTYLE:  laz_gdk_gc_set_dashes(GC, 0, CurrentPen^.GDIPenDashes, CurrentPen^.GDIPenDashesCount);
1231  end;
1232  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
1233  gdk_gc_get_values(GC, @FGCValues);
1234  Include(FFlags, dcfPenSelected);
1235end;
1236
1237{------------------------------------------------------------------------------
1238  procedure SelectRegion
1239
1240  Applies the current clipping region of the DC (DeviceContext) to the
1241  gc (GDK Graphic context - pgdkGC)
1242 ------------------------------------------------------------------------------}
1243procedure TGtkDeviceContext.SelectRegion;
1244var
1245  RGNType : Longint;
1246begin
1247  {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
1248
1249  // force GC
1250  GetGC;
1251
1252  // Clear
1253  gdk_gc_set_clip_region(FGC,  nil);
1254  gdk_gc_set_clip_rectangle(FGC,  nil);
1255
1256  if ClipRegion <> nil then
1257  begin
1258    RGNType := RegionType(ClipRegion^.GDIRegionObject);
1259    if RGNType <> ERROR then
1260      gdk_gc_set_clip_region(FGC,  ClipRegion^.GDIRegionObject);
1261  end;
1262
1263  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
1264end;
1265
1266{------------------------------------------------------------------------------
1267  Procedure: TGtkDeviceContext.SelectTextProps
1268  Params:
1269  Returns: Nothing
1270
1271  Sets the forecolor and fill according to the Textcolor
1272 ------------------------------------------------------------------------------}
1273procedure TGtkDeviceContext.SelectTextProps;
1274begin
1275  EnsureGCColor(HDC(Self), dccCurrentBackColor, True, True);//BKColor
1276  EnsureGCColor(HDC(Self), dccCurrentTextColor, False, False);//Font Color
1277end;
1278
1279function TGtkDeviceContext.GetBitmap: PGdiObject;
1280begin
1281  if FCurrentBitmap = nil then
1282    CreateBitmap;
1283
1284  Result := FCurrentBitmap;
1285end;
1286
1287function TGtkDeviceContext.GetFunction: TGdkFunction;
1288begin
1289  Result := GCValues._function;
1290end;
1291
1292
1293procedure SetLayoutText(ALayout: PPangoLayout; AText: PChar; ALength: PtrInt);
1294var
1295  OldStr: PChar;
1296begin
1297  OldStr := pango_layout_get_text(ALayout);
1298  if (strlen(OldStr)<>ALength) or (strlcomp(AText, OldStr, ALength) <> 0) then
1299    pango_layout_set_text(ALayout, AText, ALength);
1300end;
1301
1302procedure TGtkDeviceContext.DrawTextWithColors(AText: PChar; ALength: LongInt;
1303  X, Y: Integer; FGColor, BGColor: PGdkColor);
1304var
1305  WidgetCont: PPangoContext;
1306  NewMatrix: TPangoMatrix;
1307  OldMatrix: PPangoMatrix;
1308  renderer: PGdkPangoRenderer;
1309  Direction : TPangoDirection;
1310  AFont: PGdiObject;
1311
1312  procedure SetColors(AFGColor, ABGColor: PGdkColor); inline;
1313  begin
1314    gdk_pango_renderer_set_override_color(renderer, PANGO_RENDER_PART_FOREGROUND, AFGColor);
1315    gdk_pango_renderer_set_override_color(renderer, PANGO_RENDER_PART_UNDERLINE, AFGColor);
1316    gdk_pango_renderer_set_override_color(renderer, PANGO_RENDER_PART_STRIKETHROUGH, AFGColor);
1317    gdk_pango_renderer_set_override_color(renderer, PANGO_RENDER_PART_BACKGROUND, ABGColor);
1318  end;
1319
1320begin
1321  AFont := GetFont;
1322  SetLayoutText(AFont^.GDIFontObject, AText, ALength);
1323
1324  WidgetCont := pango_layout_get_context(AFont^.GDIFontObject);
1325  Direction := pango_find_base_dir(AText, ALength);
1326  pango_context_set_base_dir(WidgetCont, Direction);
1327
1328  if AFont^.LogFont.lfEscapement <> 0 then
1329  begin
1330    if Widget <> nil then
1331      renderer := gdk_pango_renderer_get_default(gtk_widget_get_screen(Widget))
1332    else
1333      renderer := gdk_pango_renderer_get_default(gdk_screen_get_default);
1334    RemovePixbuf;
1335    gdk_pango_renderer_set_drawable(renderer, drawable);
1336    gdk_pango_renderer_set_gc(renderer, GC);
1337    SetColors(FGColor, BGColor);
1338
1339    OldMatrix := pango_context_get_matrix(WidgetCont);
1340    NewMatrix.xx := 1.0;
1341    NewMatrix.xy := 0.0;
1342    NewMatrix.yx := 0.0;
1343    NewMatrix.yy := 1.0;
1344    NewMatrix.x0 := 0.0;
1345    NewMatrix.y0 := 0.0;
1346    pango_matrix_translate(@NewMatrix, X, Y);
1347    pango_matrix_rotate(@NewMatrix, AFont^.LogFont.lfEscapement / 10);
1348
1349    pango_context_set_matrix(WidgetCont, @NewMatrix);
1350    pango_layout_context_changed(AFont^.GDIFontObject);
1351    pango_renderer_draw_layout(PPangoRenderer(renderer), AFont^.GDIFontObject, X, Y);
1352
1353    //now reset
1354    pango_context_set_matrix(WidgetCont, OldMatrix);
1355    pango_layout_context_changed(AFont^.GDIFontObject);
1356
1357    SetColors(nil, nil);
1358    gdk_pango_renderer_set_drawable(renderer, nil);
1359    gdk_pango_renderer_set_gc(renderer, nil);
1360  end
1361  else
1362    gdk_draw_layout_with_colors(drawable, GC, X, Y, AFont^.GDIFontObject, FGColor, BGColor);
1363end;
1364
1365