← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/interfaces/gtk2/gtk2wscontrols.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/gtk2wscontrols.pp
1
 
{ $Id: gtk2wscontrols.pp 35769 2012-03-06 14:50:15Z vincents $}
 
1
{ $Id: gtk2wscontrols.pp 38953 2012-10-02 21:02:17Z martin $}
2
2
{
3
3
 *****************************************************************************
4
4
 *                             Gtk2WSControls.pp                             * 
50
50
 
51
51
  TGtk2WSDragImageList = class(TWSDragImageList)
52
52
  published
53
 
    class function BeginDrag(const ADragImageList: TDragImageList; Window: HWND; AIndex, X, Y: Integer): Boolean; override;
54
 
    class function DragMove(const ADragImageList: TDragImageList; X, Y: Integer): Boolean; override;
55
 
    class procedure EndDrag(const ADragImageList: TDragImageList); override;
56
 
    class function HideDragImage(const ADragImageList: TDragImageList;
57
 
      ALockedWindow: HWND; DoUnLock: Boolean): Boolean; override;
58
 
    class function ShowDragImage(const ADragImageList: TDragImageList;
59
 
      ALockedWindow: HWND; X, Y: Integer; DoLock: Boolean): Boolean; override;
 
53
    class function BeginDrag(const ADragImageList: TDragImageList; {%H-}Window: HWND; AIndex, X, Y: Integer): Boolean; override;
 
54
    class function DragMove(const {%H-}ADragImageList: TDragImageList; X, Y: Integer): Boolean; override;
 
55
    class procedure EndDrag(const {%H-}ADragImageList: TDragImageList); override;
 
56
    class function HideDragImage(const {%H-}ADragImageList: TDragImageList;
 
57
      {%H-}ALockedWindow: HWND; {%H-}DoUnLock: Boolean): Boolean; override;
 
58
    class function ShowDragImage(const {%H-}ADragImageList: TDragImageList;
 
59
      {%H-}ALockedWindow: HWND; X, Y: Integer; {%H-}DoLock: Boolean): Boolean; override;
60
60
  end;
61
61
 
62
62
  { TGtkWSControl }
87
87
 
88
88
    class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
89
89
    class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
90
 
    class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList); override;
 
90
    class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const {%H-}AOldPos, ANewPos: Integer; const AChildren: TFPList); override;
91
91
    class procedure SetColor(const AWinControl: TWinControl); override;
92
92
    class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); override;
93
93
    class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
99
99
 
100
100
    class procedure ShowHide(const AWinControl: TWinControl); override;
101
101
 
102
 
    class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean); override;
 
102
    class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, {%H-}UseRightToLeftReading, {%H-}UseRightToLeftScrollBar : Boolean); override;
103
103
  end;
104
104
 
105
105
  { TGtk2WSGraphicControl }
147
147
function GetWidgetHAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
148
148
function GetWidgetVAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
149
149
 
 
150
var
 
151
  HasWarnedLibOverlay: boolean = false;
 
152
 
150
153
implementation
151
154
 
152
155
uses
153
 
  Gtk2Int, LMessages, Math, Gtk2WSPrivate, Forms;
 
156
  Gtk2Int, LMessages, Gtk2WSPrivate, Forms;
154
157
 
155
158
{ TGtk2WSWinControl }
156
159
 
157
 
