← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/interfaces/gtk2/gtk2wsextctrls.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/gtk2wsextctrls.pp
1
 
{ $Id: gtk2wsextctrls.pp 29520 2011-02-13 12:57:08Z vincents $}
 
1
{ $Id: gtk2wsextctrls.pp 40391 2013-02-24 15:50:22Z martin $}
2
2
{
3
3
 *****************************************************************************
4
4
 *                             Gtk2WSExtCtrls.pp                             * 
23
23
unit Gtk2WSExtCtrls;
24
24
 
25
25
{$I gtk2defines.inc}
26
 
//{$define UseStatusIcon} // can be used only with fpc r13008
 
26
{$define UseStatusIcon} // can be used only with fpc r13008, from 2009
27
27
 
28
28
 
29
29
{$mode objfpc}{$H+}
32
32
 
33
33
uses
34
34
  // libs
35
 
  Math, GLib2, Gtk2, Gdk2, Gdk2Pixbuf, Gtk2Int, Gtk2Def, {$ifdef UseStatusIcon}Gtk2Ext, {$endif}
 
35
  GLib2, Gtk2, Gdk2, Gdk2Pixbuf, Gtk2Int, Gtk2Def,
 
36
  {$ifdef UseStatusIcon}Gtk2Ext, {$endif}
36
37
  // LCL
37
 
  LCLProc, ExtCtrls, Classes, Controls, SysUtils, Graphics, LCLType, LMessages,
 
38
  LCLProc, ExtCtrls, Classes, Controls, SysUtils, types, Graphics, LCLType,
38
39
  // widgetset
39
 
  WSExtCtrls, WSLCLClasses, WSProc,
40
 
  Gtk2WSControls, Gtk2WSPrivate, Gtk2Proc, Gtk2Globals;
 
40
  WSExtCtrls, WSLCLClasses,
 
41
  Gtk2WSControls, Gtk2Proc, Gtk2Globals;
41
42
 
42
43
type
43
44
 
44
 
  { TGtk2WSCustomPage }
45
 
 
46
 
  TGtk2WSCustomPage = class(TWSCustomPage)
47
 
  protected
48
 
    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
49
 
  published
50
 
    class function  CreateHandle(const AWinControl: TWinControl;
51
 
      const AParams: TCreateParams): TLCLIntfHandle; override;
52
 
    class procedure UpdateProperties(const ACustomPage: TCustomPage); override;
53
 
    class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
54
 
    class procedure ShowHide(const AWinControl: TWinControl); override;
55
 
    class function GetDefaultClientRect(const AWinControl: TWinControl;
56
 
             const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect
57
 
             ): boolean; override;
58
 
  end;
59
 
 
60
 
  { TGtk2WSCustomNotebook }
61
 
  
62
 
  TGtk2WSCustomNotebook = class(TWSCustomNotebook)
63
 
  protected
64
 
    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
65
 
  published
66
 
    class function CreateHandle(const AWinControl: TWinControl;
67
 
                                const AParams: TCreateParams): HWND; override;
68
 
    class function GetDefaultClientRect(const AWinControl: TWinControl;
69
 
             const aLeft, aTop, aWidth, aHeight: integer; var aClientRect: TRect
70
 
             ): boolean; override;
71
 
    class procedure AddPage(const ANotebook: TCustomNotebook;
72
 
      const AChild: TCustomPage; const AIndex: integer); override;
73
 
    class procedure MovePage(const ANotebook: TCustomNotebook;
74
 
      const AChild: TCustomPage; const NewIndex: integer); override;
75
 
    class procedure RemovePage(const ANotebook: TCustomNotebook;
76
 
      const AIndex: integer); override;
77
 
 
78
 
    class function GetCapabilities: TNoteBookCapabilities; override;
79
 
    class function GetNotebookMinTabHeight(const AWinControl: TWinControl): integer; override;
80
 
    class function GetNotebookMinTabWidth(const AWinControl: TWinControl): integer; override;
81
 
    class function GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): integer; override;
82
 
    class function GetTabRect(const ANotebook: TCustomNotebook; const AIndex: Integer): TRect; override;
83
 
    class procedure SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer); override;
84
 
    class procedure SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); override;
85
 
    class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); override;
86
 
    class procedure UpdateProperties(const ANotebook: TCustomNotebook); override;
87
 
  end;
88
 
 
89
45
  { TGtk2WSPage }
90
46
 
91
47
  TGtk2WSPage = class(TWSPage)
214
170
 
215
171
uses
216
172
{$ifdef HasX}
217
 
  x, xlib, xutil,
 
173
  x, xlib,
218
174
{$endif}
219
175
//  gtk2, gdk2, glib2, gtk2def, gtk2proc,
220
176
{$ifdef HasGdk2X}
222
178
{$endif}
223
179
  interfacebase;
224
180
 
225
 
const
226
 
  GtkPositionTypeMap: array[TTabPosition] of TGtkPositionType =
