← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to lcl/interfaces/gtk2/gtk2devicecontext.inc

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/interfaces/gtk2/gtk2devicecontext.inc
34
34
function TGtkDeviceContext.GetGDIObjects(ID: TGDIType): PGdiObject;
35
35
begin
36
36
  case ID of
37
 
  gdiBitmap: Result:=CurrentBitmap;
38
 
  gdiFont: Result:=CurrentFont;
39
 
  gdiBrush: Result:=CurrentBrush;
40
 
  gdiPen: Result:=CurrentPen;
41
 
  gdiPalette: Result:=CurrentPalette;
42
 
  gdiRegion: Result:=ClipRegion;
 
37
    gdiBitmap: Result:=CurrentBitmap;
 
38
    gdiFont: Result:=CurrentFont;
 
39
    gdiBrush: Result:=CurrentBrush;
 
40
    gdiPen: Result:=CurrentPen;
 
41
    gdiPalette: Result:=CurrentPalette;
 
42
    gdiRegion: Result:=ClipRegion;
43
43
  end;
44
44
end;
45
45
 
46
 
{------------------------------------------------------------------------------
47
 
  function GetOffset
 
46
function TGtkDeviceContext.GetClipRectangle: TGdkRectangle;
 
47
var
 
48
  X,Y: gint;
 
49
begin
 
50
  if FClipRegion = nil then
 
51
  begin
 
52
    if (PaintRectangle.Left<>0) or (PaintRectangle.Top<>0) or
 
53
      (PaintRectangle.Right<>0) or (PaintRectangle.Bottom<>0) then
 
54
      Result := GdkRectFromRect(PaintRectangle)
 
55
    else
 
56
    begin
 
57
      gdk_window_get_size(Drawable, @X, @Y);
 
58
      Result := GdkRectFromRect(Rect(0,0, X, Y));
 
59
    end;
 
60
  end else
 
61
    gdk_region_get_clipbox(FClipRegion^.GDIRegionObject, @Result);
 
62
end;
48
63
 
49
 
  Returns the DC offset for the DC Origin.
50
 
 ------------------------------------------------------------------------------}
51
64
function TGtkDeviceContext.GetOffset: TPoint;
52
65
var
53
66
  Fixed: Pointer;
 
67
  AChild: PGtkWidget;
 
68
  AColumn: PGtkTreeViewColumn;
 
69
  Area: TGdkRectangle;
 
70
  h: gint;
 
71
  w: gint;
 
72
  yoffs: gint;
 
73
  xoffs: gint;
54
74
begin
55
 
  if Self = nil
56
 
  then begin
57
 
    Result.X := 0;
58
 
    Result.Y := 0;
59
 
    Exit;
60
 
  end;
61
 
 
62
 
  Result := FOrigin;
63
 
  if (FWidget <> nil) then
 
75
  Result := Point(0, 0);
 
76
  if Assigned(FWidget) then
64
77
  begin
65
78
    Fixed := GetFixedWidget(FWidget);
66
79
    if GTK_WIDGET_NO_WINDOW(FWidget) and
70
83
      Inc(Result.X, FWidget^.Allocation.x);
71
84
      Inc(Result.y, FWidget^.Allocation.y);
72
85
    end;
 
86
    if (GTK_IS_SCROLLED_WINDOW(FWidget) and GTK_IS_BIN(FWidget)) or (GTK_IS_TREE_VIEW(FWidget)) then
 
87
    begin
 
88
      if GTK_IS_TREE_VIEW(FWidget) then
 
89
        AChild := FWidget
 
90
      else
 
91
        AChild := gtk_bin_get_child(PGtkBin(FWidget));
 
92
      if GTK_IS_TREE_VIEW(AChild) and gtk_tree_view_get_headers_visible(PGtkTreeView(AChild)) then
 
93
      begin
 
94
        AColumn := gtk_tree_view_get_column(PGtkTreeView(AChild), 0);
 
95
        gtk_tree_view_column_cell_get_size(AColumn, @Area, @xoffs, @yoffs, @w, @h);
 