function Gtk2ScrolledWindowScrollCB(AScrollWindow: PGtkScrolledWindow; AEvent: PGdkEventScroll; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
158
 
var
159
 
  Msg: TLMVScroll;
160
 
  AValue: Double;
161
 
  Range: PGtkRange;
162
 
begin
163
 
  case AEvent^.direction of
164
 
    GDK_SCROLL_UP,
165
 
    GDK_SCROLL_DOWN: Msg.Msg := LM_VSCROLL;
166
 
    GDK_SCROLL_LEFT,
167
 
    GDK_SCROLL_RIGHT: Msg.Msg := LM_HSCROLL;
168
 
  end;
169
 
 
170
 
  case Msg.Msg of
171
 
    LM_VSCROLL: Range := GTK_RANGE(AScrollWindow^.vscrollbar);
172
 
    LM_HSCROLL: Range := GTK_RANGE(AScrollWindow^.hscrollbar);
173
 
  end;
174
 
  
175
 
  AValue :=  power(Range^.adjustment^.page_size, 2 / 3);
176
 
  
177
 
  if (AEvent^.direction = GDK_SCROLL_UP) or
178
 
     (AEvent^.direction = GDK_SCROLL_LEFT)
179
 
  then
180
 
    AValue := -AValue;
181
 
    
182
 
  AValue := gtk_range_get_value(Range) + AValue;
183
 
  
184
 
  AValue := Max(AValue, Range^.adjustment^.lower);
185
 
  AValue := Min(AValue, Range^.adjustment^.upper - Range^.adjustment^.page_size);
186
 
 
187
 
  with Msg do
188
 
  begin
189
 
    Pos := Round(AValue);
190
 
    if Pos < High(SmallPos) then
191
 
      SmallPos := Pos
192
 
    else
193
 
      SmallPos := High(SmallPos);
194
 
 
195
 
    ScrollBar := HWND(PtrUInt(Range));
196
 
    ScrollCode := SB_THUMBPOSITION;
197
 
  end;
198
 
  Result := DeliverMessage(AWidgetInfo^.LCLObject, Msg) <> 0;
199
 
end;
200
 
 
201
160
 
202
161
class function TGtk2WSWinControl.CreateHandle(const AWinControl: TWinControl;
203
162
  const AParams: TCreateParams): HWND;
205
164
  Widget: PGtkWidget;
206
165
  WidgetInfo: PWidgetInfo;
207
166
  Allocation: TGTKAllocation;
 
167
  ScrollBar: PGtkWidget;
 
168
  Adjustment: PGtkAdjustment;
208
169
begin
209
170
  Widget := GTK2WidgetSet.CreateAPIWidget(AWinControl);
210
171
  {$IFDEF DebugLCLComponents}
211
172
  DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
212
173
  {$ENDIF}
213
174
 
214
 
  Result := THandle(PtrUInt(Widget));
 
175
  Result := THandle({%H-}PtrUInt(Widget));
215
176
  if Result = 0 then Exit;
216
177
 
217
178
  WidgetInfo := GetWidgetInfo(Widget); // Widget info already created in CreateAPIWidget
218
179
  WidgetInfo^.Style := AParams.Style;
219
180
  WidgetInfo^.ExStyle := AParams.ExStyle;
220
 
  WidgetInfo^.WndProc := PtrUInt(AParams.WindowClass.lpfnWndProc);
 
181
  WidgetInfo^.WndProc := {%H-}PtrUInt(AParams.WindowClass.lpfnWndProc);
221
182
 
222
183
  // set allocation
223
184
  Allocation.X := AParams.X;
230
191
 
231
192
  TGtk2WSWinControl.SetCallbacks(GTK_OBJECT(Widget), AWinControl);
232
193
 
233
 
  g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.hscrollbar, 'change-value',
234
 
    TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
235
 
  g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.vscrollbar, 'change-value',
236
 
    TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
 
194
  // scrollbars
 
195
  if (GetWidgetClassName(GTK_SCROLLED_WINDOW(Widget)^.vscrollbar)='OsScrollbar')
 
196
  or (GetWidgetClassName(GTK_SCROLLED_WINDOW(Widget)^.hscrollbar)='OsScrollbar')
 
197
  then begin
 
198
    // ubuntu liboverlay scrollbar is active
 
199
    if not HasWarnedLibOverlay then begin
 
200
      HasWarnedLibOverlay:=true;
 
201
      debugln(['WARNING: liboverlay_scrollbar is active for control=',AWinControl,'. Set environment option LIBOVERLAY_SCROLLBAR=0 before starting this application, otherwise scrollbars will not work properly.']);
 
202
    end;
 
203
  end;
 
204
 
 
205
  ScrollBar:=GTK_SCROLLED_WINDOW(Widget)^.hscrollbar;
 
206
  if (GetWidgetClassName(ScrollBar)='OsScrollbar')
 
207
  then begin
 
208
    // the ubuntu scroll bar eats the change-value signal => use value-changed
 
209
    Adjustment:=gtk_scrolled_window_get_hadjustment(GTK_SCROLLED_WINDOW(Widget));
 
210
    g_signal_connect_after(Adjustment, 'value-changed',TGCallback(@Gtk2RangeUbuntuScrollCB), WidgetInfo);
 
211
  end else begin
 
212
    g_signal_connect_after(ScrollBar, 'change-value',
 
213
      TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
 
214
  end;
 
215
 
 
216
  ScrollBar:=GTK_SCROLLED_WINDOW(Widget)^.vscrollbar;
 
217
  if (GetWidgetClassName(ScrollBar)='OsScrollbar')
 
218
  then begin
 
219
    // the ubuntu scroll bar eats the change-value signal => use value-changed
 
220
    Adjustment:=gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(Widget));
 
221
    g_signal_connect_after(Adjustment, 'value-changed',TGCallback(@Gtk2RangeUbuntuScrollCB), WidgetInfo);
 
222
  end else begin
 
223
    g_signal_connect_after(ScrollBar, 'change-value',
 
224
      TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
 
225
  end;
 
226
 
 
227
  g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.hscrollbar, 'button-press-event',
 
228
    TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo);
 
229
  g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.hscrollbar, 'button-release-event',
 
230
    TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo);
 