227
 
  (
228
 
{ tpTop    } GTK_POS_TOP,
229
 
{ tpBottom } GTK_POS_BOTTOM,
230
 
{ tpLeft   } GTK_POS_LEFT,
231
 
{ tpRight  } GTK_POS_RIGHT
232
 
  );
233
 
 
234
 
  LCL_NotebookManualPageSwitchKey = 'lcl_manual_page_switch';
235
 
 
236
 
 
237
 
type
238
 
  GtkNotebookPressEventProc = function (widget:PGtkWidget; event:PGdkEventButton):gboolean; cdecl;
239
 
  
240
 
var
241
 
  OldNoteBookButtonPress: GtkNotebookPressEventProc = nil;
242
 
 
243
 
// this was created as a workaround of a tnotebook eating rightclick of custom controls
244
 
function Notebook_Button_Press(widget:PGtkWidget; event:PGdkEventButton):gboolean; cdecl;
245
 
begin
246
 
  Result := True;
247
 
  if gtk_get_event_widget(PGdkEvent(event)) <> widget then exit;
248
 
  if OldNoteBookButtonPress = nil then exit;
249
 
  Result := OldNoteBookButtonPress(widget, event);
250
 
end;
251
 
 
252
 
procedure HookNoteBookClass;
253
 
var
254
 
  WidgetClass: PGtkWidgetClass;
255
 
begin
256
 
  WidgetClass := GTK_WIDGET_CLASS(gtk_type_class(gtk_notebook_get_type));
257
 
 
258
 
  OldNoteBookButtonPress := GtkNotebookPressEventProc(WidgetClass^.button_press_event);
259
 
  WidgetClass^.button_press_event := @Notebook_Button_Press;
260
 
end;
261
 
 
262
 
{ TGtk2WSCustomNotebook }
263
 
 
264
 
 
265
 
function NotebookPageRealToLCLIndex(const ANotebook: TCustomNotebook; AIndex: integer): integer;
266
 
var
267
 
  I: Integer;
268
 
begin
269
 
  Result := AIndex;
270
 
  if csDesigning in ANotebook.ComponentState then exit;
271
 
  I := 0;
272
 
  while (I < ANotebook.PageCount) and (I <= Result) do
273
 
  begin
274
 
    if not ANotebook.Page[I].TabVisible then Inc(Result);
275
 
    Inc(I);
276
 
  end;
277
 
end;
278
 
 
279
 
 
280
 
function GtkWSNotebook_SwitchPage(widget: PGtkWidget; page: Pgtkwidget; pagenum: integer; data: gPointer): GBoolean; cdecl;
281
 
var
282
 
  Mess: TLMNotify;
283
 
  NMHdr: tagNMHDR;
284
 
  IsManual: Boolean;
285
 
begin
286
 
  Result := CallBackDefaultReturn;
287
 
  EventTrace('switch-page', data);
288
 
  UpdateNoteBookClientWidget(TObject(Data));
289
 
 
290
 
  // remove flag
291
 
  IsManual := gtk_object_get_data(PGtkObject(Widget), LCL_NotebookManualPageSwitchKey) <> nil;
292
 
  if IsManual then
293
 
    gtk_object_set_data(PGtkObject(Widget), LCL_NotebookManualPageSwitchKey, nil);
294
 
  if PGtkNotebook(Widget)^.cur_page = nil then // for windows compatibility
295
 
    Exit;
296
 
 
297
 
  // gtkswitchpage is called before the switch
298
 
  if not IsManual then
299
 
  begin
300
 
    // send first the TCN_SELCHANGING to ask if switch is allowed
301
 
    FillChar(Mess, SizeOf(Mess), 0);
302
 
    Mess.Msg := LM_NOTIFY;
303
 
    FillChar(NMHdr, SizeOf(NMHdr), 0);
304
 
    NMHdr.code := TCN_SELCHANGING;
305
 
    NMHdr.hwndFrom := PtrUInt(widget);
306
 
    NMHdr.idFrom := NotebookPageRealToLCLIndex(TCustomNotebook(Data), pagenum);  //use this to set pageindex to the correct page.
307
 
    Mess.NMHdr := @NMHdr;
308
 
    Mess.Result := 0;
309
 
    DeliverMessage(Data, Mess);
310
 
    if Mess.Result <> 0 then
311
 
    begin
312
 
      g_signal_stop_emission_by_name(PGtkObject(Widget), 'switch-page');
313
 
      Result := not CallBackDefaultReturn;
314
 
      Exit;
315
 
    end;
316
 
  end;
317
 
 
318
 
  // then send the new page
319
 
  FillChar(Mess, SizeOf(Mess), 0);
320
 
  Mess.Msg := LM_NOTIFY;
321
 
  FillChar(NMHdr, SizeOf(NMHdr), 0);
322
 
  NMHdr.code := TCN_SELCHANGE;
323
 
  NMHdr.hwndFrom := PtrUInt(widget);
