← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/interfaces/gtk2/gtk2wsprivate.pp

  • 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/gtk2wsprivate.pp
1
 
{ $Id: gtk2wsprivate.pp 29456 2011-02-10 22:22:30Z vincents $ }
 
1
{ $Id: gtk2wsprivate.pp 36862 2012-04-17 07:55:52Z zeljko $ }
2
2
{
3
3
                 ------------------------------------------
4
4
                 gtk2wsprivate.pp  -  Gtk2 internal classes
5
5
                 ------------------------------------------
6
6
 
7
7
 @created(Thu Feb 1st WET 2007)
8
 
 @lastmod($Date: 2011-02-10 22:22:30 +0000 (Thu, 10 Feb 2011) $)
 
8
 @lastmod($Date: 2012-04-17 09:55:52 +0200 (Tue, 17 Apr 2012) $)
9
9
 @author(Marc Weustink <marc@@lazarus.dommelstein.net>)
10
10
 
11
11
 This unit contains the private classhierarchy for the gtk implemetations
60
60
  public
61
61
    class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
62
62
    class procedure UpdateCursor(AInfo: PWidgetInfo); virtual;
63
 
    class procedure SetDefaultCursor(AInfo: PWidgetInfo); virtual;
64
63
  end;
65
64
  TGtkPrivateWidgetClass = class of TGtkPrivateWidget;
66
65
 
71
70
  private
72
71
  protected
73
72
  public
74
 
    class procedure SetDefaultCursor(AInfo: PWidgetInfo); override;
75
73
  end;
76
74
 
77
75
 
147
145
  private
148
146
  protected
149
147
  public
150
 
    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
 
148
    class procedure SetCallbacks(const {%H-}AGtkWidget: PGtkWidget; const {%H-}AWidgetInfo: PWidgetInfo); virtual;
151
149
  end;
152
150
 
153
151
  { TGtkPrivateNotebook }
259
257
 
260
258
 
261
259
function GetWidgetWithWindow(const AHandle: THandle): PGtkWidget;
262
 
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor; ARecursive: Boolean);
263
 
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo);
 
260
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor;
 
261
  ARecursive: Boolean; ASetDefault: Boolean);
 
262
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo;
 
263
  ASetDefault: Boolean);
 
264
procedure SetGlobalCursor(Cursor: HCURSOR);
264
265
 
265
266
implementation
266
267
 
 
268
uses
 
269
  Gtk2Extra;
 
270
 
267
271
{$I Gtk2PrivateWidget.inc}
268
272
{$I Gtk2PrivateList.inc}
269
273
 
279
283
  if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
280
284
  then Exit;
281
285
 
282
 
  ScrollWidget := Pointer(AWinControl.Handle);
 
286
  ScrollWidget := {%H-}Pointer(AWinControl.Handle);
283
287
//  WidgetInfo := GetWidgetInfo(ScrollWidget);
284
288
  // Some controls have viewports, so we get the first window.
285
289
  Widget := GetWidgetWithWindow(AWinControl.Handle);
321
325
  //      code can be removed and a call to TGtkWSBaseScrollingWinControl.SetZPosition
322
326
  //      can be made. This is not possible now since we have a frame around us
323
327
 
324
 
  Widget := Pointer(AWinControl.Handle);
 
328
  Widget := {%H-}Pointer(AWinControl.Handle);
325
329
  //  WidgetInfo := GetWidgetInfo(Widget);
326
330
 
327
331
  // Only do the scrollbars, leave the core to the default (we might have a viewport)
371
375
 
372
376
{------------------------------------------------------------------------------
373
377
  procedure: SetWindowCursor
 
378
  Params:  AWindow : PGDkWindow, ACursor: PGdkCursor, ASetDefault: Boolean
 
379
  Returns: Nothing
 
380
 
 
381
  Sets the cursor for a window.
 
382
  Tries to avoid messing with the cursors of implicitly created
 
383
  child windows (e.g. headers in TListView) with the following logic:
 
384
  - If Cursor <> nil, saves the old cursor (if not already done or ASetDefault = true)
 
385
    before setting the new one.
 
386
  - If Cursor = nil, restores the old cursor (if not already done).
 
387
 
 
388
  Unfortunately gdk_window_get_cursor is only available from
 
389
  version 2.18, so it needs to be retrieved dynamically.
 
390
  If gdk_window_get_cursor is not available, the cursor is set
 
391
  according to LCL widget data.
 
392
  ------------------------------------------------------------------------------}
 
393
procedure SetWindowCursor(AWindow: PGdkWindow; Cursor: PGdkCursor; ASetDefault: Boolean);
 
394
var
 
395
  OldCursor: PGdkCursor;
 
396
  Data: gpointer;
 
397
  Info: PWidgetInfo;
 
398
begin
 
399
  Info := nil;
 
400
  gdk_window_get_user_data(AWindow, @Data);
 
401
  if (Data <> nil) and GTK_IS_WIDGET(Data) then
 
402
  begin
 
403
    Info := GetWidgetInfo(PGtkWidget(Data), False);
 
404
  end;
 
405
  if not Assigned(gdk_window_get_cursor) and (Info = nil)
 
406
  then Exit;
 
407
  if ASetDefault then //and ((Cursor <> nil) or ( <> nil)) then
 
408
  begin
 
409
    // Override any old default cursor
 
410
    g_object_steal_data(PGObject(AWindow), 'havesavedcursor'); // OK?
 
411
    g_object_steal_data(PGObject(AWindow), 'savedcursor');
 
412
    gdk_window_set_cursor(AWindow, Cursor);
 