231
    g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.vscrollbar, 'button-press-event',
 
232
    TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo);
 
233
  g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.vscrollbar, 'button-release-event',
 
234
    TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo);
237
235
 
238
236
  g_signal_connect(Widget, 'scroll-event', TGCallback(@Gtk2ScrolledWindowScrollCB), WidgetInfo);
239
237
end;
248
246
begin
249
247
  if not WSCheckHandleAllocated(AWinControl, 'SetBiDiMode') then
250
248
    Exit;
251
 
  gtk_widget_set_direction(PGtkWidget(AWinControl.Handle),
 
249
  gtk_widget_set_direction({%H-}PGtkWidget(AWinControl.Handle),
252
250
    WidgetDirection[UseRightToLeftAlign]);
253
 
  Info := GetWidgetInfo(PGtkWidget(AWinControl.Handle));
 
251
  Info := GetWidgetInfo({%H-}PGtkWidget(AWinControl.Handle));
254
252
  if Info <> nil then
255
253
  begin
256
254
    if Info^.CoreWidget <> nil then
276
274
  case AWinControl.fCompStyle of
277
275
    csComboBox:
278
276
      begin
279
 
        AText := StrPas(gtk_entry_get_text(PGtkEntry(PGtkCombo(Handle)^.entry)));
 
277
        AText := StrPas(gtk_entry_get_text(PGtkEntry({%H-}PGtkCombo(Handle)^.entry)));
280
278
      end;
281
279
 
282
 
    csEdit, csSpinEdit:
283
 
       AText:= StrPas(gtk_entry_get_text(PgtkEntry(Handle)));
 
280
    csEdit: AText:= StrPas(gtk_entry_get_text({%H-}PgtkEntry(Handle)));
 
281
    csSpinEdit: AText:= StrPas(gtk_entry_get_text(@{%H-}PGtkSpinButton(Handle)^.entry));
 
282
 
284
283
 
285
284
    csMemo:
286
285
      begin
287
 
        CS := gtk_editable_get_chars(PGtkOldEditable(
288
 
          GetWidgetInfo(Pointer(Handle), True)^.CoreWidget), 0, -1);
 
286
        CS := gtk_editable_get_chars(PGtkEditable(
 
287
          GetWidgetInfo({%H-}Pointer(Handle), True)^.CoreWidget), 0, -1);
289
288
        AText := StrPas(CS);
290
289
        g_free(CS);
291
290
      end;
309
308
  case AWinControl.fCompStyle of
310
309
    csMemo:
311
310
      begin
312
 
        TextBuf := gtk_text_view_get_buffer(PGtkTextView(GetWidgetInfo(Pointer(Handle), True)^.CoreWidget));
 
311
        TextBuf := gtk_text_view_get_buffer(PGtkTextView(GetWidgetInfo({%H-}Pointer(Handle), True)^.CoreWidget));
313
312
        gtk_text_buffer_get_start_iter(TextBuf, @StartIter);
314
313
        gtk_text_buffer_get_end_iter(TextBuf, @EndIter);
315
314
        CS := gtk_text_buffer_get_text(TextBuf, @StartIter, @EndIter, False);
329
328
  if not WSCheckHandleAllocated(AWinControl, 'SetBorderStyle')
330
329
  then Exit;
331
330
 
332
 
  Widget := PGtkWidget(AWinControl.Handle);
 
331
  Widget := {%H-}PGtkWidget(AWinControl.Handle);
333
332
  if GtkWidgetIsA(Widget, GTKAPIWidget_GetType) then
334
333
    GTKAPIWidget_SetShadowType(PGTKAPIWidget(Widget), BorderStyleShadowMap[ABorderStyle])
335
334
  else
348
347
  if not WSCheckHandleAllocated(AWinControl, 'SetBorderStyle')
349
348
  then Exit;
350
349
  
351
 
  Widget := PGtkWidget(AWinControl.Handle);
 
350
  Widget := {%H-}PGtkWidget(AWinControl.Handle);
352
351
  if GTK_IS_SCROLLED_WINDOW(Widget) then
353
352
    gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(Widget), BorderStyleShadowMap[ABorderStyle])