324
 
  NMHdr.idFrom := NotebookPageRealToLCLIndex(TCustomNotebook(Data), pagenum);  //use this to set pageindex to the correct page.
325
 
  Mess.NMHdr := @NMHdr;
326
 
  DeliverMessage(Data, Mess);
327
 
end;
328
 
 
329
 
class procedure TGtk2WSCustomNotebook.SetCallbacks(
330
 
  const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
331
 
begin
332
 
  TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
333
 
  ConnectSignal(PGtkObject(AGtkWidget), 'switch_page', @GtkWSNotebook_SwitchPage, AWidgetInfo^.LCLObject);
334
 
end;
335
 
 
336
 
class function TGtk2WSCustomNotebook.CreateHandle(const AWinControl: TWinControl;
337
 
  const AParams: TCreateParams): HWND;
338
 
var
339
 
  AWidget: PGtkNoteBook;
340
 
  WidgetInfo: PWidgetInfo;
341
 
begin
342
 
  if OldNoteBookButtonPress = nil then
343
 
    HookNoteBookClass;
344
 
  //DebugLn(['TGtk2WSCustomNotebook.CreateHandle ',DbgSName(AWinControl)]);
345
 
 
346
 
  AWidget := PGtkNoteBook(gtk_notebook_new());
347
 
  WidgetInfo := CreateWidgetInfo(AWidget, AWinControl, AParams);
348
 
  {$IFDEF DebugLCLComponents}
349
 
  DebugGtkWidgets.MarkCreated(Pointer(AWidget), dbgsName(AWinControl));
350
 
  {$ENDIF}
351
 
  gtk_notebook_set_scrollable(AWidget, True);
352
 
 
353
 
  if not (nboHidePageListPopup in TCustomNotebook(AWinControl).Options) then
354
 
    gtk_notebook_popup_enable(AWidget);
355
 
 
356
 
  if TCustomNotebook(AWinControl).PageCount=0 then
357
 
    // a gtk notebook needs a page -> add dummy page
358
 
    Gtk2WidgetSet.AddDummyNoteBookPage(AWidget);
359
 
 
360
 
  gtk_notebook_set_tab_pos(AWidget, GtkPositionTypeMap[TCustomNotebook(AWinControl).TabPosition]);
361
 
  Result := HWND(TLCLIntfHandle(PtrUInt(AWidget)));
362
 
  Set_RC_Name(AWinControl, PGtkWidget(AWidget));
363
 
  SetCallBacks(PGtkWidget(AWidget), WidgetInfo);
364
 
end;
365
 
 
366
 
class function TGtk2WSCustomNotebook.GetDefaultClientRect(
367
 
  const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
368
 
  var aClientRect: TRect): boolean;
369
 
var
370
 
  FrameBorders: TRect;
371
 
begin
372
 
  Result:=false;
373
 
  //DebugLn(['TGtk2WSCustomNotebook.GetDefaultClientRect ',DbgSName(AWinControl),' ',aWidth,'x',aHeight]);
374
 
  if AWinControl.HandleAllocated then begin
375
 
 
376
 
  end else begin
377
 
    FrameBorders:=GetStyleNotebookFrameBorders;
378
 
    aClientRect:=Rect(0,0,
379
 
                 Max(0,aWidth-FrameBorders.Left-FrameBorders.Right),
380
 
                 Max(0,aHeight-FrameBorders.Top-FrameBorders.Bottom));
381
 
    Result:=true;
382
 
  end;
383
 
  {$IFDEF VerboseSizeMsg}
384
 
  if Result then DebugLn(['TGtk2WSCustomNotebook.GetDefaultClientRect END FrameBorders=',dbgs(FrameBorders),' aClientRect=',dbgs(aClientRect)]);
385
 
  {$ENDIF}
386
 
end;
387
 
 
388
 
class procedure TGtk2WSCustomNotebook.AddPage(const ANotebook: TCustomNotebook;
389
 
  const AChild: TCustomPage; const AIndex: integer);
390
 
{
391
 
  Inserts a new page to a notebook at position Index. The ANotebook is a
392
 
  TCustomNoteBook, the AChild one of its TCustomPage. Both handles must already
393
 
  be created. ANoteBook Handle is a PGtkNoteBook and APage handle is a
394
 
  PGtkHBox.
395
 
  This procedure creates a new tab with an optional image, the page caption and
396
 
  an optional close button. The image and the caption will also be added to the
397
 
  tab popup menu.
398
 
}
399
 
var
400
 
  NoteBookWidget: PGtkWidget;  // the notebook
401
 
  PageWidget: PGtkWidget;      // the page (content widget)
402
 
  TabWidget: PGtkWidget;       // the tab (hbox containing a pixmap, a label
403
 
                               //          and a close button)
404
 
  TabLabelWidget: PGtkWidget;  // the label in the tab
405
 
  MenuWidget: PGtkWidget;      // the popup menu (hbox containing a pixmap and
406
 
                               // a label)
407
 
  MenuLabelWidget: PGtkWidget; // the label in the popup menu item
408
 
begin
409
 
  {$IFDEF NOTEBOOK_DEBUG}
410
 
  DebugLn(['TGtkWSCustomNotebook.AddPage ',dbgsName(ANoteBook),' ',ANotebook.HandleAllocated,' AChild=',dbgsName(AChild),' ',AChild.HandleAllocated,' Child.TabVisible=',AChild.TabVisible]);
411
 
  {$ENDIF}
412
 
  NoteBookWidget := PGtkWidget(ANoteBook.Handle);
413
 
  PageWidget := PGtkWidget(AChild.Handle);
414
 
 
415
 
  // set LCL size
416
 
  AChild.SetBounds(AChild.Left, AChild.Top, ANotebook.ClientWidth, ANotebook.ClientHeight);
417
 
 
418
 
  if AChild.TabVisible then
419
 
    gtk_widget_show(PageWidget);
420
 
 
421
 
  // Check if already created. if so just show it because it is invisible
422
 
  if gtk_notebook_get_tab_label(PGtkNoteBook(NoteBookWidget), PageWidget) <> nil
423
 
  then begin
424
 
    {$IFDEF NOTEBOOK_DEBUG}
425
 
    DebugLn(['TGtkWSCustomNotebook.AddPage already added']);
426
 
    {$ENDIF}
427
 
    exit;
428
 
  end;
429
 
 
430
 
  // create the tab (hbox container)
431
 
  TabWidget := gtk_hbox_new(false, 1);
432
 
  gtk_object_set_data(PGtkObject(TabWidget), 'TabImage', nil);
433
 
  gtk_object_set_data(PGtkObject(TabWidget), 'TabCloseBtn', nil);
434
 
  // put a label into the tab
435
 
  TabLabelWidget := gtk_label_new('');
436
 
  gtk_object_set_data(PGtkObject(TabWidget), 'TabLabel', TabLabelWidget);
437
 
  gtk_widget_show(TabLabelWidget);
438
 
  gtk_box_pack_start_defaults(PGtkBox(TabWidget), TabLabelWidget);
439
 
 
440
 
  if AChild.TabVisible then
441
 
    gtk_widget_show(TabWidget);
442
 
 
443
 
  // create popup menu item
444
 
  MenuWidget := gtk_hbox_new(false, 2);
445
 
  // set icon widget to nil
446
 
  gtk_object_set_data(PGtkObject(MenuWidget), 'TabImage', nil);
447
 
  // put a label into the menu
448
 
  MenuLabelWidget := gtk_label_new('');
449
 
  gtk_object_set_data(PGtkObject(MenuWidget), 'TabLabel', MenuLabelWidget);
450
 
  gtk_widget_show(MenuLabelWidget);
451
 
  gtk_box_pack_start_defaults(PGtkBox(MenuWidget), MenuLabelWidget);
452
 
 
453
 
  if AChild.TabVisible then
454
 
    gtk_widget_show(MenuWidget);
455
 
 
456
 
  // remove the dummy page (a gtk_notebook needs at least one page)
457
 
  RemoveDummyNoteBookPage(PGtkNotebook(NoteBookWidget));
458
 
  // insert the page
459
 
  gtk_notebook_insert_page_menu(PGtkNotebook(NotebookWidget), PageWidget,
460
 
    TabWidget, MenuWidget, AIndex);
461
 
 
462
 
  UpdateNotebookPageTab(ANoteBook, AChild);
463
 
  UpdateNoteBookClientWidget(ANoteBook);
464
 
 
465
 
  // init the size of the page widget
466
 
  //DebugLn(['TGtkWSCustomNotebook.AddPage ',DbgSName(ANoteBook),' ',dbgs(ANoteBook.BoundsRect)]);
467
 
  {$IFDEF VerboseSizeMsg}
468
 
  DebugLn(['TGtkWSCustomNotebook.AddPage PageWidget^.allocation=',dbgs(PageWidget^.allocation),' NotebookWidget=',dbgs(NotebookWidget^.allocation)]);
469
 
  {$ENDIF}
470
 
end;
471
 
 
472
 
class procedure TGtk2WSCustomNotebook.MovePage(const ANotebook: TCustomNotebook;
473
 
  const AChild: TCustomPage; const NewIndex: integer);
474
 
var
475
 
  NoteBookWidget: PGtkNotebook;
476
 
begin
477
 
  NoteBookWidget:=PGtkNotebook(ANoteBook.Handle);
478
 
  gtk_notebook_reorder_child(NoteBookWidget, PGtkWidget(AChild.Handle), NewIndex);
479
 
  UpdateNoteBookClientWidget(ANoteBook);
480
 
end;
481
 
 
482
 
class procedure TGtk2WSCustomNotebook.RemovePage(const ANotebook: TCustomNotebook;
483
 
  const AIndex: integer);
484
 
var
485
 
  PageWidget: PGtkWidget;
486
 
  Page: TCustomPage;
487
 
begin
488
 
  // The gtk does not provide a function to remove a page without destroying it.
489
 
  // Luckily the LCL destroys the Handle, when a page is removed, so this
490
 
  // function is not needed.
491
 
  {$IFDEF NOTEBOOK_DEBUG}
492
 
  DebugLn(['TGtkWSCustomNotebook.RemovePage AIndex=',AIndex,' ',DbgSName(ANotebook.Page[AIndex])]);
493
 
  {$ENDIF}
494
 
  Page:=ANotebook.Page[AIndex];
495
 
  if not Page.HandleAllocated then exit;
496
 
  PageWidget := PGtkWidget(Page.Handle);
497
 
  gtk_widget_hide(PageWidget);
498
 
end;
499
 
 
500
 
class function TGtk2WSCustomNotebook.GetCapabilities: TNoteBookCapabilities;
501
 
begin
502
 
  Result:=[nbcPageListPopup, nbcShowCloseButtons];
503
 
end;
504
 
 
505
 
class function TGtk2WSCustomNotebook.GetNotebookMinTabHeight(
506
 
  const AWinControl: TWinControl): integer;
507
 
var
508
 
  NBWidget: PGTKWidget;
509
 
  BorderWidth: Integer;
510
 
  Page: PGtkNotebookPage;
511
 
begin
512
 
  Result:=inherited GetNotebookMinTabHeight(AWinControl);
513
 
  //debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight A ',dbgs(Result));
514
 
  exit;
515
 
 
516
 
  debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight A ',dbgs(AWinControl.HandleAllocated));
517
 
  if AWinControl.HandleAllocated then
518
 
    NBWidget:=PGTKWidget(AWinControl.Handle)
519
 
  else
520
 
    NBWidget:=GetStyleWidget(lgsNotebook);
521
 
 
522
 
  // ToDo: find out how to create a fully working hidden Notebook style widget
523
 
 
524
 
  if (NBWidget=nil) then begin
525
 
    Result:=TWSCustomNotebook.GetNotebookMinTabHeight(AWinControl);
526
 
    exit;
527
 
  end;
528
 
  debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight NBWidget: ',GetWidgetDebugReport(NBWidget),
529
 
   ' ',dbgs(NBWidget^.allocation.width),'x',dbgs(NBWidget^.allocation.height));