413
    Exit;
 
414
  end;
 
415
  if Cursor <> nil then
 
416
  begin
 
417
    if Assigned(gdk_window_get_cursor)
 
418
    then OldCursor := gdk_window_get_cursor(AWindow)
 
419
    else OldCursor := {%H-}PGdkCursor(Info^.ControlCursor);
 
420
    // As OldCursor can be nil, use a separate key to indicate whether it
 
421
    // is stored.
 
422
    if ASetDefault or (g_object_get_data(PGObject(AWindow), 'havesavedcursor') = nil) then
 
423
    begin
 
424
      g_object_set_data(PGObject(AWindow), 'havesavedcursor', gpointer(1));
 
425
      g_object_set_data(PGObject(AWindow), 'savedcursor', gpointer(OldCursor));
 
426
    end;
 
427
    gdk_pointer_grab(AWindow, False, 0, AWindow, Cursor, 1);
 
428
    try
 
429
      gdk_window_set_cursor(AWindow, Cursor);
 
430
    finally
 
431
      gdk_pointer_ungrab(0);
 
432
    end;
 
433
  end else
 
434
  begin
 
435
    if g_object_steal_data(PGObject(AWindow), 'havesavedcursor') <> nil then
 
436
    begin
 
437
      Cursor := g_object_steal_data(PGObject(AWindow), 'savedcursor');
 
438
      gdk_window_set_cursor(AWindow, Cursor);
 
439
    end;
 
440
  end;
 
441
end;
 
442
 
 
443
{------------------------------------------------------------------------------
 
444
  procedure: SetWindowCursor
374
445
  Params:  AWindow : PGDkWindow, ACursor: HCursor, ARecursive: Boolean
375
446
  Returns: Nothing
376
447
 
377
448
  Sets the cursor for a window (or recursively for window with children)
378
449
 ------------------------------------------------------------------------------}
379
 
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor; ARecursive: Boolean);
 
450
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor;
 
451
  ARecursive: Boolean; ASetDefault: Boolean);
380
452
var
381
453
  Cursor: PGdkCursor;
382
454
 
384
456
  var
385
457
    ChildWindows, ListEntry: PGList;
386
458
  begin
387
 
    gdk_window_set_cursor(AWindow, Cursor);
 
459
    SetWindowCursor(AWindow, Cursor, ASetDefault);
388
460
 
389
461
    ChildWindows := gdk_window_get_children(AWindow);
390
462
 
397
469
    g_list_free(ChildWindows);
398
470
  end;
399
471
begin
400
 
  Cursor := PGdkCursor(ACursor);
401
 
  if Cursor = nil then Exit;
 
472
  Cursor := {%H-}PGdkCursor(ACursor);
402
473
  if ARecursive
403
474
  then SetCursorRecursive(AWindow)
404
 
  else gdk_window_set_cursor(AWindow, Cursor);
 
475
  else SetWindowCursor(AWindow, Cursor, ASetDefault);
405
476
end;
406
477
 
407
478
// Helper functions
410
481
var
411
482
  Children: PGList;
412
483
begin
413
 
  Result := PGTKWidget(PtrUInt(AHandle));
 
484
  Result := {%H-}PGTKWidget(PtrUInt(AHandle));
414
485
  while (Result <> nil) and GTK_WIDGET_NO_WINDOW(Result)
415
486
  and GtkWidgetIsA(Result,gtk_container_get_type) do
416
487
  begin
421
492
  end;
422
493
end;
423
494
 
424
 
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo);
 
495
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo;
 
496
  ASetDefault: Boolean);
425
497
var
426
498
  Cursor: PGdkCursor;
427
499
  Data: gpointer;
436
508
    begin
437
509
      Info := GetWidgetInfo(PGtkWidget(Data), False);
438
510
      if Info = AInfo then
439
 
        gdk_window_set_cursor(AWindow, Cursor);
 
511
        SetWindowCursor(AWindow, Cursor, ASetDefault);
440
512
    end;
441
513
 
442
514
    ChildWindows := gdk_window_get_children(AWindow);
451
523
  end;
452
524
begin
453
525
  if AInfo = nil then Exit;
454
 
  Cursor := PGdkCursor(AInfo^.ControlCursor);
455
 
  if Cursor = nil then Exit;
 
526
  Cursor := {%H-}PGdkCursor(AInfo^.ControlCursor);
456
527
  SetCursorRecursive(AWindow);
457
528
end;
458
529
 
 
530
{------------------------------------------------------------------------------
 
531
  procedure: SetGlobalCursor
 
532
  Params:  ACursor: HCursor
 
533
  Returns: Nothing
 
534
 
 
535
  Sets the cursor for all toplevel windows. Also sets the cursor for all child
 
536
  windows recursively provided gdk_get_window_cursor is available.
 
537
 ------------------------------------------------------------------------------}
 
538
procedure SetGlobalCursor(Cursor: HCURSOR);
 
539
var
 
540
  TopList, List: PGList;
 
541
begin
 
542
  TopList := gdk_window_get_toplevels;
 
543
  List := TopList;
 
544
  while List <> nil do
 
545
  begin
 
546
    if (List^.Data <> nil) then
 
547
      SetWindowCursor(PGDKWindow(List^.Data), Cursor,
 
548
        Assigned(gdk_window_get_cursor), False);
 
549
    list := g_list_next(list);
 
550
  end;
 
551
 
 
552
  if TopList <> nil then
 
553
    g_list_free(TopList);
 
554
end;
 
555
 
 
556
 
459
557
end.
460
558