354
353
  else
398
397
    Exit;
399
398
  end;
400
399
 
401
 
  GDIObject := PGDIObject(ABitmap.Handle);
 
400
  GDIObject := {%H-}PGDIObject(ABitmap.Handle);
402
401
 
403
402
  Pixmap := nil;
404
403
  Mask := nil;
467
466
  TWinControlHack = class(TWinControl)
468
467
  end;
469
468
 
 
469
function Gtk2TreeViewEditorEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl;
 
470
var
 
471
  R: TRect;
 
472
  Alloc: TGtkAllocation;
 
473
  w: PGtkWidget;
 
474
  AOrientation: TGtkOrientation;
 
475
begin
 
476
  Result := CallBackDefaultReturn;
 
477
  case event^._type of
 
478
    GDK_FOCUS_CHANGE:
 
479
    begin
 
480
      // cheat GtkTreeView container , so we are visible and ready for input.
 
481
      if event^.focus_change._in = 1 then
 
482
      begin
 
483
        R := TWinControl(Data).BoundsRect;
 
484
        with R do
 
485
        begin
 
486
          with R do
 
487
          begin
 
488
            Alloc.x := Left;
 
489
            Alloc.y := Top;
 
490
            Alloc.width := Right - Left;
 
491
            Alloc.height := Bottom - Top;
 
492
          end;
 
493
          gtk_widget_size_allocate(Widget, @Alloc);
 
494
        end;
 
495
      end else
 
496
      begin
 
497
        w := gtk_widget_get_parent(Widget);
 
498
        if Assigned(w) and GTK_IS_ICON_VIEW(w) then
 
499
        begin
 
500
          //gtk2 does not layout items correctly when iconArrangement is iaTop.
 
501
          //so we force it to do so.
 
502
          AOrientation := gtk_icon_view_get_orientation(PGtkIconView(w));
 
503
          if AOrientation = GTK_ORIENTATION_HORIZONTAL then
 
504
            gtk_icon_view_set_orientation(PGtkIconView(w), GTK_ORIENTATION_VERTICAL)
 
505
          else
 
506
            gtk_icon_view_set_orientation(PGtkIconView(w), GTK_ORIENTATION_HORIZONTAL);
 
507
          gtk_icon_view_set_orientation(PGtkIconView(w), AOrientation)
 
508
        end;
 
509
      end;
 
510
    end;
 
511
  end;
 
512
end;
 
513
 
470
514
class procedure TGtk2WSWinControl.AddControl(const AControl: TControl);
471
515
var
472
516
  AParent: TWinControl;
480
524
  {$ENDIF}
481
525
 
482
526
  AParent := TWinControl(AControl).Parent;
483
 
  //debugln('LM_AddChild: ',TWinControl(Sender).Name,' ',dbgs(AParent<>nil));
 
527
  // DebugLn('LM_AddChild: ',dbgsName(AControl),' ',dbgs(AParent<>nil));
484
528
  if not Assigned(AParent) then
485
529
    Assert(true, Format('Trace: [TGtkWSWinControl.AddControl] %s --> Parent is not assigned', [AControl.ClassName]))
486
530
  else
487
531
  begin
488
 
    Assert(False, Format('Trace:  [TGtkWSWinControl.AddControl] %s --> Calling Add Child: %s', [AParent.ClassName, AControl.ClassName]));
489
 
    ParentWidget := Pgtkwidget(AParent.Handle);
 
532
    // DebugLn(Format('Trace:  [TGtkWSWinControl.AddControl] %s --> Calling Add Child: %s', [AParent.ClassName, AControl.ClassName]));
 
533
 
 
534
    ParentWidget := {%H-}PGtkwidget(AParent.Handle);
490
535
    pFixed := GetFixedWidget(ParentWidget);
491
 
    if pFixed <> ParentWidget then
492
 
    begin
493
 
      // parent changed for child
494
 
      ChildWidget := PGtkWidget(TWinControl(AControl).Handle);
495
 
      FixedPutControl(pFixed, ChildWidget, AControl.Left, AControl.Top);
496
 
      RegroupAccelerator(ChildWidget);
 
536
 
 
537
    // gtk2 is pretty tricky about adding editor into control
 
538
    if (AParent.FCompStyle = csListView) and
 
539
      (TWinControl(AControl).FCompStyle = csEdit) then
 
540
    begin
 
541
      ChildWidget := {%H-}PGtkWidget(TWinControl(AControl).Handle);
 