530
 
 
531
 
  BorderWidth:=(PGtkContainer(NBWidget)^.flag0 and bm_TGtkContainer_border_width)
532
 
               shr bp_TGtkContainer_border_width;
533
 
  if PGtkNoteBook(NBWidget)^.first_tab<>nil then
534
 
    Page:=PGtkNoteBook(NBWidget)^.cur_page;
535
 
 
536
 
  Result:=BorderWidth;
537
 
  if (Page<>nil) then begin
538
 
    debugln('TGtkWSCustomNotebook.RemovePage TODO');
539
 
  end;
540
 
  debugln('TGtkWSCustomNotebook.GetNotebookMinTabHeight END ',dbgs(Result),' ',
541
 
    GetWidgetDebugReport(NBWidget));
542
 
end;
543
 
 
544
 
class function TGtk2WSCustomNotebook.GetNotebookMinTabWidth(
545
 
  const AWinControl: TWinControl): integer;
546
 
begin
547
 
  Result:=TWSCustomNotebook.GetNotebookMinTabWidth(AWinControl);
548
 
end;
549
 
 
550
 
class function TGtk2WSCustomNotebook.GetTabIndexAtPos(
551
 
  const ANotebook: TCustomNotebook; const AClientPos: TPoint): integer;
552
 
var
553
 
  NoteBookWidget: PGtkNotebook;