96
        // borders are 2px
 
97
        dec(Result.y, h - 2);
 
98
      end;
 
99
    end;
73
100
  end;
74
 
 
75
 
  if not FSpecialOrigin then Exit;
76
 
  if FWidget = nil then Exit;
77
101
end;
78
102
 
79
103
function TGtkDeviceContext.GetOwnedGDIObjects(ID: TGDIType): PGdiObject;
89
113
procedure TGtkDeviceContext.SetCurrentBrush(const AValue: PGdiObject);
90
114
begin
91
115
  ChangeGDIObject(FCurrentBrush,AValue);
92
 
  if FSelectedColors = dcscBrush
93
 
  then FSelectedColors := dcscCustom;
 
116
  if FSelectedColors = dcscBrush then
 
117
    FSelectedColors := dcscCustom;
94
118
end;
95
119
 
96
120
procedure TGtkDeviceContext.SetCurrentFont(const AValue: PGdiObject);
108
132
procedure TGtkDeviceContext.SetCurrentPen(const AValue: PGdiObject);
109
133
begin
110
134
  ChangeGDIObject(FCurrentPen,AValue);
111
 
  if FSelectedColors = dcscPen
112
 
  then FSelectedColors := dcscCustom;
 
135
  if FSelectedColors = dcscPen then
 
136
    FSelectedColors := dcscCustom;
113
137
  if FHasTransf then
114
138
    TransfUpdatePen;
115
139
end;
118
142
  const NewValue: PGdiObject);
119
143
begin
120
144
  if GdiObject = NewValue then exit;
121
 
  if GdiObject <> nil
122
 
  then begin
 
145
  if GdiObject <> nil then
 
146
  begin
123
147
    dec(GdiObject^.DCCount);
124
148
    if GdiObject^.DCCount < 0 then
125
149
      RaiseGDBException('');
128
152
 
129
153
  GdiObject := NewValue;
130
154
 
131
 
  if GdiObject <> nil
132
 
  then begin
 
155
  if GdiObject <> nil then
 
156
  begin
133
157
    inc(GdiObject^.DCCount);
134
158
    ReferenceGDIObject(GDIObject);
135
159
  end;
166
190
    end;
167
191
    FMapMode := AValue;
168
192
    // to do: combine with affine transformations here when they get implemented
169
 
    FHasTransf :=  (FMapMode <> MM_TEXT) or (FViewPortOrg.x <> 0) or (FViewPortOrg.y <> 0);
 
193
    FHasTransf :=
 
194
      (FMapMode <> MM_TEXT) or
 
195
      (FViewPortOrg.x <> 0) or
 
196
      (FViewPortOrg.y <> 0) or
 
197
      (FWindowOrg.x <> 0) or
 
198
      (FWindowOrg.y <> 0);
170
199
    if not (FMapMode in [MM_TEXT, MM_ANISOTROPIC, MM_ISOTROPIC]) then
171
200
    begin
172
201
      FViewPortExt.X := Gtk2WidgetSet.GetDeviceCaps(HDC(Self), LOGPIXELSX);
266
295
  end;
267
296
end;
268
297
 
 
298
procedure TGtkDeviceContext.SetWindowOrg(AValue: TPoint);
 
299
begin
 
300
  if (FWindowOrg.x <> AValue.x) or
 
301
     (FWindowOrg.y <> AValue.y) then
 
302
  begin
 
303
    FWindowOrg := AValue;
 
304
    FHasTransf := True;
 
305
  end;
 
306
end;
 
307
 
269
308
procedure TGtkDeviceContext.SetSelectedColors(AValue: TDevContextSelectedColorsType);
270
309
begin
271
310
  if FSelectedColors = AValue then Exit;
280
319
 
281
320
procedure TGtkDeviceContext.SetTextMetricsValid(AValid: Boolean);
282
321
begin
283
 
  if AValid
284
 
  then Include(FFlags, dcfTextMetricsValid)
285
 
  else Exclude(FFlags, dcfTextMetricsValid);
 
322
  if AValid then
 