542
      ParentWidget := gtk_bin_get_child(PGtkBin(PFixed)); // treeview
 
543
      // MUST allocate some size before adding it to container !
 
544
      gtk_widget_set_size_request(ChildWidget, 80, 25);
 
545
      gtk_widget_set_parent(ChildWidget, ParentWidget);
 
546
      // now we connect our GtkEntry directly to event filter
 
547
      g_signal_connect(PGtkObject(ChildWidget), 'event',
 
548
        gtk_signal_func(@Gtk2TreeViewEditorEvent), AControl);
 
549
    end else
 
550
    begin
 
551
      if pFixed <> ParentWidget then
 
552
      begin
 
553
        // parent changed for child
 
554
        ChildWidget := {%H-}PGtkWidget(TWinControl(AControl).Handle);
 
555
        FixedPutControl(pFixed, ChildWidget, AControl.Left, AControl.Top);
 
556
        RegroupAccelerator(ChildWidget);
 
557
      end;
497
558
    end;
498
559
  end;
499
560
end;
504
565
begin
505
566
  if AWinControl.HandleAllocated then
506
567
  begin
507
 
    Widget := PGtkWidget(AWinControl.Handle);
 
568
    Widget := {%H-}PGtkWidget(AWinControl.Handle);
508
569
    FocusWidget := FindFocusWidget(Widget);
509
570
    Result := (FocusWidget <> nil) and GTK_WIDGET_CAN_FOCUS(FocusWidget);
510
571
  end else
516
577
  Widget: PGtkWidget;
517
578
  Geometry: TGdkGeometry;
518
579
begin
519
 
  Widget := PGtkWidget(AWinControl.Handle);
 
580
  Widget := {%H-}PGtkWidget(AWinControl.Handle);
520
581
  if (Widget <> nil) and (GtkWidgetIsA(Widget, gtk_window_get_type)) then
521
582
  begin
522
583
    with Geometry, AWinControl do
544
605
      height_inc := 1;
545
606
      min_aspect := 0;
546
607
      max_aspect := 1;
 
608
      win_gravity := gtk_window_get_gravity(PGtkWindow(Widget));
547
609
    end;
548
610
    //debugln('TGtk2WSWinControl.ConstraintsChange A ',GetWidgetDebugReport(Widget),' max=',dbgs(Geometry.max_width),'x',dbgs(Geometry.max_height));
549
611
    gtk_window_set_geometry_hints(PGtkWindow(Widget), nil, @Geometry,
550
 
                                  GDK_HINT_MIN_SIZE or GDK_HINT_MAX_SIZE);
 
612
      GDK_HINT_POS or GDK_HINT_MIN_SIZE or GDK_HINT_MAX_SIZE);
551
613
  end;
552
614
end;
553
615
 
562
624
  if not WSCheckHandleAllocated(AWinControl, 'Invalidate')
563
625
  then Exit;
564
626
 
565
 
  Assert(false, 'Trace:Trying to invalidate window... !!!');
566
 
  gtk_widget_queue_draw(PGtkWidget(AWinControl.Handle));
 
627
  //DebugLn('Trace:Trying to invalidate window... !!!');
 
628
  gtk_widget_queue_draw({%H-}PGtkWidget(AWinControl.Handle));
567
629
end;
568
630
 
569
631
class procedure TGtk2WSWinControl.ShowHide(const AWinControl: TWinControl);
628
690
class procedure TGtk2WSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCursor);
629
691
var
630
692
  WidgetInfo: PWidgetInfo;
 
693
  NewCursor: HCURSOR;
631
694
begin
632
695
  if not WSCheckHandleAllocated(AWinControl, 'SetCursor')
633
696
  then Exit;
634
697
 
635
 
  WidgetInfo := GetWidgetInfo(Pointer(AWinControl.Handle));
636
 
  if (WidgetInfo^.ControlCursor = ACursor) and
637
 
     (WidgetInfo^.DefaultCursor <> HCursor(-1)) then Exit;
638
698
  if ACursor <> Screen.Cursors[crDefault] then
639
 
    WidgetInfo^.ControlCursor := ACursor
 
699
    NewCursor := ACursor
640
700
  else
 
701
    NewCursor := 0;
 
702
  WidgetInfo := GetWidgetInfo({%H-}Pointer(AWinControl.Handle));
 
703
  if WidgetInfo^.ControlCursor <> NewCursor then
641
704
  begin
642
 
    if WidgetInfo^.DefaultCursor = HCursor(-1) then
643
 
      TGtkPrivateWidgetClass(AWinControl.WidgetSetClass.WSPrivate).SetDefaultCursor(WidgetInfo);