554
 
  i: integer;
555
 
  TabWidget: PGtkWidget;
556
 
  PageWidget: PGtkWidget;
557
 
  NotebookPos: TPoint;
558
 
  Window: PGdkWindow;
559
 
  WindowOrg,ClientOrg: TPoint;
560
 
  Count: guint;
561
 
begin
562
 
  Result:=-1;
563
 
  NoteBookWidget:=PGtkNotebook(ANotebook.Handle);
564
 
  if (NotebookWidget=nil) then exit;
565
 
  //DebugLn(['TGtkWSCustomNotebook.GetTabIndexAtPos ',GetWidgetDebugReport(PGtkWidget(NotebookWidget))]);
566
 
  Window := GetControlWindow(NoteBookWidget);
567
 
  gdk_window_get_origin(Window,@WindowOrg.X,@WindowOrg.Y);
568
 
  ClientOrg:=GetWidgetClientOrigin(PGtkWidget(NotebookWidget));
569
 
  NotebookPos.X:= AClientPos.X + (ClientOrg.X-WindowOrg.X);
570
 
  NotebookPos.Y:= AClientPos.Y + (ClientOrg.Y-WindowOrg.Y);
571
 
  // go through all tabs
572
 
  Count:=g_list_length(NoteBookWidget^.Children);
573
 
  for i:=0 to Count-1 do