323
    Include(FFlags, dcfTextMetricsValid)
 
324
  else
 
325
    Exclude(FFlags, dcfTextMetricsValid);
286
326
end;
287
327
 
288
328
procedure TGtkDeviceContext.InvTransfPoint(var X1, Y1: Integer);
289
329
begin
290
 
  X1 := MulDiv(X1 - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
291
 
  Y1 := MulDiv(Y1 - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
 
330
  X1 := MulDiv(X1 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
 
331
  Y1 := MulDiv(Y1 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
292
332
  // to do: put affine inverse transformation here (for all Inv.. methods)
293
333
end;
294
334
 
295
335
function TGtkDeviceContext.InvTransfPointIndirect(const P: TPoint): TPoint;
296
336
begin
297
 
  Result.X := MulDiv(P.X - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
298
 
  Result.Y := MulDiv(P.Y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
 
337
  Result.X := MulDiv(P.X + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
 
338
  Result.Y := MulDiv(P.Y + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
299
339
end;
300
340
 
301
341
procedure TGtkDeviceContext.InvTransfRect(var X1, Y1, X2, Y2: Integer);
302
342
begin
303
 
  X1 := MulDiv(X1 - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
304
 
  Y1 := MulDiv(Y1 - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
305
 
  X2 := MulDiv(X2 - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
306
 
  Y2 := MulDiv(Y2 - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
 
343
  X1 := MulDiv(X1 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
 
344
  Y1 := MulDiv(Y1 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
 
345
  X2 := MulDiv(X2 + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
 
346
  Y2 := MulDiv(Y2 + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
307
347
end;
308
348
 
309
349
function TGtkDeviceContext.InvTransfRectIndirect(const R: TRect): TRect;
310
350
begin
311
 
  Result.Left := MulDiv(R.Left - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
312
 
  Result.Top := MulDiv(R.Top - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
313
 
  Result.Right := MulDiv(R.Right - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
314
 
  Result.Bottom := MulDiv(R.Bottom - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
 
351
  Result.Left := MulDiv(R.Left + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
 
352
  Result.Top := MulDiv(R.Top + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
 
353
  Result.Right := MulDiv(R.Right + FWindowOrg.x - FViewPortOrg.x, FWindowExt.x, FViewPortExt.x);
 
354
  Result.Bottom := MulDiv(R.Bottom + FWindowOrg.y - FViewPortOrg.y, FWindowExt.y, FViewPortExt.y);
315
355
end;
316
356
 
317
357
procedure TGtkDeviceContext.InvTransfExtent(var ExtX, ExtY: Integer);
357
397
procedure TGtkDeviceContext.TransfPoint(var X1, Y1: Integer);
358
398
begin
359
399
  // to do: put affine transformation here (for all Transf.. methods)
360
 
  X1 := MulDiv(X1, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x;
361
 
  Y1 := MulDiv(Y1, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y;
 
400
  X1 := MulDiv(X1, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
 
401
  Y1 := MulDiv(Y1, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
362
402
end;
363
403
 
364
404
function TGtkDeviceContext.TransfPointIndirect(const P: TPoint): TPoint;
365
405
begin
366
 
  Result.x := MulDiv(P.x, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x;
367
 
  Result.Y := MulDiv(P.y, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y;
 
406
  Result.x := MulDiv(P.x, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
 
407
  Result.Y := MulDiv(P.y, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
368
408
end;
369
409
 
370
410
procedure TGtkDeviceContext.TransfRect(var X1, Y1, X2, Y2: Integer);
371
411
begin
372
 
  X1 := MulDiv(X1, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x;
373
 
  Y1 := MulDiv(Y1, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y;
374
 
  X2 := MulDiv(X2, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x;
375
 
  Y2 := MulDiv(Y2, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y;
 
412
  X1 := MulDiv(X1, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
 
413
  Y1 := MulDiv(Y1, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
 
414
  X2 := MulDiv(X2, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
 
415
  Y2 := MulDiv(Y2, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
376
416
end;
377
417
 
378
418
function TGtkDeviceContext.TransfRectIndirect(const R: TRect): TRect;
379
419
begin
380
 
  Result.Left := MulDiv(R.Left, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x;
381
 
  Result.Top := MulDiv(R.Top, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y;
382
 
  Result.Right := MulDiv(R.Right, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x;
383
 
  Result.Bottom := MulDiv(R.Bottom, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y;
 
420
  Result.Left := MulDiv(R.Left, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
 
421
  Result.Top := MulDiv(R.Top, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
 
422
  Result.Right := MulDiv(R.Right, FViewPortExt.x, FWindowExt.x) + FViewPortOrg.x - FWindowOrg.x;
 
423
  Result.Bottom := MulDiv(R.Bottom, FViewPortExt.y, FWindowExt.y) + FViewPortOrg.y - FWindowOrg.y;
384
424
end;
385
425
 
386
426
procedure TGtkDeviceContext.TransfExtent(var ExtX, ExtY: Integer);
414
454
      if FCurrentFont^.LogFont.lfHeight > 0 then
415
455
        AHeight := 1
416
456
      else
417
 
        AHeight := -1;
 
457
      if FCurrentFont^.LogFont.lfHeight < 0 then
 
458
        AHeight := -1
 
459
      else
 
460
        AHeight := 0;
418
461
    if FCurrentFont^.LogFont.lfHeight <> AHeight then
419
462
    begin
420
463
      FontCache.Unreference(FCurrentFont^.GDIFontObject);
421
464
      FCurrentFont^.LogFont.lfHeight := AHeight;
422
 
      TmpObj := PGdiObject(PtrUInt(GTK2WidgetSet.CreateFontIndirect(FCurrentFont^.LogFont)));
 
465
      TmpObj := {%H-}PGdiObject(PtrUInt(GTK2WidgetSet.CreateFontIndirect(FCurrentFont^.LogFont)));
423
466
      FCurrentFont^.GDIFontObject := TmpObj^.GDIFontObject;
424
467
      TmpObj^.GDIFontObject := nil;
 
468
      TmpObj^.RefCount := 0;
425
469
      GTK2WidgetSet.DisposeGDIObject(TmpObj);
426
470
    end;
427
471
  end;
471
515
 
472
516
var
473
517
  ClientWidget: PGtkWidget;
 
518
  W: PGtkWidget;
474
519
begin
475
 
  if FWidget <> nil
476
 
  then RaiseWidgetAlreadySet;
 
520
  if FWidget <> nil then
 
521
    RaiseWidgetAlreadySet;
477
522
 
478
523
  FWithChildWindows := AWithChildWindows;
479
524
  FWidget := AWidget;
480
525
 
481
 
  if AWidget = nil
482
 
  then begin
 
526
  if AWidget = nil then
 
527
  begin
483
528
    // screen: ToDo: multiple desktops
484
529
    FDrawable := gdk_screen_get_root_window(gdk_screen_get_default);
485
 
  end
486
 
  else begin
487
 
    if ADoubleBuffer <> nil
488
 
    then begin
 
530
  end else
 
531
  begin
 
532
    if ADoubleBuffer <> nil then
 
533
    begin
489
534
      Include(FFlags, dcfDoubleBuffer);
490
535
      FOriginalDrawable := AWindow;
491
536
      FDrawable := ADoubleBuffer;
492
 
    end
493
 
    else begin
 
537
    end else
 
538
    begin
494
539
      // create a new devicecontext for this window
495
540
      Exclude(FFlags, dcfDoubleBuffer);
496
541
 
497
 
      if AWindow = nil
498
 
      then begin
 
542
      if AWindow = nil then
 
543
      begin
499
544
        ClientWidget := GetFixedWidget(AWidget);
500
545
        if ClientWidget = nil then RaiseWidgetWithoutClientArea;
501
546
 
502
547
        AWindow := GetControlWindow(ClientWidget);
503
 
        if AWindow = nil
504
 
        then begin
505
 
          //force creation
506
 
          gtk_widget_realize(ClientWidget);
 
548
        if AWindow = nil then
 
549
        begin
 
550
          W := gtk_widget_get_parent(AWidget);
 
551
          //we are forcing window creation but not for GtkNotebook
 
552
          //see issue #18754 and #20126
 
553
          //Zeljko:This part should be NOT BE REMOVED since TToolbar, TFrame
 
554
          //TGroupBox etc...depend on this. eg.TToolbar will lock
 
555
          //mouse without realizing clientWidget.Also if THintWindow is
 
556
          //visible it crashes sometimes. SO JUST NOTEBOOK !
 
557
          if (W <> nil) and not GTK_IS_NOTEBOOK(W) then
 
558
            gtk_widget_realize(ClientWidget);
 
559
 
507
560
          AWindow := GetControlWindow(ClientWidget);
508
561
          // Don't raise an exception. Not all operations needs drawable. For example font metrics:
509
562
          // http://bugs.freepascal.org/view.php?id=14035
510
563
          //if AWindow = nil then RaiseUnableToRealize;
511
564
        end;
512
 
      end
513
 
      else begin
 
565
      end else
 
566
      begin
514
567
        ClientWidget := AWidget;
515
568
      end;
516
569
 
517
 
      FSpecialOrigin := GtkWidgetIsA(ClientWidget, GTK_LAYOUT_GET_TYPE);
518
570
      FDrawable := AWindow;
519
571
      // GC is created on demand
520
572
    end;
545
597
  FViewPortExt := Point(1, 1);
546
598
  FViewPortOrg := Point(0, 0);
547
599
  FWindowExt := Point(1, 1);
 
600
  FWindowOrg := Point(0, 0);
548
601
  FMapMode := MM_TEXT;
549
602
  if FHasTransf then
550
603
  begin
553
606
    TransfUpdatePen;
554
607
  end;
555
608
 
556
 
  FOrigin.X := 0;
557
 
  FOrigin.Y := 0;
558
 
  FSpecialOrigin := False;
559
 
  PenPos.X:=0;
560
 
  PenPos.Y:=0;
 
609
  PenPos := Point(0, 0);
561
610
 
562
611
  CurrentBitmap:=nil;
563
612
  CurrentFont:=nil;
603
652
  g: TGDIType;
604
653
  CurGDIObject: PGDIObject;
605
654
begin
606
 
  Result := (Self <> nil) and (ASource <> nil);
 
655
  Result := Assigned(Self) and Assigned(ASource);
607
656
  if not Result then Exit;
608
657
 
609
 
  if ARestore
610
 
  then begin
611
 
    if FWidget <> ASource.FWidget
612
 
    then RaiseRestoreDifferentWidget;
613
 
  end
614
 
  else begin
615
 
    if FWidget <> nil
616
 
    then RaiseWidgetAlreadySet;
 
658
  if ARestore then
 
659
  begin
 
660
    if FWidget <> ASource.FWidget then
 
661
      RaiseRestoreDifferentWidget;
 
662
  end else
 
663
  begin
 
664
    if Assigned(FWidget) then
 
665
      RaiseWidgetAlreadySet;
617
666
    FWidget := ASource.FWidget;
618
667
  end;
619
668
 
621
670
  FDrawable := ASource.FDrawable;
622
671
  FOriginalDrawable := ASource.FOriginalDrawable;
623
672
 
624
 
  if FGC <> nil
625
 
  then begin
 
673
  if Assigned(FGC) then
 
674
  begin
626
675
    // free old GC
627
676
    gdk_gc_unref(FGC);
628
677
    FGC := nil;
629
678
    Exclude(FFlags, dcfPenSelected);
630
679
  end;
631
680
 
632
 
  if (ASource.FGC <> nil) and (FDrawable <> nil)
633
 
  then begin
 
681
  if Assigned(ASource.FGC) and Assigned(FDrawable) then
 
682
  begin
634
683
    gdk_gc_get_values(ASource.FGC, @FGCValues);
635
684
    FGC := gdk_gc_new_with_values(FDrawable, @FGCValues,
636
685
      GDK_GC_FOREGROUND or GDK_GC_BACKGROUND or GDK_GC_SUBWINDOW);
637
686
    Exclude(FFlags, dcfPenSelected);
638
687
  end;
639
688
 
640
 
  FOrigin := ASource.FOrigin;
641
 
  FSpecialOrigin := ASource.FSpecialOrigin;
642
 
  PenPos := ASource.PenPos;
643
 
 
644
 
  if dcfTextMetricsValid in ASource.Flags
645
 
  then begin
 
689
  if dcfTextMetricsValid in ASource.Flags then
 
690
  begin
646
691
    Include(FFlags, dcfTextMetricsValid);
647
692
    DCTextMetric := ASource.DCTextMetric;
648
693
  end
649
694
  else
650
695
    Exclude(FFlags, dcfTextMetricsValid);
651
696
 
652
 
  for g:=Low(TGDIType) to High(TGDIType) do
 
697
  for g := Low(TGDIType) to High(TGDIType) do
653
698
  begin
654
699
    GDIObjects[g] := ASource.GDIObjects[g];
655
700
    if AClearSource then
656
701
      ASource.GDIObjects[g] := nil;
657
702
 
658
 
    if AMoveGDIOwnerShip
659
 
    then begin
660
 
      if OwnedGDIObjects[g]<>nil
661
 
      then begin
662
 
        DeleteObject(HGDIOBJ(PtrUInt(OwnedGDIObjects[g])));
663
 
      end;
 
703
    if AMoveGDIOwnerShip then
 
704
    begin
 
705
      if Assigned(OwnedGDIObjects[g]) then
 
706
        DeleteObject(HGDIOBJ({%H-}PtrUInt(OwnedGDIObjects[g])));
664
707
 
665
708
      CurGDIObject := ASource.OwnedGDIObjects[g];
666
709
 
667
 
      if CurGDIObject<>nil
668
 
      then begin
 
710
      if Assigned(CurGDIObject) then
 
711
      begin
669
712
        ASource.OwnedGDIObjects[g] := nil;
670
713
        OwnedGDIObjects[g] := CurGDIObject;
671
714
      end;
675
718
  CopyGDIColor(ASource.CurrentBackColor, CurrentBackColor);
676
719
 
677
720
  SelectedColors := dcscCustom;
 
721
  PenPos := ASource.PenPos;
678
722
 
679
723
  if FHasTransf then
680
724
  begin
683
727
    FViewPortExt := Point(1, 1);
684
728
    FViewPortOrg := Point(0, 0);
685
729
    FWindowExt := Point(1, 1);
 
730
    FWindowOrg := Point(0, 0);
686
731
    TransfUpdateFont;
687
732
    TransfUpdatePen;
688
733
  end;
694
739
    FViewPortExt := ASource.ViewPortExt;
695
740
    FViewPortOrg := ASource.ViewPortOrg;
696
741
    FWindowExt := ASource.WindowExt;
 
742
    FWindowOrg := ASource.WindowOrg;
697
743
    TransfUpdateFont;
698
744
    TransfUpdatePen;
699
745
  end;
707
753
  OldCurrentBrush: PGdiObject;
708
754
  DCOrigin: TPoint;
709
755
  BrushChanged: Boolean;
 
756
  ClipArea: TGdkRectangle;
710
757
begin
711
758
  BrushChanged := False;
712
759
  if not IsNullBrush then
723
770
 
724
771
    // Temporary hold the old brush to replace it with the given brush
725
772
    OldCurrentBrush := GetBrush;
726
 
    if not CompareGDIBrushes(PGdiObject(ABrush), OldCurrentBrush) then
 
773
    if not CompareGDIBrushes({%H-}PGdiObject(ABrush), OldCurrentBrush) then
727
774
    begin
728
775
      BrushChanged := True;
729
 
      CurrentBrush := PGdiObject(ABrush);
 
776
      CurrentBrush := {%H-}PGdiObject(ABrush);
730
777
      SelectedColors := dcscCustom;
731
778
    end;
732
779
 
735
782
      gdk_gc_set_function(GC, GDK_COPY);
736
783
 
737
784
    DCOrigin := Offset;
 
785
    ClipArea := ClipRect;
738
786
    if (CurrentBrush^.GDIBrushFill = GDK_SOLID) and
739
787
       (IsBackgroundColor(CurrentBrush^.GDIBrushColor.ColorRef)) then
740
788
      StyleFillRectangle(Drawable, GC,
741
789
                         CurrentBrush^.GDIBrushColor.ColorRef,
742
790
                         ARect.Left + DCOrigin.X, ARect.Top + DCOrigin.Y,
743
 
                         Width, Height)
 
791
                         Width, Height, @ClipArea)
744
792
    else
745
793
      gdk_draw_rectangle(Drawable, GC, 1,
746
794
                         ARect.Left + DCOrigin.X, ARect.Top + DCOrigin.Y,
775
823
  if FCurrentFont <> nil then exit;
776
824
 
777
825
  // create font
778
 
  if FWidget <> nil
779
 
  then begin
 
826
  if FWidget <> nil then
 
827
  begin
780
828
    ClientWidget := GetFixedWidget(FWidget);
781
829
 
782
830
    NewFont := Gtk2Widgetset.NewGDIObject(gdiFont);
812
860
begin
813
861
  // create GC
814
862
 
815
 
  if Drawable <> nil
816
 
  then begin
817
 
    if FWithChildWindows
818
 
    then begin
 
863
  if Drawable <> nil then
 
864
  begin
 
865
    if FWithChildWindows then
 
866
    begin
819
867
      FillChar(FGCValues, SizeOf(FGCValues), 0);
820
868
      FGCValues.subwindow_mode := GDK_INCLUDE_INFERIORS;
821
869
      Result := gdk_gc_new_with_values(Drawable, @FGCValues, GDK_GC_FUNCTION or GDK_GC_SUBWINDOW);
822
 
    end
823
 
    else begin
 
870
    end else
 
871
    begin
824
872
      Result := gdk_gc_new(Drawable);
825
873
    end;
826
 
  end
827
 
  else begin
 
874
  end else
 
875
  begin
828
876
    // create default GC
829
877
    Result := gdk_gc_new(gdk_screen_get_root_window(gdk_screen_get_default));
830
878
  end;
863
911
 
864
912
function TGtkDeviceContext.GetGC: pgdkGC;
865
913
begin
866
 
  if FGC = nil
867
 
  then FGC := CreateGC;
 
914
  if FGC = nil then
 
915
    FGC := CreateGC;
868
916
  Result := FGC;
869
917
end;
870
918
 
871
919
function TGtkDeviceContext.GetFont: PGdiObject;
872
920
begin
873
 
  if FCurrentFont = nil
874
 
  then CreateFont;
 
921
  if FCurrentFont = nil then
 
922
    CreateFont;
875
923
 
876
924
  Result := FCurrentFont;
877
925
end;
878
926
 
879
927
function TGtkDeviceContext.GetBrush: PGdiObject;
880
928
begin
881
 
  if FCurrentBrush = nil
882
 
  then CreateBrush;
 
929
  if FCurrentBrush = nil then
 
930
    CreateBrush;
883
931
 
884
932
  Result := FCurrentBrush;
885
933
end;
886
934
 
887
935
function TGtkDeviceContext.GetPen: PGdiObject;
888
936
begin
889
 
  if FCurrentPen = nil
890
 
  then CreatePen;
 
937
  if FCurrentPen = nil then
 
938
    CreatePen;
891
939
 
892
940
  Result := FCurrentPen;
893
941
end;
979
1027
  // no drawable: this is normal, when restoring the default bitmap (FreeDC)
980
1028
  if NewDrawable = nil then Exit;
981
1029
 
982
 
  if FGC <> nil
983
 
  then gdk_gc_unref(FGC);
 
1030
  if FGC <> nil then
 
1031
    gdk_gc_unref(FGC);
984
1032
  FDrawable := NewDrawable;
985
1033
  FGC := gdk_gc_new(FDrawable);
986
1034
  gdk_gc_set_function(FGC, GDK_COPY);
1022
1070
    gdiPen:    Result := SelectPen(AGdiObject);
1023
1071
  else
1024
1072
    // we only handle bitmaps here atm
1025
 
    Result := PGdiObject(GTK2WidgetSet.SelectObject(HDC(Self), HGDIOBJ(AGdiObject)));
 
1073
    Result := {%H-}PGdiObject(GTK2WidgetSet.SelectObject(HDC(Self), {%H-}HGDIOBJ(AGdiObject)));
1026
1074
  end;
1027
1075
end;
1028
1076
 
1033
1081
 
1034
1082
  CurrentPen := AGDIObject;
1035
1083
  Exclude(FFlags, dcfPenSelected);
1036
 
  if FGC <> nil
1037
 
  then SelectPenProps;
 
1084
  if FGC <> nil then
 
1085
    SelectPenProps;
1038
1086
  SelectedColors := dcscCustom;
1039
1087
end;
1040
1088
 
1041
1089
constructor TGtkDeviceContext.Create;
1042
1090
begin
 
1091
  Clear;
1043
1092
  BkMode := OPAQUE;
1044
1093
end;
1045
1094
 
1169
1218
  gdk_gc_set_clip_region(FGC,  nil);
1170
1219
  gdk_gc_set_clip_rectangle(FGC,  nil);
1171
1220
 
1172
 
  if ClipRegion <> nil
1173
 
  then begin
 
1221
  if ClipRegion <> nil then
 
1222
  begin
1174
1223
    RGNType := RegionType(ClipRegion^.GDIRegionObject);
1175
 
    if (RGNType <> ERROR) and (RGNType <> NULLREGION)
1176
 
    then gdk_gc_set_clip_region(FGC,  ClipRegion^.GDIRegionObject);
 
1224
    if (RGNType <> ERROR) and (RGNType <> NULLREGION) then
 
1225
      gdk_gc_set_clip_region(FGC,  ClipRegion^.GDIRegionObject);
1177
1226
  end;
1178
1227
 
1179
1228
  {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
1194
1243
 
1195
1244
function TGtkDeviceContext.GetBitmap: PGdiObject;
1196
1245
begin
1197
 
  if FCurrentBitmap = nil
1198
 
  then CreateBitmap;
 
1246
  if FCurrentBitmap = nil then
 
1247
    CreateBitmap;
1199
1248
 
1200
1249
  Result := FCurrentBitmap;
1201
1250
end;
1202
1251
 
 
1252
function TGtkDeviceContext.GetFunction: TGdkFunction;
 
1253
begin
 
1254
  Result := GCValues._function;
 
1255
end;
 
1256
 
1203
1257
 
1204
1258
procedure SetLayoutText(ALayout: PPangoLayout; AText: PChar; ALength: PtrInt);
1205
1259
var
1206
1260
  OldStr: PChar;
1207
1261
begin
1208
1262
  OldStr := pango_layout_get_text(ALayout);
1209
 
  if (strlcomp(AText, OldStr, ALength) <> 0) or (strlen(OldStr)<>ALength) then
 
1263
  if (strlen(OldStr)<>ALength) or (strlcomp(AText, OldStr, ALength) <> 0) then
1210
1264
    pango_layout_set_text(ALayout, AText, ALength);
1211
1265
end;
1212
1266
 
1213
 
{ TGtk2DeviceContext }
1214
 
 
1215
 
function TGtk2DeviceContext.GetFunction: TGdkFunction;
1216
 
begin
1217
 
  Result := GCValues._function;
1218
 
end;
1219
 
 
1220
 
procedure TGtk2DeviceContext.DrawTextWithColors(AText: PChar; ALength: LongInt;
 
1267
procedure TGtkDeviceContext.DrawTextWithColors(AText: PChar; ALength: LongInt;
1221
1268
  X, Y: Integer; FGColor, BGColor: PGdkColor);
1222
1269
var
1223
1270
  WidgetCont: PPangoContext;