644
 
    WidgetInfo^.ControlCursor := WidgetInfo^.DefaultCursor;
 
705
    WidgetInfo^.ControlCursor := NewCursor;
 
706
    TGtkPrivateWidgetClass(AWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WidgetInfo);
645
707
  end;
646
 
  TGtkPrivateWidgetClass(AWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WidgetInfo);
647
708
end;
648
709
 
649
710
class procedure TGtk2WSWinControl.SetFont(const AWinControl: TWinControl;
654
715
  if not WSCheckHandleAllocated(AWinControl, 'SetFont')
655
716
  then Exit;
656
717
 
657
 
  Widget := PGtkWidget(AWinControl.Handle);
 
718
  Widget := {%H-}PGtkWidget(AWinControl.Handle);
658
719
  if GtkWidgetIsA(Widget, GTKAPIWidget_GetType) then
659
720
    exit;
660
721
 
678
739
  DebugLn(['TGtk2WSWinControl.SetPos ',DbgSName(AWinControl),' ',ALeft,',',ATop]);
679
740
  {$ENDIF}
680
741
 
681
 
  Widget := PGtkWidget(AWinControl.Handle);
 
742
  Widget := {%H-}PGtkWidget(AWinControl.Handle);
682
743
  Allocation.X := gint16(ALeft);
683
744
  Allocation.Y := gint16(ATop);
684
745
  Allocation.Width := guint16(Widget^.Allocation.Width);
698
759
  DebugLn(['TGtk2WSWinControl.SetSize ',DbgSName(AWinControl),' ',AWidth,',',AHeight]);
699
760
  {$ENDIF}
700
761
 
701
 
  Widget := PGtkWidget(AWinControl.Handle);
 
762
  Widget := {%H-}PGtkWidget(AWinControl.Handle);
702
763
  Allocation.X := Widget^.Allocation.X;
703
764
  Allocation.Y := Widget^.Allocation.Y;
704
765
  Allocation.Width := guint16(AWidth);
711
772
  if not WSCheckHandleAllocated(AWinControl, 'SetColor')
712
773
  then Exit;
713
774
 
 
775
  // do not change color of scrollbar. issue #22996
 
776
  if (AWinControl.FCompStyle = csScrollBar) then
 
777
    exit;
 
778
 
714
779
  if ((csOpaque in AWinControl.ControlStyle) and
715
 
      GtkWidgetIsA(pGtkWidget(AWinControl.handle),GTKAPIWidget_GetType)) then
 
780
      GtkWidgetIsA({%H-}pGtkWidget(AWinControl.handle),GTKAPIWidget_GetType)) then
716
781
    Exit;
717
782
 
718
783
  //DebugLn('TGtk2WSWinControl.SetColor ',DbgSName(AWinControl));
719
 
  Gtk2WidgetSet.SetWidgetColor(PGtkWidget(AWinControl.Handle),
 
784
  Gtk2WidgetSet.SetWidgetColor({%H-}PGtkWidget(AWinControl.Handle),
720
785
                              AWinControl.Font.Color, AWinControl.Color,
721
786
                              [GTK_STATE_NORMAL, GTK_STATE_ACTIVE,
722
787
                               GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]);
740
805
    NewText: PChar;
741
806
  begin
742
807
    // dig through the hierachy to get the labels
743
 
    NoteBookWidget:=PGtkWidget((AWinControl.Parent).Handle);
744
 
    PageWidget:=PGtkWidget(AWinControl.Handle);
 
808
    NoteBookWidget:={%H-}PGtkWidget((AWinControl.Parent).Handle);
 
809
    PageWidget:={%H-}PGtkWidget(AWinControl.Handle);
745
810
    TabWidget:=gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget),
746
811
                                          PageWidget);
747
812
    if TabWidget<>nil then
751
816
    MenuWidget:=gtk_notebook_get_menu_label(PGtkNoteBook(NotebookWidget),
752
817
                                            PageWidget);
753
818
    if MenuWidget<>nil then
754
 
      MenuLabelWidget:=gtk_object_get_data(PGtkObject(MenuWidget), 'TabLabel')
 
819
      MenuLabelWidget:=gtk_object_get_data(PGtkObject(MenuWidget), 'TabMenuLabel')
755
820
    else
756
821
      MenuLabelWidget:=nil;
757
822
    // set new text
771
836
 
772
837
  //TODO: create classprocedures for this in the corresponding classes
773
838
 
774
 
  P := Pointer(AWinControl.Handle);