574
 
  begin
575
 
    PageWidget:=gtk_notebook_get_nth_page(NoteBookWidget,i);
576
 
    if PageWidget<>nil then
577
 
    begin
578
 
      TabWidget:=gtk_notebook_get_tab_label(NoteBookWidget, PageWidget);
579
 
      if (TabWidget<>nil) and GTK_WIDGET_MAPPED(TabWidget) then
580
 
      begin
581
 
        // test if position is in tabwidget
582
 
        if (TabWidget^.Allocation.X<=NoteBookPos.X)
583
 
        and (TabWidget^.Allocation.Y<=NoteBookPos.Y)
584
 
        and (TabWidget^.Allocation.X+TabWidget^.Allocation.Width>NoteBookPos.X)
585
 
        and (TabWidget^.Allocation.Y+TabWidget^.Allocation.Height>NoteBookPos.Y)
586
 
        then begin
587
 
          Result:=i;
588
 
          exit;
589
 
        end;
590
 
      end;
591
 
    end;
592
 
  end;
593
 
end;
594
 
 
595
 
class function TGtk2WSCustomNotebook.GetTabRect(const ANotebook: TCustomNotebook;
596
 
  const AIndex: Integer): TRect;
597
 
var
598
 
  NoteBookWidget: PGtkNotebook;
599
 
  TabWidget: PGtkWidget;
600
 
  PageWidget: PGtkWidget;
601
 
  Count: guint;
602
 
begin
603
 
  Result := inherited;
604
 
  NoteBookWidget:=PGtkNotebook(ANotebook.Handle);
605
 
  if (NotebookWidget=nil) then exit;
606
 
 
607
 
  Count := g_list_length(NoteBookWidget^.Children);
608
 
  PageWidget := gtk_notebook_get_nth_page(NoteBookWidget, AIndex);
609
 
  if (PageWidget<>nil) and (AIndex < Count) then
610
 
  begin
611
 
    TabWidget := gtk_notebook_get_tab_label(NoteBookWidget, PageWidget);
612
 
    if TabWidget <> nil then
613
 
      Result := RectFromGdkRect(TabWidget^.allocation);
614
 
  end;
615
 
end;
616
 
 
617
 
class procedure TGtk2WSCustomNotebook.SetPageIndex(
618
 
  const ANotebook: TCustomNotebook; const AIndex: integer);
619
 
var
620
 
  GtkNotebook: PGtkNotebook;
621
 
begin
622
 
  if not WSCheckHandleAllocated(ANotebook, 'SetPageIndex') then
623
 
    Exit;
624
 
 
625
 
  GtkNotebook := PGtkNoteBook(ANotebook.Handle);
626
 
  if gtk_notebook_get_current_page(GtkNotebook) <> AIndex then
627
 
  begin
628
 
    gtk_object_set_data(PGtkObject(GtkNotebook), LCL_NotebookManualPageSwitchKey, ANotebook);
629
 
    gtk_notebook_set_page(GtkNotebook, AIndex);
630
 
  end;
631
 
  UpdateNoteBookClientWidget(ANotebook);
632
 
end;
633
 
 
634
 
class procedure TGtk2WSCustomNotebook.SetTabPosition(
635
 
  const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition);
636
 
begin
637
 
  gtk_notebook_set_tab_pos(PGtkNotebook(ANotebook.Handle),
638
 
    GtkPositionTypeMap[ATabPosition]);
639
 
end;
640
 
 
641
 
class procedure TGtk2WSCustomNotebook.ShowTabs(const ANotebook: TCustomNotebook;
642
 
  AShowTabs: boolean);
643
 
begin
644
 
  gtk_notebook_set_show_tabs(PGtkNotebook(ANotebook.Handle), AShowTabs);
645
 
end;
646
 
 
647
 
class procedure TGtk2WSCustomNotebook.UpdateProperties(const ANotebook: TCustomNotebook);
648
 
begin
649
 
  if (nboHidePageListPopup in ANoteBook.Options) then
650
 
    gtk_notebook_popup_disable(PGtkNotebook(ANoteBook.Handle))
651
 
  else
652
 
    gtk_notebook_popup_enable(PGtkNotebook(ANoteBook.Handle));
653
 
end;
654
 
 
655
 
 
656
 
 
657
 
{ TGtk2WSCustomPage }
658
 
 
659
 
class procedure TGtk2WSCustomPage.SetCallbacks(const AGtkWidget: PGtkWidget;
660
 
  const AWidgetInfo: PWidgetInfo);
661
 
begin
662
 
  TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
663
 
end;
664
 
 
665
 
class function TGtk2WSCustomPage.CreateHandle(const AWinControl: TWinControl;
666
 
  const AParams: TCreateParams): TLCLIntfHandle;
667
 
var
668
 
  Widget: PGtkWidget;
669
 
  WidgetInfo: PWidgetInfo;
670
 
begin
671
 
  Widget := Gtk2Widgetset.CreateSimpleClientAreaWidget(AWinControl, True);