775
 
  Assert(p = nil, 'Trace:WARNING: [TGtkWidgetSet.SetLabel] --> got nil pointer');
776
 
  Assert(False, 'Trace:Setting Str1 in SetLabel');
 
839
  P := {%H-}Pointer(AWinControl.Handle);
 
840
  Assert(p <> nil, 'Trace:WARNING: [TGtkWidgetSet.SetLabel] --> got nil pointer');
 
841
  //DebugLn('Trace:Setting Str1 in SetLabel');
777
842
  pLabel := pchar(AText);
778
843
 
779
844
  case AWinControl.fCompStyle of
791
856
          //Accel := Ampersands2Underscore(aLabel);
792
857
          if gtk_bin_get_child(P) = nil then
793
858
          begin
794
 
            Assert(False, Format('trace:  [TGtkWidgetSet.SetLabel] %s has no child label', [AWinControl.ClassName]));
 
859
            //DebugLn(Format('trace:  [TGtkWidgetSet.SetLabel] %s has no child label', [AWinControl.ClassName]));
795
860
             gtk_container_add(P, gtk_label_new(aLabel));
796
861
          end else
797
862
          begin
798
 
            Assert(False, Format('trace:  [TGtkWidgetSet.SetLabel] %s has child label', [AWinControl.ClassName]));
 
863
            //DebugLn(Format('trace:  [TGtkWidgetSet.SetLabel] %s has child label', [AWinControl.ClassName]));
799
864
            gtk_label_set_text(pgtkLabel( gtk_bin_get_child(P)), aLabel);
800
865
          end;
801
866
          //If Accel <> -1 then
865
930
      // else
866
931
      // DebugLn('WARNING: [TGtkWidgetSet.SetLabel] --> not handled for class ',Sender.ClassName);
867
932
  end;
868
 
  Assert(False, Format('trace:  [TGtkWidgetSet.SetLabel] %s --> END', [AWinControl.ClassName]));
 
933
  //DebugLn(Format('trace:  [TGtkWidgetSet.SetLabel] %s --> END', [AWinControl.ClassName]));
869
934
end;
870
935
 
871
936
class procedure TGtk2WSWinControl.SetShape(const AWinControl: TWinControl;
877
942
  if not WSCheckHandleAllocated(AWinControl, 'SetShape') then
878
943
    Exit;
879
944
 
880
 
  GtkWidget := PGtkWidget(AWinControl.Handle);
 
945
  GtkWidget := {%H-}PGtkWidget(AWinControl.Handle);
881
946
  FixedWidget := GetFixedWidget(GtkWidget);
882
947
 
883
948
  if AShape <> 0 then
884
949
  begin
885
950
    if Gtk2Widgetset.IsValidGDIObjectType(AShape, gdiBitmap) then
886
 
      GdkBitmap := PGdiObject(AShape)^.GDIBitmapObject
 
951
      GdkBitmap := {%H-}PGdiObject(AShape)^.GDIBitmapObject
887
952
    else
888
953
      GdkBitmap := nil;
889
954
  end
903
968
var
904
969
  DC: TGtkDeviceContext absolute ADC;
905
970
 
 
971
  procedure PaintGtkForm(AWindow: PGdkWindow);
 
972
  var
 
973
    W, H: gint;
 
974
    Pixbuf: PGdkPixbuf;
 
975
    MenuPixBuf: PGdkPixBuf;
 
976
    AMenuBar: PGtkWidget;
 
977
    OffsetY: Integer;
 
978
  begin
 
979
    OffsetY := 0;
 
980
    MenuPixBuf := nil;
 
981
 
 
982
    if Assigned(TCustomForm(AWinControl).Menu) then
 
983
    begin
 
984
      AMenuBar := {%H-}PGtkWidget(TCustomForm(AWinControl).Menu.Handle);
 
985
      if GTK_IS_MENU_BAR(AMenuBar) and GTK_WIDGET_VISIBLE(AMenuBar) then
 
986
      begin
 
987
        OffsetY := AMenuBar^.allocation.height;
 
988
        MenuPixbuf := gdk_pixbuf_get_from_drawable(nil, AMenuBar^.Window, nil,
 
989
          0, 0, 0, 0, AMenuBar^.allocation.Width, AMenuBar^.Allocation.Height);
 
990
 
 
991
        gdk_pixbuf_render_to_drawable(MenuPixbuf, DC.Drawable, DC.GC, 0, 0, X, Y + OffsetY,
 
992
          AMenuBar^.allocation.Width, AMenuBar^.Allocation.Height, GDK_RGB_DITHER_NONE, 0, 0);
 
993
 
 
994
        gdk_pixbuf_unref(MenuPixbuf);
 
995
      end;
 
996
    end;
 
997
    gdk_window_get_size(AWindow, @W, @H);
 
998
 
 
999
    Pixbuf := gdk_pixbuf_get_from_drawable(nil, AWindow, nil,
 
1000
      0, 0, 0, 0, W, H);
 
1001
 
 
1002
    // put menubar into form screenshoot too
 
1003
    if OffsetY <> 0 then
 
1004
    begin
 
1005
      MenuPixBuf := gdk_pixbuf_scale_simple(PixBuf, W, H - OffsetY,GDK_INTERP_NEAREST);
 
1006
      gdk_pixbuf_render_to_drawable(MenuPixbuf, DC.Drawable, DC.GC, 0, 0, X, Y + (OffsetY * 2),
 
1007
        -1, -1, GDK_RGB_DITHER_NONE, 0, 0);
 
1008
      if MenuPixBuf <> nil then
 
1009
        gdk_pixbuf_unref(MenuPixBuf);
 
1010
    end else
 
1011
      gdk_pixbuf_render_to_drawable(Pixbuf, DC.Drawable, DC.GC, 0, 0, X, Y,
 
1012
        -1, -1, GDK_RGB_DITHER_NONE, 0, 0);
 
1013
 
 
1014
    gdk_pixbuf_unref(Pixbuf);
 
1015
  end;
 
1016
 
906
1017
  procedure PaintWindow(AWindow: PGdkWindow);
907
1018
  var
908
1019
    W, H: gint;
919
1030
 
920
1031
  procedure PaintWidget(AWidget: PGtkWidget);
921
1032
  var
922
 
    AOffset: TPoint;
923
1033
    AWindow: PGdkWindow;
924
1034
  begin
925
 
    AWindow := GetControlWindow(AWidget);
926
 
 
927
 
    if AWindow <> nil then
928
 
      PaintWindow(AWindow);
 
1035
    if (AWinControl.FCompStyle = csForm) then
 
1036
      PaintGtkForm(AWidget^.window)
 
1037
    else
 
1038
    begin
 
1039
      AWindow := GetControlWindow(AWidget);
 
1040
      if AWindow <> nil then
 
1041
        PaintWindow(AWindow);
 
1042
    end;
929
1043
  end;
930
1044
 
931
1045
begin
932
 
  if not WSCheckHandleAllocated(AWinControl, 'PaintTo')
933
 
  then Exit;
934
 
  PaintWidget(GetFixedWidget(PGtkWidget(AWinControl.Handle)));
 
1046
  if not WSCheckHandleAllocated(AWinControl, 'PaintTo') then
 
1047
    Exit;
 
1048
  PaintWidget(GetFixedWidget({%H-}PGtkWidget(AWinControl.Handle)));
935
1049
end;
936
1050
 
937
1051
{ TGtk2WSBaseScrollingWinControl }
993
1107
  if V < High(Msg.SmallPos)
994
1108
  then Msg.SmallPos := V
995
1109
  else Msg.SmallPos := High(Msg.SmallPos);
996
 
  Msg.ScrollBar := HWND(PtrUInt(ScrollingData^.HScroll));
 
1110
  Msg.ScrollBar := HWND({%H-}PtrUInt(ScrollingData^.HScroll));
997
1111
 
998
1112
  Result := (DeliverMessage(AInfo^.LCLObject, Msg) <> 0) xor CallBackDefaultReturn;
999
1113
end;
1055
1169
  if V < High(Msg.SmallPos)
1056
1170
  then Msg.SmallPos := V
1057
1171
  else Msg.SmallPos := High(Msg.SmallPos);
1058
 
  Msg.ScrollBar := HWND(PtrUInt(ScrollingData^.HScroll));
 
1172
  Msg.ScrollBar := HWND({%H-}PtrUInt(ScrollingData^.HScroll));
1059
1173
 
1060
1174
  Result := (DeliverMessage(AInfo^.LCLObject, Msg) <> 0) xor CallBackDefaultReturn;
1061
1175
end;
1073
1187
  DebugGtkWidgets.MarkCreated(Widget,dbgsName(AWinControl));
1074
1188
  {$ENDIF}
1075
1189
 
1076
 
  Result := THandle(PtrUInt(Widget));
 
1190
  Result := THandle({%H-}PtrUInt(Widget));
1077
1191
  if Result = 0 then Exit;
1078
1192
 
1079
1193
  gtk_widget_show(Widget);