672
 
  {$IFDEF DebugLCLComponents}
673
 
  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
674
 
  {$ENDIF}
675
 
  Result := TLCLIntfHandle(PtrUInt(Widget));
676
 
 
677
 
  WidgetInfo := GetWidgetInfo(Widget);
678
 
  WidgetInfo^.LCLObject := AWinControl;
679
 
  WidgetInfo^.Style := AParams.Style;
680
 
  WidgetInfo^.ExStyle := AParams.ExStyle;
681
 
  WidgetInfo^.WndProc := PtrUInt(AParams.WindowClass.lpfnWndProc);
682
 
 
683
 
  Set_RC_Name(AWinControl, Widget);
684
 
  SetCallBacks(Widget, WidgetInfo);
685
 
end;
686
 
 
687
 
class procedure TGtk2WSCustomPage.UpdateProperties(const ACustomPage: TCustomPage);
688
 
var
689
 
  NoteBook: PGtkWidget;
690
 
  PageWidget: PGtkWidget;
691
 
  TabWidget: PGtkWidget;
692
 
  TabImageWidget: PGtkWidget;
693
 
begin
694
 
  UpdateNotebookPageTab(nil, ACustomPage);
695
 
  {we must update our icon (if exists) otherwise it will be updated only
696
 
  when our tab reach focus}
697
 
  if not (csDesigning in ACustomPage.ComponentState)
698
 
    and not ACustomPage.TabVisible
699
 
    or not ACustomPage.HandleAllocated
700
 
    or not Assigned(ACustomPage.Parent)
701
 
  then
702
 
    exit;
703
 
 
704
 
  PageWidget := PGtkWidget(ACustomPage.Handle);
705
 
  NoteBook := PGtkWidget(ACustomPage.Parent.Handle);
706
 
  if (NoteBook = nil) or not GTK_IS_NOTEBOOK(NoteBook) then
707
 
    exit;
708
 
 
709
 
  TabWidget := gtk_notebook_get_tab_label(PGtkNoteBook(Notebook), PageWidget);
710
 
  if (TabWidget = nil) or not GTK_WIDGET_VISIBLE(TabWidget) then
711
 
    exit;
712
 
 
713
 
  TabImageWidget := gtk_object_get_data(PGtkObject(TabWidget), 'TabImage');
714
 
  if TabImageWidget <> nil then
715
 
    gtk_widget_queue_draw(TabImageWidget);
716
 
end;
717
 
 
718
 
class procedure TGtk2WSCustomPage.SetBounds(const AWinControl: TWinControl;
719
 
  const ALeft, ATop, AWidth, AHeight: Integer);
720
 
begin
721
 
  // ignore resizes from the LCL
722
 
end;
723
 
 
724
 
class procedure TGtk2WSCustomPage.ShowHide(const AWinControl: TWinControl);
725
 
begin
726
 
  if (csDesigning in AWinControl.ComponentState) then
727
 
    TGtk2WidgetSet(WidgetSet).SetVisible(AWinControl,
728
 
      AWinControl.HandleObjectShouldBeVisible)
729
 
  else
730
 
    TGtk2WidgetSet(WidgetSet).SetVisible(AWinControl,
731
 
      TCustomPage(AWinControl).TabVisible);
732
 
end;
733
 
 
734
 
class function TGtk2WSCustomPage.GetDefaultClientRect(
735
 
  const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
736
 
  var aClientRect: TRect): boolean;
737
 
begin
738
 
  Result:=false;
739
 
  if AWinControl.Parent=nil then exit;
740
 
  if AWinControl.HandleAllocated and AWinControl.Parent.HandleAllocated
741
 
  and (PGtkWidget(AWinControl.Handle)^.parent<>nil) then
742
 
  begin
743
 
 
744
 
  end else begin
745
 
    Result:=true;
746
 
    aClientRect:=AWinControl.Parent.ClientRect;
747
 
    //DebugLn(['TGtk2WSCustomPage.GetDefaultClientRect ',DbgSName(AWinControl),' Parent=',DbgSName(AWinControl.Parent),' ParentBounds=',dbgs(AWinControl.Parent.BoundsRect),' ParentClient=',dbgs(AWinControl.Parent.ClientRect)]);
748
 
  end;
749
 
  {$IFDEF VerboseSizeMsg}
750
 
  if Result then DebugLn(['TGtk2WSCustomPage.GetDefaultClientRect ',DbgSName(AWinControl),' aClientRect=',dbgs(aClientRect)]);
751
 
  {$ENDIF}
752
 
end;
753
 
 
754
181
{ TGtk2WSCustomPanel }
755
182
 
756
183
class procedure TGtk2WSCustomPanel.SetCallbacks(const AGtkWidget: PGtkWidget;
762
189
class function TGtk2WSCustomPanel.CreateHandle(const AWinControl: TWinControl;
763
190
  const AParams: TCreateParams): TLCLIntfHandle;
764
191
var
765
 
  Widget: PGtkWidget;
 
192
  Frame, WidgetClient: PGtkWidget;
766
193
  WidgetInfo: PWidgetInfo;
767
194
  Allocation: TGTKAllocation;
 
195
  bwidth: gint;
 
196
  Style: PGtkRCStyle;
 
197
  BorderStyle: TBorderStyle;
 
198
  r: TRect;
768
199
begin
769
 
  Widget := TGtk2Widgetset(Widgetset).CreateAPIWidget(AWinControl);
 
200
  Frame := gtk_frame_new(nil);
 
201
  BorderStyle:=TCustomControl(AWinControl).BorderStyle;
 
202
  gtk_frame_set_shadow_type(PGtkFrame(Frame),BorderStyleShadowMap[BorderStyle]);
 
203
 
 
204
  case BorderStyle of
 
205
  bsSingle:
 
206
    bwidth:=1;
 
207
  else
 
208
    bwidth:=0
 
209
  end;
 
210
  Style := gtk_widget_get_modifier_style(Frame);
 
211
  Style^.xthickness := bwidth;
 
212
  Style^.ythickness := bwidth;
 
213
  gtk_widget_modify_style(Frame, Style);
 
214
 
770
215
  {$IFDEF DebugLCLComponents}
771
 
  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
 
216
  DebugGtkWidgets.MarkCreated(Frame, dbgsName(AWinControl));
772
217
  {$ENDIF}
773
218
 
774
 
  Result := THandle(PtrUInt(Widget));
775
 
  if Result = 0 then Exit;
776
 
 
777
 
  WidgetInfo := GetWidgetInfo(Widget); // Widget info already created in CreateAPIWidget
 
219
  WidgetClient := CreateFixedClientWidget(True);
 
220
 
 
221
  gtk_container_add(GTK_CONTAINER(Frame), WidgetClient);
 
222
  GTK_WIDGET_SET_FLAGS(Frame, GTK_CAN_FOCUS);
 
223
 
 
224
  WidgetInfo := CreateWidgetInfo(Frame, AWinControl, AParams);
 
225
  WidgetInfo^.ClientWidget := WidgetClient;
 
226
  WidgetInfo^.CoreWidget := Frame;
 
227
  WidgetInfo^.LCLObject := AWinControl;
778
228
  WidgetInfo^.Style := AParams.Style;
779
229
  WidgetInfo^.ExStyle := AParams.ExStyle;
780
 
  WidgetInfo^.WndProc := PtrUInt(AParams.WindowClass.lpfnWndProc);
781
 
 
782
 
  // set allocation
 
230
  WidgetInfo^.WndProc := {%H-}PtrUInt(AParams.WindowClass.lpfnWndProc);
 
231
 
 
232
  g_object_set_data(PGObject(WidgetClient), 'widgetinfo', WidgetInfo);
 
233
 
 
234
  gtk_widget_show_all(Frame);
 
235
 
783
236
  Allocation.X := AParams.X;
784
237
  Allocation.Y := AParams.Y;
785
238
  Allocation.Width := AParams.Width;
786
239
  Allocation.Height := AParams.Height;
787
 
  gtk_widget_size_allocate(Widget, @Allocation);
788
 
 
789
 
  Set_RC_Name(AWinControl, Widget);
790
 
  SetCallbacks(Widget, WidgetInfo);
 
240
  gtk_widget_size_allocate(Frame, @Allocation);
 
241
 
 
242
  //debugln(['TGtk2WSCustomPanel.CreateHandle Frame^.allocation=',dbgs(Frame^.allocation),' WidgetClient^.allocation=',dbgs(WidgetClient^.allocation)]);
 
243
 
 
244
  Set_RC_Name(AWinControl, Frame);
 
245
 
 
246
  // issue #23940. Hide panel if we are not visible, but before setting callbacks.
 
247
  // so it won't trigger unnecessary events to LCL.
 
248
  if not AWinControl.Visible and not (csDesigning in AWinControl.ComponentState) then
 
249
    gtk_widget_hide(Frame);
 
250
 
 
251
  SetCallbacks(Frame, WidgetInfo);
 
252
 
 
253
  Result := TLCLIntfHandle({%H-}PtrUInt(Frame));
791
254
end;
792
255
 
793
256
class procedure TGtk2WSCustomPanel.SetColor(const AWinControl: TWinControl);
794
257
var
795
258
  MainWidget: PGtkWidget;
796
 
  FontColor, BGColor: TColor;
797
259
begin
798
260
  if not AWinControl.HandleAllocated then exit;
799
 
  MainWidget:=GetFixedWidget(pGtkWidget(AWinControl.handle));
 
261
  MainWidget:=GetFixedWidget({%H-}pGtkWidget(AWinControl.handle));
800
262
  if MainWidget<>nil then
801
263
  Gtk2WidgetSet.SetWidgetColor(MainWidget,
802
264
                              AWinControl.Font.Color, AWinControl.Color,