← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/interfaces/gtk2/gtk2callback.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/gtk2callback.inc
32
32
  Result := DeliverMessage(Target, PaintMsg);
33
33
 
34
34
  if (TObject(Target) is TCustomControl) then begin
35
 
    WidgetInfo := GetWidgetInfo(PGtkWidget(TCustomControl(Target).Handle), False);
 
35
    WidgetInfo := GetWidgetInfo({%H-}PGtkWidget(TCustomControl(Target).Handle), False);
36
36
    if WidgetInfo <> nil then
37
37
      WidgetInfo^.UpdateRect := Rect(0,0,0,0);
38
38
  end;
110
110
 
111
111
procedure EventTrace(const TheMessage : string; data : pointer);
112
112
begin
113
 
  if Data = nil then
114
 
    Assert(False, Format('Trace:Event [%s] fired',[Themessage]))
115
 
  else
116
 
    Assert(False, Format('Trace:Event [%s] fired for %s',
117
 
      [TheMessage, TObject(data).Classname]));
 
113
//  if Data = nil then
 
114
    //DebugLn(Format('Trace:Event [%s] fired',[Themessage]))
 
115
//  else
 
116
    //DebugLn(Format('Trace:Event [%s] fired for %s',
 
117
    //  [TheMessage, TObject(data).Classname]));
118
118
end;
119
119
 
120
120
{*************************************************************}
137
137
  if Widget=nil then ;
138
138
  if ComponentIsDestroyingHandle(TWinControl(Data)) then exit;
139
139
  APage:=TCustomPage(Data);
140
 
  TCustomNoteBook(APage.Parent).DoCloseTabClicked(APage);
 
140
  TCustomTabControl(APage.Parent).DoCloseTabClicked(APage);
141
141
end;
142
142
 
143
 
function FilterFuc(xevent: PGdkXEvent; event: PGdkEvent; data: gpointer): TGdkFilterReturn; cdecl;
 
143
function FilterFuc({%H-}xevent: PGdkXEvent; {%H-}event: PGdkEvent; {%H-}data: gpointer): TGdkFilterReturn; cdecl;
 
144
{$ifdef windows}
144
145
var
145
146
  AForm: TCustomForm absolute data;
 
147
{$endif}
146
148
begin
147
149
  Result := GDK_FILTER_CONTINUE;
148
150
  {$ifdef windows}
223
225
function gtkRealizeAfterCB(Widget: PGtkWidget; Data: Pointer): GBoolean; cdecl;
224
226
var
225
227
  WinWidgetInfo: PWidgetInfo;
226
 
  HiddenLCLObject, LCLObject: TObject;
 
228
  LCLObject: TObject;
227
229
  NewEventMask: TGdkEventMask;
228
230
  TheWinControl: TWinControl;
229
231
  ClientWidget: PGtkWidget;
237
239
  EventTrace('realizeafter', nil);
238
240
  {$ENDIF}
239
241
 
240
 
  HiddenLCLObject:=GetHiddenLCLObject(Widget);
241
 
  if HiddenLCLObject=nil then begin
242
 
    // this is a normal lcl wigdet
243
 
 
244
 
    MainWidget:=GetMainWidget(Widget);
245
 
    if MainWidget=nil then
246
 
      MainWidget:=Widget;
247
 
    WinWidgetInfo:=GetWidgetInfo(MainWidget,true);
248
 
    LCLObject:=GetLCLObject(MainWidget);
249
 
    if (LCLObject<>nil) and (WinWidgetInfo<>nil) then begin
250
 
      ClientWidget:=GetFixedWidget(Widget);
251
 
      if (LCLObject is TWinControl) then
252
 
        TheWinControl:=TWinControl(LCLObject)
253
 
      else
254
 
        TheWinControl:=nil;
255
 
 
256
 
      // set extra signal masks after the widget window is created
257
 
      // define extra events we're interrested in
258
 
      //write('GTKRealizeAfterCB ');
259
 
      //if TheWinControl<>nil then DbgOut(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',DbgS(TheWinControl.Handle));
260
 
      //DebugLn(' Widget=',DbgS(Widget),' Fixed=',DbgS(GetFixedWidget(Widget)),' Main=',DbgS(GetMainWidget(Widget)));
261
 
      if (TheWinControl<>nil) then begin
262
 
        //DebugLn(['gtkRealizeAfterCB ',GetWidgetDebugReport(Widget)]);
263
 
        {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
264
 
 
265
 
        NewEventMask:=gdk_window_get_events(GetControlWindow(Widget))
 
242
  MainWidget:=GetMainWidget(Widget);
 
243
  WinWidgetInfo:=GetWidgetInfo(MainWidget,true);
 
244
  LCLObject:=GetLCLObject(MainWidget);
 
245
  if (LCLObject<>nil) and (WinWidgetInfo<>nil) then begin
 
246
    ClientWidget:=GetFixedWidget(Widget);
 
247
    if (LCLObject is TWinControl) then
 
248
      TheWinControl:=TWinControl(LCLObject)
 
249
    else
 
250
      TheWinControl:=nil;
 
251
 
 
252
    // set extra signal masks after the widget window is created
 
253
    // define extra events we're interrested in
 
254
    //write('GTKRealizeAfterCB ');
 
255
    //if TheWinControl<>nil then DbgOut(' ',TheWinControl.Name,':',TheWinControl.ClassName,' ',DbgS(TheWinControl.Handle));
 
256
    //DebugLn(' Widget=',DbgS(Widget),' Fixed=',DbgS(GetFixedWidget(Widget)),' Main=',DbgS(GetMainWidget(Widget)));
 
257
    if (TheWinControl<>nil) then begin
 
258
      //DebugLn(['gtkRealizeAfterCB ',GetWidgetDebugReport(Widget)]);
 
259
      {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF}
 
260
 
 
261
      NewEventMask:=gdk_window_get_events(GetControlWindow(Widget))
 
262
                    or WinWidgetInfo^.EventMask;
 
263
      gtk_widget_add_events(Widget,NewEventMask);
 
264
      gdk_window_set_events(GetControlWindow(Widget),NewEventMask);
 
265
 
 
266
      if (ClientWidget<>nil) and (GetControlWindow(ClientWidget)<>nil)
 
267
      and (GetControlWindow(ClientWidget)<>GetControlWindow(Widget)) then begin
 
268
        //DebugLn(['gtkRealizeAfterCB ClientWindow<>Window']);
 
269
        NewEventMask:=gdk_window_get_events(GetControlWindow(ClientWidget))
266
270
                      or WinWidgetInfo^.EventMask;
267
 
        gtk_widget_add_events(Widget,NewEventMask);
268
 
        gdk_window_set_events(GetControlWindow(Widget),NewEventMask);
269
 
 
270
 
        if (ClientWidget<>nil) and (GetControlWindow(ClientWidget)<>nil)
271
 
        and (GetControlWindow(ClientWidget)<>GetControlWindow(Widget)) then begin
272
 
          //DebugLn(['gtkRealizeAfterCB ClientWindow<>Window']);
273
 
          NewEventMask:=gdk_window_get_events(GetControlWindow(ClientWidget))
274
 
                        or WinWidgetInfo^.EventMask;
275
 
          gtk_widget_add_events(ClientWidget,WinWidgetInfo^.EventMask);
276
 
          gdk_window_set_events(GetControlWindow(ClientWidget),NewEventMask);
277
 
        end;
278
 
        //DebugLn('BBB1 ',DbgS(NewEventMask),8),' ',DbgS(Cardinal(gdk_window_get_events(Widget^.Window)));
279
 
        {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
280
 
      end;
281
 
 
282
 
      if TheWinControl<>nil then 
283
 
      begin
284
 
        TheWinControl.CNPreferredSizeChanged;
285
 
        TGtkPrivateWidgetClass(TheWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WinWidgetInfo);
286
 
        ConnectInternalWidgetsSignals(MainWidget,TheWinControl);
287
 
 
288
 
        if TheWinControl is TCustomPage then
289
 
          UpdateNotebookPageTab(nil,TheWinControl);
290
 
 
291
 
        if TheWinControl is TCustomForm then
292
 
          SetFormShowInTaskbar(TCustomForm(TheWinControl),
293
 
                               TCustomForm(TheWinControl).ShowInTaskbar);
294
 
      end;
295
 
 
296
 
    end;
297
 
  end else begin
298
 
    // this is a hidden child widget of a lcl widget
299
 
    if HiddenLCLObject is TWinControl then
300
 
      ConnectInternalWidgetsSignals(Widget,TWinControl(HiddenLCLObject));
 
271
        gtk_widget_add_events(ClientWidget,WinWidgetInfo^.EventMask);
 
272
        gdk_window_set_events(GetControlWindow(ClientWidget),NewEventMask);
 
273
      end;
 
274
      //DebugLn('BBB1 ',DbgS(NewEventMask),8),' ',DbgS(Cardinal(gdk_window_get_events(Widget^.Window)));
 
275
      {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF}
 
276
    end;
 
277
 
 
278
    if TheWinControl<>nil then
 
279
    begin
 
280
      TheWinControl.CNPreferredSizeChanged;
 
281
      TGtkPrivateWidgetClass(TheWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WinWidgetInfo);
 
282
      ConnectInternalWidgetsSignals(MainWidget,TheWinControl);
 
283
 
 
284
      if TheWinControl is TCustomPage then
 
285
        UpdateNotebookPageTab(nil,TheWinControl);
 
286
 
 
287
      if TheWinControl is TCustomForm then
 
288
        SetFormShowInTaskbar(TCustomForm(TheWinControl),
 
289
                             TCustomForm(TheWinControl).ShowInTaskbar);
 
290
    end;
 
291
 
301
292
  end;
302
293
end;
303
294
 
311
302
  EventTrace('show', data);
312
303
  {$ENDIF}
313
304
  if Widget=nil then ;
314
 
  FillChar(Mess,SizeOf(Mess),0);
 
305
  FillChar(Mess{%H-},SizeOf(Mess),0);
315
306
  Mess.Msg := LM_SHOWWINDOW;
316
307
  Mess.Show := True;
317
308
 
328
319
  EventTrace('hide', data);
329
320
  {$ENDIF}
330
321
  if Widget=nil then ;
331
 
  FillChar(Mess,SizeOf(Mess),0);
 
322
  FillChar(Mess{%H-},SizeOf(Mess),0);
332
323
  Mess.Msg := LM_SHOWWINDOW;
333
324
  Mess.Show := False;
334
325
  Result := DeliverMessage(Data, Mess) = 0;
347
338
  
348
339
  if LockOnChange(PgtkObject(Widget),0) > 0 then Exit;
349
340
 
350
 
  FillChar(Mess,SizeOf(Mess),#0);
 
341
  FillChar(Mess{%H-}, SizeOf(Mess), #0);
351
342
  Mess.Msg := LM_ACTIVATE;
352
 
  Mess.Active:=true;
353
 
  Mess.Minimized:=false;
354
 
  Mess.ActiveWindow:=0;
 
343
  Mess.Active := WA_ACTIVE;
 
344
  Mess.Minimized := False;
355
345
  if GtkWidgetIsA(Widget, gtk_window_get_type) then
356
 
    Mess.ActiveWindow:=HWnd(PtrUInt(PGTKWindow(Widget)^.focus_widget));
 
346
    Mess.ActiveWindow := HWnd({%H-}PtrUInt(PGTKWindow(Widget)^.focus_widget))
 
347
  else
 
348
    Mess.ActiveWindow := 0;
357
349
  Mess.Result := 0;
358
350
  //DebugLn('gtkactivateCB ',DbgSName(TObject(Data)));
359
351
  DeliverMessage(Data, Mess);
399
391
  {$IFDEF EventTrace}
400
392
  EventTrace('changed', data);
401
393
  {$ENDIF}
402
 
  FillChar(Mess, SizeOf(Mess), 0);
 
394
  FillChar(Mess{%H-}, SizeOf(Mess), 0);
403
395
  Mess.Msg := LM_CHANGED;
404
396
  DeliverMessage(Data, Mess);
405
397
end;
406
398
 
 
399
function GtkEntryDelayCursorPos(AGtkWidget: Pointer): GBoolean; cdecl;
 
400
var
 
401
  Info: PWidgetInfo;
 
402
begin
 
403
  Result := AGtkWidget <> nil;
 
404
  if AGtkWidget <> nil then
 
405
  begin
 
406
    g_idle_remove_by_data(AGtkWidget);
 
407
    Info := GetWidgetInfo(AGtkWidget);
 
408
    if Info <> nil then
 
409
      gtkchanged_editbox(PGtkWidget(AGtkWidget),
 
410
        Info^.LCLObject);
 
411
  end;
 
412
end;
 
413
 
407
414
function gtkchanged_editbox( widget: PGtkWidget; data: gPointer) : GBoolean; cdecl;
408
415
var
409
416
  Mess : TLMessage;
421
428
  NeedCursorCheck := False;
422
429
  if GTK_IS_ENTRY(Widget) then
423
430
  begin
424
 
    {cheat GtkEditable to update cursor pos in gtkEntry. issue #7243}
425
 
    gtk_editable_get_selection_bounds(PGtkEditable(Widget), @GStart, @GEnd);
426
 
    EntryText := gtk_entry_get_text(PGtkEntry(Widget));
427
 
    if (GStart = GEnd) and
428
 
      (UTF8Length(EntryText) >= PGtkEntry(Widget)^.text_length) then
 
431
    // lcl-do-not-change-selection comes from gtkKeyPress.
 
432
    // Only floatspinedit sets that data, so default is nil. issue #18679
 
433
    if g_object_get_data(PGObject(Widget),'lcl-do-not-change-selection') = nil then
429
434
    begin
430
 
      Info := GetWidgetInfo(Widget, False);
431
 
      {do not update position if backspace or delete pressed}
432
 
      if wwiInvalidEvent in Info^.Flags then
433
 
        exclude(Info^.Flags, wwiInvalidEvent)
434
 
      else
 
435
      {cheat GtkEditable to update cursor pos in gtkEntry. issue #7243}
 
436
      gtk_editable_get_selection_bounds(PGtkEditable(Widget), @GStart, @GEnd);
 
437
      EntryText := gtk_entry_get_text(PGtkEntry(Widget));
 
438
      if (GStart = GEnd) and
 
439
        (UTF8Length(EntryText) >= PGtkEntry(Widget)^.text_length) then
435
440
      begin
436
 
        // if we change selstart in OnChange event new cursor pos need to
437
 
        // be postponed in TGtk2WSCustomEdit.SetSelStart
438
 
        NeedCursorCheck := True;
439
 
        gtk_editable_set_position(PGtkEditable(Widget), GStart + 1);
 
441
        Info := GetWidgetInfo(Widget, False);
 
442
        {do not update position if backspace or delete pressed}
 
443
        if wwiInvalidEvent in Info^.Flags then
 
444
        begin
 
445
          Exclude(Info^.Flags, wwiInvalidEvent);
 
446
 
 
447
          {take care of pasted data since it does not return proper cursor pos.}
 
448
          // issue #7243
 
449
          if g_object_get_data(PGObject(Widget),'lcl-delay-cm_textchaged') <> nil then
 
450
          begin
 
451
            g_object_set_data(PGObject(Widget),'lcl-delay-cm_textchaged',nil);
 
452
            g_object_set_data(PGObject(Widget),'lcl-gtkentry-pasted-data',Widget);
 
453
            g_idle_add(@GtkEntryDelayCursorPos, Widget);
 
454
            exit;
 
455
          end;
 
456
        end else
 
457
        begin
 
458
          // if we change selstart in OnChange event new cursor pos need to
 
459
          // be postponed in TGtk2WSCustomEdit.SetSelStart
 
460
          NeedCursorCheck := True;
 
461
          if g_object_get_data(PGObject(Widget),'lcl-gtkentry-pasted-data') <> nil then
 
462
          begin
 
463
            g_object_set_data(PGObject(Widget),'lcl-gtkentry-pasted-data',nil);
 
464
            gtk_editable_set_position(PGtkEditable(Widget), GStart);
 
465
          end else
 
466
          begin
 
467
            //NeedCursorCheck := True;
 
468
            if gtk_minor_version < 17 then
 
469
            begin
 
470
              g_object_set_data(PGObject(Widget),'lcl-gtkentry-pasted-data',Widget);
 
471
              g_idle_add(@GtkEntryDelayCursorPos, Widget);
 
472
              exit;
 
473
            end else
 
474
              gtk_editable_set_position(PGtkEditable(Widget), GStart + 1);
 
475
          end;
 
476
        end;
440
477
      end;
441
 
    end;
 
478
    end else
 
479
      g_object_set_data(PGObject(Widget),'lcl-do-not-change-selection', nil);
442
480
  end;
443
481
 
444
482
  if NeedCursorCheck then
445
483
    LockOnChange(PgtkObject(Widget), +1);
446
 
  FillByte(Mess,SizeOf(Mess),0);
 
484
  FillByte(Mess{%H-},SizeOf(Mess),0);
447
485
  Mess.Msg := CM_TEXTCHANGED;
448
486
  DeliverMessage(Data, Mess);
449
487
  if NeedCursorCheck then
451
489
end;
452
490
 
453
491
function gtkchanged_spinbox(widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
 
492
var
 
493
  SValue: String;
 
494
  SNewValue: String;
 
495
  AValue, AMin, AMax: Double;
 
496
  NumDigits: Integer;
 
497
  Mess : TLMessage;
 
498
  ADecimalSeparator: Char;
454
499
begin
455
500
  Result := CallBackDefaultReturn;
456
501
  if LockOnChange(PgtkObject(Widget),0) > 0 then exit;
 
502
 
457
503
  // prior to gtk2-2.12 there's bug with signalling of spin button
458
504
  // which leads to crash.See issue #18554
 
505
  // we are passing this code only for gtk2 >= 2.12
459
506
  if GTK_IS_SPIN_BUTTON(Widget) and (gtk_minor_version >= 12) then
460
 
    gtk_spin_button_update(PGtkSpinButton(Widget));
 
507
  begin
 
508
    NumDigits := gtk_spin_button_get_digits(PGtkSpinButton(Widget));
 
509
    if NumDigits > 0 then
 
510
    begin
 
511
      {$IF FPC_FULLVERSION<20600}
 
512
      ADecimalSeparator := DecimalSeparator;
 
513
      {$ELSE}
 
514
      ADecimalSeparator := DefaultFormatSettings.DecimalSeparator;
 
515
      {$ENDIF}
 
516
      SValue := gtk_entry_get_text(PGtkEntry(Widget));
 
517
 
 
518
      {do not try to parse SValue if it's empty, eg started typing on
 
519
       selected value. issue #23190}
 
520
      if (SValue = '') or (SValue = ',') or
 
521
        (SValue = '.') or (SValue = '+') or
 
522
        (SValue = '-') or (SValue = ADecimalSeparator) then
 
523
      begin
 
524
        FillByte(Mess{%H-},SizeOf(Mess),0);
 
525
        Mess.Msg := CM_TEXTCHANGED;
 
526
        DeliverMessage(Data, Mess);
 
527
        exit;
 
528
      end;
 
529
 
 
530
      SNewValue := SValue;
 
531
      AValue := StrToFloatDef(SValue, 0);
 
532
 
 
533
      {do not freeze (below) if clocale isn't used. issue #23190}
 
534
      if (ADecimalSeparator <> '.') and (Pos('.', SValue) <> 0) then
 
535
      begin
 
536
        SValue := StringReplace(SValue, '.', ADecimalSeparator, [rfReplaceAll]);
 
537
        if (SValue[1] = ADecimalSeparator) then
 
538
          SValue := '0' + SValue;
 
539
        SNewValue := SValue;
 
540
        AValue := StrToFloatDef(SValue, 0);
 
541
      end else
 
542
      if (ADecimalSeparator <> ',') and (Pos(',', SValue) <> 0) then
 
543
      begin
 
544
        SValue := StringReplace(SValue, ',', ADecimalSeparator, [rfReplaceAll]);
 
545
        if (SValue[1] = ADecimalSeparator) then
 
546
          SValue := '0' + SValue;
 
547
        SNewValue := SValue;
 
548
        AValue := StrToFloatDef(SValue, 0);
 
549
      end;
 
550
 
 
551
      gtk_spin_button_get_range(PGtkSpinButton(Widget), @AMin, @AMax);
 
552
 
 
553
 
 
554
      // woohoo
 
555
      // gtk2 have different meaning how validator should work and trigger
 
556
      // so we change it. #18679
 
557
      // do not use while loop, but assign to minimum or maximum allowed. #23190
 
558
      if (AValue < AMin) or (AValue > AMax) then
 
559
      begin
 
560
        if AValue < AMin then
 
561
          SValue := FloatToStr(AMin);
 
562
        if AValue > AMax then
 
563
          SValue := FloatToStr(AMax);
 
564
        AValue := StrToFloatDef(SValue, 0);
 
565
      end;
 
566
      if (Pos(ADecimalSeparator, SValue) > 0) and (length(SValue) > 1) then
 
567
      begin
 
568
        SNewValue := Copy(SValue,Pos(ADecimalSeparator, SValue) + 1, length(SValue));
 
569
        while length(SNewValue) > NumDigits do
 
570
        begin
 
571
          Delete(SValue, length(SValue), 1);
 
572
          inc(NumDigits);
 
573
        end;
 
574
      end;
 
575
      if SNewValue <> SValue then
 
576
        gtk_entry_set_text(PGtkEntry(Widget), PChar(SValue));
 
577
 
 
578
      // inform LCL about our changes to entry
 
579
      FillByte(Mess{%H-},SizeOf(Mess),0);
 
580
      Mess.Msg := CM_TEXTCHANGED;
 
581
      DeliverMessage(Data, Mess);
 
582
    end else
 
583
      // always signal update to pure TSpinEdit
 
584
      gtk_spin_button_update(PGtkSpinButton(Widget));
 
585
  end;
461
586
end;
462
587
 
463
588
function gtkchanged_editbox_backspace(widget: PGtkWidget;
609
734
  //DebugLn(['gtkExposeEventAfter ',GetWidgetDebugReport(Widget),' ',dbgGRect(@Event^.Area)]);
610
735
 
611
736
  DeliverGtkPaintMessage(Data,Widget,@Event^.Area,false,true);
612
 
 
613
 
  // Some widgets in gtk2 don't have their own exclusive "windows" so a synthetic event must be sent
614
 
  // MG: That is already done by the gtk2. For which widgets does this not work?
615
 
  //     Enabling this results in double painting, which is slower and
616
 
  //     wrong for anitaliased text.
617
 
  {if GTK_IS_FIXED(Widget) then begin
618
 
    children := gtk_container_get_children(PGtkContainer(Widget));
619
 
    while children <> nil do begin
620
 
      if (children^.data <> nil) then begin
621
 
        if GTK_WIDGET_NO_WINDOW(PGtkWidget(children^.data)) then
622
 
          gtk_container_propagate_expose(PGtkContainer(Widget), PGtkWidget(children^.data), Event);
623
 
        if children^.next = nil then break;
624
 
        children := children^.next;
625
 
      end;
626
 
    end;
627
 
    g_list_free(children);
628
 
  end;}
629
737
end;
630
738
 
631
739
function gtkfrmactivateAfter(widget: PGtkWidget; Event : PgdkEventFocus;
644
752
  if (Widget=nil) or (Event=nil) then ;
645
753
 
646
754
  ResetDefaultIMContext;
647
 
  UpdateMouseCaptureControl;
648
755
 
649
 
  FillChar(Mess,SizeOf(Mess),#0);
 
756
  FillChar(Mess{%H-},SizeOf(Mess),#0);
650
757
  {$IFDEF VerboseFocus}
651
758
  write('gtkfrmactivateAfter Widget=',DbgS(Widget),' Event^.theIn=',Event^._in);
652
759
  LCLObject:=TObject(data);
682
789
    if (Info <> nil) then
683
790
      Include(Info^.Flags, wwiActivating);
684
791
    Mess.Msg := LM_ACTIVATE;
685
 
    Mess.Active := True;
 
792
    Mess.Active := WA_ACTIVE;
686
793
    Mess.Minimized := False;
687
 
    Mess.ActiveWindow := 0;
688
794
    if GtkWidgetIsA(Widget, gtk_window_get_type) then
689
 
      Mess.ActiveWindow := HWnd(PtrUInt(PGTKWindow(Widget)^.focus_widget));
 
795
      Mess.ActiveWindow := HWnd({%H-}PtrUInt(PGTKWindow(Widget)^.focus_widget))
 
796
    else
 
797
      Mess.ActiveWindow := 0;
690
798
    Mess.Result := 0;
691
799
    DeliverMessage(Data, Mess); // send message directly (not Post)
692
800
  finally
720
828
    DebugLn(' LCLObject=nil');
721
829
  {$ENDIF}
722
830
  ResetDefaultIMContext;
723
 
  UpdateMouseCaptureControl;
724
831
 
725
 
  Info:=GetWidgetInfo(Widget,false);
 
832
  Info := GetWidgetInfo(Widget,false);
726
833
  try
727
834
    if (Info<>nil) then
728
 
      Include(Info^.Flags,wwiDeactivating);
729
 
    Mess.Msg := LM_DEACTIVATE;
 
835
      Include(Info^.Flags, wwiDeactivating);
 
836
    FillChar(Mess{%H-}, SizeOf(Mess), #0);
 
837
    Mess.Msg := LM_ACTIVATE;
 
838
    Mess.Active := WA_INACTIVE;
 
839
    Mess.Minimized := False;
 
840
    Mess.ActiveWindow := 0;
 
841
    Mess.Result := 0;
730
842
    DeliverMessage(Data, Mess);
731
843
  finally
732
844
    if Info<>nil then
733
 
      Exclude(Info^.Flags,wwiDeactivating);
 
845
      Exclude(Info^.Flags, wwiDeactivating);
734
846
  end;
735
847
 
736
848
  Result := CallBackDefaultReturn;
774
886
    if AVKeyCode = 0 then Exit;
775
887
    if APressed
776
888
    then begin
777
 
      if KeyStateList.IndexOf(Pointer(PtrInt(AVKeyCode))) < 0
778
 
      then KeyStateList.Add(Pointer(PtrInt(AVKeyCode)));
 
889
      if KeyStateList.IndexOf({%H-}Pointer(PtrUInt(AVKeyCode))) < 0
 
890
      then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode)));
779
891
    end
780
892
    else begin
781
 
      KeyStateList.Remove(Pointer(PtrInt(AVKeyCode)));
 
893
      KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode)));
782
894
    end;
783
895
  end;
784
896
 
810
922
  end;
811
923
end;
812
924
 
 
925
type
 
926
  TCustomEditHack = class(TCustomEdit);
 
927
 
813
928
function GTKFocusCB(widget: PGtkWidget; event: PGdkEventFocus; data: gPointer): GBoolean; cdecl;
814
929
var
815
930
  Mess : TLMessage;
819
934
  CurFocusWidget: PGtkWidget;
820
935
{$ENDIF}
821
936
  Mask: TGdkModifierType;
 
937
  AInfo: PWidgetInfo;
822
938
begin
823
939
  {$IFDEF EventTrace}
824
940
  EventTrace('focus', data);
885
1001
    end;
886
1002
  end;
887
1003
 
 
1004
  // we do not show selection (gtk behaviour) when widget is unfocused,
 
1005
  // so revert back CursorPos.issues #18164,#21897,#23182
 
1006
  if GtkWidgetIsA(Widget, gtk_type_entry) then
 
1007
  begin
 
1008
    AInfo := GetWidgetInfo(Widget);
 
1009
    if AInfo <> nil then
 
1010
    begin
 
1011
      if (AInfo^.LCLObject is TCustomEdit) and
 
1012
        not TCustomEditHack(AInfo^.LCLObject).AutoSelect then
 
1013
      if (AInfo^.CursorPos > 0) or (AInfo^.SelLength > 0) then
 
1014
      begin
 
1015
        // gtk_entry_set_position(PGtkEntry(Widget), AInfo^.CursorPos);
 
1016
        // gtk_editable_select_region(PGtkEditable(Widget), AInfo^.CursorPos, AInfo^.CursorPos);
 
1017
        // do not trigger signals, only update pos for lcl
 
1018
        PGtkEntry(Widget)^.current_pos := AInfo^.CursorPos;
 
1019
        PGtkEntry(Widget)^.selection_bound := AInfo^.CursorPos + AInfo^.SelLength;
 
1020
      end;
 
1021
    end;
 
1022
  end;
 
1023
 
888
1024
  ResetDefaultIMContext;
889
 
  UpdateMouseCaptureControl;
890
1025
 
891
1026
  //TODO: fill in old focus
892
 
  FillChar(Mess, SizeOf(Mess), 0);
 
1027
  FillChar(Mess{%H-}, SizeOf(Mess), 0);
893
1028
  Mess.msg := LM_SETFOCUS;
894
1029
  DeliverMessage(Data,  Mess);
895
1030
 
939
1074
  end;
940
1075
  DebugLn('');
941
1076
  {$ENDIF}
942
 
 
943
 
  // do not release capture widget here, as this will interfere
944
 
  //ReleaseCaptureWidget(Widget);
945
 
 
946
1077
  Result:=CallBackDefaultReturn;
947
1078
end;
948
1079
 
 
1080
function GtkEntryDelayClearCursorPos(AGtkWidget: Pointer): GBoolean; cdecl;
 
1081
var
 
1082
  Info: PWidgetInfo;
 
1083
  //AStart,AEnd: gint;
 
1084
begin
 
1085
  Result := AGtkWidget <> nil;
 
1086
  if AGtkWidget <> nil then
 
1087
  begin
 
1088
    g_idle_remove_by_data(AGtkWidget);
 
1089
    Info := GetWidgetInfo(AGtkWidget);
 
1090
    if Info <> nil then
 
1091
    begin
 
1092
      //gtk_editable_get_selection_bounds(PGtkEditable(AGtkWidget),@AStart, @AEnd);
 
1093
      //Info^.CursorPos := AEnd;
 
1094
      gtk_editable_select_region(PGtkEditable(AGtkWidget), 0, 0);
 
1095
    end;
 
1096
  end;
 
1097
end;
 
1098
 
949
1099
function GTKKillFocusCBAfter(widget: PGtkWidget; event:PGdkEventFocus;
950
1100
  data: gPointer) : GBoolean; cdecl;
951
1101
var
952
1102
  Mess : TLMessage;
 
1103
  Info: PWidgetInfo;
 
1104
  AStart,AEnd: gint;
953
1105
{$IFDEF VerboseFocus}
954
1106
  LCLObject: TObject;
955
1107
  CurFocusWidget: PGtkWidget;
992
1144
  {$ENDIF}
993
1145
 
994
1146
  ResetDefaultIMContext;
995
 
  UpdateMouseCaptureControl;
996
1147
 
997
 
  FillChar(Mess,SizeOf(Mess),0);
 
1148
  FillChar(Mess{%H-},SizeOf(Mess),0);
998
1149
  Mess.msg := LM_KILLFOCUS;
999
1150
  // do not release the capture widget here
1000
1151
 
1001
1152
  //TODO: fill in new focus
1002
 
  Assert(False, Format('Trace:TODO: [gtkkillfocusCB] %s  finish', [TObject(Data).ClassName]));
 
1153
  //DebugLn(Format('Trace:TODO: [gtkkillfocusCB] %s  finish', [TObject(Data).ClassName]));
1003
1154
  
1004
1155
  DeliverMessage(Data,  Mess);
1005
1156
 
 
1157
  // do not show selection when widget is unfocused
 
1158
  // issues #18164,#21897,#23182
 
1159
  if GtkWidgetIsA(Widget, gtk_type_entry) then
 
1160
  begin
 
1161
    g_idle_add(@GtkEntryDelayClearCursorPos, Widget);
 
1162
    //save now CursorPos and SelStart in WidgetInfo
 
1163
    if (Widget <> nil) then
 
1164
    begin
 
1165
      Info := GetWidgetInfo(Widget);
 
1166
      if Info <> nil then
 
1167
      begin
 
1168
        if (Info^.LCLObject is TCustomEdit) and
 
1169
          not TCustomEditHack(Info^.LCLObject).AutoSelect then
 
1170
        begin
 
1171
          gtk_editable_get_selection_bounds(PGtkEditable(Widget),@AStart, @AEnd);
 
1172
          Info^.CursorPos := Min(AStart, AEnd);
 
1173
          Info^.SelLength := Abs(AEnd - AStart);
 
1174
        end;
 
1175
      end;
 
1176
    end;
 
1177
  end;
 
1178
 
1006
1179
  Result:=true;
1007
1180
end;
1008
1181
 
1069
1242
            end;
1070
1243
          end;
1071
1244
          {$ENDIF}
1072
 
          SizeMsg.SizeType := SIZEICONIC;
 
1245
          SizeMsg.SizeType := SIZE_MINIMIZED;
1073
1246
        end
1074
1247
        else if (GDK_WINDOW_STATE_MAXIMIZED and state^.new_window_state)>0 then
1075
1248
        begin
1076
1249
          // it can be both maximized + iconified and just loose iconified state
1077
1250
          if (state^.changed_mask and (GDK_WINDOW_STATE_MAXIMIZED or GDK_WINDOW_STATE_ICONIFIED)) = 0 then Exit;
1078
 
          SizeMsg.SizeType := SIZEFULLSCREEN;
 
1251
          SizeMsg.SizeType := SIZE_MAXIMIZED;
1079
1252
        end
1080
1253
        else
1081
 
          SizeMsg.SizeType := SIZENORMAL;
 
1254
          SizeMsg.SizeType := SIZE_RESTORED;
1082
1255
 
1083
1256
        if (TheForm = Application.MainForm) and
1084
 
          (SizeMsg.SizeType <> SIZEICONIC) and
 
1257
          (SizeMsg.SizeType <> SIZE_MINIMIZED) and
1085
1258
          (TheForm.WindowState = wsMinimized) then
1086
1259
            Application.IntfAppRestore;
1087
1260
 
1088
1261
        // don't bother the LCL if nothing changed
1089
1262
        case SizeMsg.SizeType of
1090
 
          SIZENORMAL: if TheForm.WindowState=wsNormal then exit;
1091
 
          SIZEICONIC: if TheForm.WindowState=wsMinimized then exit;
1092
 
          SIZEFULLSCREEN: if TheForm.WindowState=wsMaximized then exit;
 
1263
          SIZE_RESTORED: if TheForm.WindowState=wsNormal then exit;
 
1264
          SIZE_MINIMIZED: if TheForm.WindowState=wsMinimized then exit;
 
1265
          SIZE_MAXIMIZED: if TheForm.WindowState=wsMaximized then exit;
 
1266
          SIZE_FULLSCREEN: if TheForm.WindowState=wsFullScreen then exit;
1093
1267
        end;
1094
1268
 
1095
1269
        with SizeMsg do
1110
1284
        DeliverMessage(TheForm, SizeMsg);
1111
1285
        if (gtk_major_version = 2) and (gtk_minor_version <= 8) and
1112
1286
          (TheForm.WindowState = wsMaximized) then
1113
 
            gtk_widget_queue_draw(PGtkWidget(TheForm.Handle));
 
1287
            gtk_widget_queue_draw({%H-}PGtkWidget(TheForm.Handle));
1114
1288
      end;
1115
1289
    end;
1116
1290
  end;
1139
1313
      FreeWidgetInfo(Widget);
1140
1314
      Exit;
1141
1315
    end else
1142
 
    if (PGtkWidget(TWinControl(Data).Handle) <> Widget) then // the TWinControl does not use this widget anymore.
 
1316
    if ({%H-}PGtkWidget(TWinControl(Data).Handle) <> Widget) then // the TWinControl does not use this widget anymore.
1143
1317
      Exit;
1144
1318
  end;
1145
1319
 
1147
1321
  EventTrace('destroyCB', data);
1148
1322
  {$ENDIF}
1149
1323
  //DebugLn('gtkdestroyCB Data="',DbgSName(TObject(Data)),'" LCLObject="',DbgSName(Info^.LCLObject),'" ',GetWidgetDebugReport(Widget));
1150
 
  FillChar(Mess, SizeOf(Mess), 0);
 
1324
  FillChar(Mess{%H-}, SizeOf(Mess), 0);
1151
1325
  Mess.msg := LM_DESTROY;
1152
1326
  DeliverMessage(Data, Mess);
1153
1327
 
1159
1333
 
1160
1334
procedure DestroyWindowFromPointCB(Widget: PGtkWidget; data: gPointer); cdecl;
1161
1335
begin
1162
 
  if PGtkWidget(LastWFPResult) <> Widget then Exit;
 
1336
  if {%H-}PGtkWidget(LastWFPResult) <> Widget then Exit;
1163
1337
  LastWFPResult := 0;
1164
1338
  LastWFPMousePos := Point(High(Integer), High(Integer));
1165
1339
end;
1168
1342
  data : gPointer) : GBoolean; cdecl;
1169
1343
var Mess : TLMessage;
1170
1344
begin
1171
 
  FillChar(Mess,SizeOf(Mess),0);
 
1345
  FillChar(Mess{%H-},SizeOf(Mess),0);
1172
1346
  if (Widget=nil) or (Event=nil) then ;
1173
1347
  Mess.Msg:= LM_CLOSEQUERY;
1174
1348
  { Message results : True - do nothing, False - destroy or hide window }
1186
1360
  {$ENDIF}
1187
1361
//   Mess.msg := LM_RESIZE;
1188
1362
//   TControl(data).WindowProc(TLMessage(Mess));
1189
 
  Assert(False, 'Trace:TODO: [gtkresizeCB] fix (or remove) to new LM_SIZE');
 
1363
  //DebugLn('Trace:TODO: [gtkresizeCB] fix (or remove) to new LM_SIZE');
1190
1364
//TObject(data).Dispatch(Mess);
1191
1365
end;
1192
1366
 
1199
1373
  {$IFDEF EventTrace}
1200
1374
  EventTrace('month changed', data);
1201
1375
  {$ENDIF}
1202
 
  FillChar(Mess,SizeOf(Mess),0);
 
1376
  FillChar(Mess{%H-},SizeOf(Mess),0);
1203
1377
  Mess.Msg := LM_MONTHCHANGED;
1204
1378
  DeliverPostMessage(Data, Mess);
1205
1379
 
1238
1412
begin
1239
1413
  MappedXY := TranslateGdkPointToClientArea(Event^.Window,
1240
1414
                               Point(TruncToInt(Event^.X), TruncToInt(Event^.Y)),
1241
 
                               PGtkWidget(AWinControl.Handle));
1242
 
  MappedXY := SubtractScoll(PGtkWidget(AWinControl.Handle), MappedXY);
 
1415
                               {%H-}PGtkWidget(AWinControl.Handle));
 
1416
  MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY);
1243
1417
 
1244
1418
  ShiftState := GTKEventStateToShiftState(Event^.State);
1245
1419
  with Msg do
1257
1431
  // send the message directly to the LCL
1258
1432
  // (Posting the message via queue
1259
1433
  //  has the risk of getting out of sync with the gtk)
1260
 
  NotifyApplicationUserInput(Msg.Msg);
 
1434
  NotifyApplicationUserInput(AWinControl, Msg.Msg);
1261
1435
  //DebugLn(['DeliverMouseMoveMessage ',dbgsName(AWinControl)]);
1262
1436
  DeliverMessage(AWinControl, Msg);
 
1437
 
 
1438
  // if dragmanager is started later then inform g_object issue #19914
 
1439
  if GTK_IS_NOTEBOOK({%H-}PGtkWidget(AWinControl.Handle)) and
 
1440
    DragManager.IsDragging and
 
1441
    (g_object_get_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging') = nil)
 
1442
    then
 
1443
      g_object_set_data({%H-}PGObject(AWinControl.Handle),
 
1444
        'lclnotebookdragging', gpointer(PtrInt(1)));
 
1445
end;
 
1446
 
 
1447
procedure FixListViewRubberBand(AWidget: PGtkWidget);
 
1448
var
 
1449
  Info: PWidgetInfo;
 
1450
  IconView: PGtkIconView;
 
1451
  Priv: _PGtkIconViewPrivate;
 
1452
begin
 
1453
  Info := GetWidgetInfo(AWidget);
 
1454
  IconView := PGtkIconView(Info^.CoreWidget);
 
1455
  Priv := IconView^.priv;
 
1456
 
 
1457
  if Priv^.doing_rubberband then
 
1458
  begin
 
1459
    Priv^.doing_rubberband := False;
 
1460
    gtk_widget_queue_draw(AWidget);
 
1461
  end;
1263
1462
end;
1264
1463
 
1265
1464
{-------------------------------------------------------------------------------
1266
1465
  function ControlGetsMouseMoveBefore(AControl: TControl): boolean;
1267
1466
 
1268
 
  Returns true, if mouse move event should be sent before the widget istelf
 
1467
  Returns true, if mouse move event should be sent before the widget itself
1269
1468
  reacts.
1270
1469
-------------------------------------------------------------------------------}
1271
 
function ControlGetsMouseMoveBefore(AControl: TControl): boolean;
 
1470
function ControlGetsMouseMoveBefore(AControl: TControl;
 
1471
  const ABefore: Boolean; Event: PGDKEventMotion): boolean;
 
1472
var
 
1473
  ShiftState: TShiftState;
 
1474
  Widget: PGtkWidget;
 
1475
  MainView: PGtkWidget;
1272
1476
begin
1273
1477
  if (AControl=nil) then ;
 
1478
  Result := True;
1274
1479
  // currently there are no controls, that need after events.
1275
 
  Result:=true;
 
1480
  if not ABefore then exit;
 
1481
 
 
1482
  // gtk2 column resizing ... issue #21354
 
1483
  if (Event <> nil) and not (csDesigning in AControl.ComponentState) and
 
1484
    (AControl is TListView) and
 
1485
    (TListView(AControl).ViewStyle = vsReport) and
 
1486
    (TListView(AControl).ShowColumnHeaders) then
 
1487
  begin
 
1488
    ShiftState := GTKEventStateToShiftState(Event^.State);
 
1489
    if ssLeft in ShiftState then
 
1490
    begin
 
1491
      Widget := {%H-}PGtkWidget(TWinControl(AControl).Handle);
 
1492
      if GTK_IS_SCROLLED_WINDOW(Widget) then
 
1493
      begin
 
1494
        MainView := gtk_bin_get_child(PGtkBin(Widget));
 
1495
        if GTK_IS_TREE_VIEW(MainView) then
 
1496
        begin
 
1497
          // here we are
 
1498
          if gtk_tree_view_get_bin_window(PGtkTreeView(MainView)) <> Event^.window then
 
1499
            Result := False;
 
1500
          //TODO: queue column resize when x < 0
 
1501
          // gtk_tree_view_column_queue_resize(tree_column: PGtkTreeViewColumn)
 
1502
        end;
 
1503
      end;
 
1504
    end;
 
1505
  end else
 
1506
  if (Event <> nil) and not (csDesigning in AControl.ComponentState) and
 
1507
    (AControl is TWinControl) and
 
1508
    (TWinControl(AControl).FCompStyle = csListView) and
 
1509
    (TListView(AControl).ViewStyle in [vsIcon, vsSmallIcon]) and
 
1510
    TListView(AControl).MultiSelect then
 
1511
  begin
 
1512
    ShiftState := GTKEventStateToShiftState(Event^.State);
 
1513
    // issue #22991 - this fixes rubberbanding
 
1514
    if [ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble] * ShiftState = [] then
 
1515
      FixListViewRubberBand(PGtkWidget(TWinControl(AControl).Handle));
 
1516
  end;
1276
1517
end;
1277
1518
 
1278
1519
procedure GTKGetDevicePointer(win: PGdkWindow; dev: PGdkDevice;
1328
1569
    );
1329
1570
  {$ENDIF}
1330
1571
 
1331
 
  UpdateMouseCaptureControl;
1332
 
  
1333
1572
  ShiftState := GTKEventStateToShiftState(Event^.State);
1334
1573
 
1335
1574
  if (ShiftState*[ssShift, ssCtrl, ssAlt, ssSuper] <> LastModifierKeys) or NeedShiftUpdateAfternFocus
1341
1580
      UpdateShiftState(TGtk2WidgetSet(WidgetSet).KeyStateList, LastModifierKeys);
1342
1581
  end;
1343
1582
 
1344
 
  if (MouseCaptureWidget = Widget) and (MouseCaptureType = mctGTK) and
1345
 
    ([ssLeft,ssRight,ssMiddle]*ShiftState=[]) then
 
1583
  if (MouseCaptureWidget = Widget) and ([ssLeft,ssRight,ssMiddle]*ShiftState=[]) then
1346
1584
  begin
1347
1585
    {$IFDEF VerboseMouseCapture}
1348
1586
    DebugLn(['gtkMotionNotify gtk capture without mouse down: ',GetWidgetDebugReport(Widget)]);
1353
1591
  begin
1354
1592
    DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMouseMotion);
1355
1593
    if DesignOnlySignal then exit;
1356
 
    if not ControlGetsMouseMoveBefore(TControl(Data)) then exit;
 
1594
    if not ControlGetsMouseMoveBefore(TControl(Data), True, Event) then exit;
1357
1595
  end else
1358
1596
  begin
1359
1597
    // stop the signal, so that the widget does not auto react
1362
1600
  end;
1363
1601
 
1364
1602
  ACtl := TWinControl(Data);
1365
 
  if not (csCaptureMouse in ACtl.ControlStyle) and
 
1603
  if not (csDesigning in ACtl.ComponentState) and
 
1604
     not (csCaptureMouse in ACtl.ControlStyle) and
1366
1605
    ([ssLeft,ssRight,ssMiddle]*ShiftState <> []) and
1367
 
    not (ACtl is TCustomForm) and not DragManager.IsDragging then
 
1606
    not (ACtl is TCustomForm) and not (ACtl is TScrollBar)
 
1607
    and not DragManager.IsDragging then
1368
1608
  begin
1369
1609
    if (Event^.x < 0) or (Event^.y < 0) or
1370
1610
      (Event^.x > ACtl.Width) or (Event^.y > ACtl.Height) then
1399
1639
  // stop the signal, so that it is not sent to the parent widgets
1400
1640
  g_signal_stop_emission_by_name(PGTKObject(Widget),'motion-notify-event');
1401
1641
 
1402
 
  UpdateMouseCaptureControl;
1403
 
 
1404
1642
  if (csDesigning in TComponent(Data).ComponentState) then exit;
1405
 
  if ControlGetsMouseMoveBefore(TControl(Data)) then exit;
 
1643
  if ControlGetsMouseMoveBefore(TControl(Data), True, Event) then exit;
1406
1644
 
1407
1645
  DeliverMouseMoveMessage(Widget,Event, TWinControl(Data));
1408
1646
end;
1409
1647
 
 
1648
 
 
1649
// restore old column sizing after dblclick. issue #18381
 
1650
function ReturnColumnSizing(AGtkWidget: Pointer): gboolean; cdecl;
 
1651
var
 
1652
  AIndex: PtrInt;
 
1653
  ASizing: TGtkTreeViewColumnSizing;
 
1654
  Column: PGtkTreeViewColumn;
 
1655
  ColWidth: gint;
 
1656
begin
 
1657
  Result := AGtkWidget <> nil;
 
1658
  if AGtkWidget <> nil then
 
1659
  begin
 
1660
    if g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick') <> nil then
 
1661
    begin
 
1662
      AIndex := {%H-}PtrInt(g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick') - 1);
 
1663
      ASizing := TGtkTreeViewColumnSizing({%H-}PtrUInt(g_object_get_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick-oldsizing')) - 1);
 
1664
      g_object_set_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick', nil);
 
1665
      g_object_set_data(PGObject(AGtkWidget),'lcl-column-resized-dblclick-oldsizing', nil);
 
1666
      if (AIndex >= 0) then
 
1667
      begin
 
1668
        Column := gtk_tree_view_get_column(PGtkTreeView(AGtkWidget), AIndex);
 
1669
        ColWidth := gtk_tree_view_column_get_width(Column);
 
1670
        gtk_tree_view_column_set_sizing(Column, ASizing);
 
1671
        gtk_tree_view_column_set_fixed_width(Column, ColWidth);
 
1672
      end;
 
1673
    end;
 
1674
    g_idle_remove_by_data(AGtkWidget);
 
1675
  end;
 
1676
end;
 
1677
 
 
1678
{resizes column to like autosize does when dblclicked separator. issue #18381}
 
1679
function ResizeColumnOnDblClick({%H-}ACtl: TWinControl; ScrolledWin: PGtkWidget;
 
1680
  TreeView: PGtkTreeView; const AMouseCoord: TPoint): Boolean;
 
1681
var
 
1682
  Adjustment: PGtkAdjustment;
 
1683
  List: PGList;
 
1684
  Column: PGtkTreeViewColumn;
 
1685
  i, Accu: PtrInt;
 
1686
  xoffset: Integer;
 
1687
  Pt: TPoint;
 
1688
  CurSizing: TGtkTreeViewColumnSizing;
 
1689
  ColIndex: Integer;
 
1690
  ColWidth: Integer;
 
1691
begin
 
1692
  Result := True;
 
1693
  Pt := AMouseCoord;
 
1694
  Accu := 0;
 
1695
  ColIndex := -1;
 
1696
  // think about horizontal scrollbar position too !
 
1697
  Adjustment := gtk_scrolled_window_get_hadjustment(PGtkScrolledWindow(ScrolledWin));
 
1698
  if Adjustment <> nil then
 
1699
    xoffset := Round(gtk_adjustment_get_value(Adjustment))
 
1700
  else
 
1701
    xoffset := 0;
 
1702
 
 
1703
  List := gtk_tree_view_get_columns(TreeView);
 
1704
  try
 
1705
    for i := 0 to g_list_length(List) - 1 do
 
1706
    begin
 
1707
      Column := g_list_nth_data(List, i);
 
1708
      if Column = nil then
 
1709
        continue;
 
1710
      if gtk_tree_view_column_get_visible(Column) then
 
1711
      begin
 
1712
        ColWidth := gtk_tree_view_column_get_width(Column);
 
1713
        if (Accu + ColWidth + 3 >= Pt.X + xoffset) then
 
1714
        begin
 
1715
          // DebugLn('NOTICE: GtkTreeView column resizing on dblclick ',i);
 
1716
          CurSizing := gtk_tree_view_column_get_sizing(Column);
 
1717
          if gtk_tree_view_column_get_resizable(Column) and
 
1718
            (CurSizing <> GTK_TREE_VIEW_COLUMN_AUTOSIZE) then
 
1719
          begin
 
1720
            gtk_tree_view_column_set_sizing(Column, GTK_TREE_VIEW_COLUMN_AUTOSIZE);
 
1721
            gtk_tree_view_column_set_resizable(Column, True);
 
1722
 
 
1723
            ColIndex := i;
 
1724
            // we are adding i + 1 since if i = 0 then ptr is null !
 
1725
            g_object_set_data(PGObject(TreeView),'lcl-column-resized-dblclick', {%H-}GPointer(ColIndex + 1));
 
1726
            Accu := Ord(CurSizing);
 
1727
            // we are adding Accu + 1 since if Accu = 0 then ptr is null !
 
1728
            g_object_set_data(PGObject(TreeView),'lcl-column-resized-dblclick-oldsizing', {%H-}GPointer(Accu + 1));
 
1729
            Accu := g_idle_add(@ReturnColumnSizing, TreeView);
 
1730
            break;
 
1731
          end;
 
1732
          break;
 
1733
        end;
 
1734
        Accu := Accu + ColWidth + 3 {section separator offset};
 
1735
      end;
 
1736
    end;
 
1737
    Result := not (ColIndex >= 0);
 
1738
  finally
 
1739
    g_list_free(List);
 
1740
  end;
 
1741
end;
 
1742
 
1410
1743
{-------------------------------------------------------------------------------
1411
1744
  function ControlGetsMouseDownBefore(AControl: TControl): boolean;
1412
1745
 
1414
1747
  reacts.
1415
1748
-------------------------------------------------------------------------------}
1416
1749
function ControlGetsMouseDownBefore(AControl: TControl;
1417
 
  AWidget: PGtkWidget): boolean;
 
1750
  {%H-}AWidget: PGtkWidget; Event : PGdkEventButton): boolean;
 
1751
var
 
1752
  Widget: PGtkWidget;
 
1753
  MainView: PGtkWidget;
 
1754
  Pt: TPoint;
1418
1755
begin
1419
 
  Result:=true;
1420
 
  if AControl=nil then exit;
1421
 
  if GtkWidgetIsA(AWidget,gtk_toggle_button_get_type) then begin
 
1756
  Result := True;
 
1757
  if AControl = nil then exit;
 
1758
 
 
1759
  if not (csDesigning in AControl.ComponentState) and
 
1760
    (Event^.button = 1) and
 
1761
    (gdk_event_get_type(Event) = GDK_2BUTTON_PRESS) and
 
1762
    (AControl is TWinControl) and
 
1763
    (TWinControl(AControl).FCompStyle = csListView) and
 
1764
    (TListView(AControl).ViewStyle = vsReport) and
 
1765
    (TListView(AControl).ShowColumnHeaders) then
 
1766
  begin
 
1767
    Widget := {%H-}PGtkWidget(TWinControl(AControl).Handle);
 
1768
    if GTK_IS_SCROLLED_WINDOW(Widget) then
 
1769
    begin
 
1770
      MainView := gtk_bin_get_child(PGtkBin(Widget));
 
1771
      if GTK_IS_TREE_VIEW(MainView) then
 
1772
      begin
 
1773
        if gtk_tree_view_get_bin_window(PGtkTreeView(MainView)) <> Event^.window then
 
1774
        begin
 
1775
          Pt.X := Round(Event^.x_root);
 
1776
          Pt.Y := Round(Event^.y_root);
 
1777
          ScreenToClient(TWinControl(AControl).Handle, Pt);
 
1778
          Result := ResizeColumnOnDblClick(TWinControl(AControl), Widget,
 
1779
            PGtkTreeView(MainView), Pt);
 
1780
        end;
 
1781
      end;
 
1782
    end;
 
1783
  end else
 
1784
  if not (csDesigning in AControl.ComponentState) and
 
1785
    (Event^.button = 1) and
 
1786
    (gdk_event_get_type(Event) = GDK_BUTTON_PRESS) and
 
1787
    (AControl is TWinControl) and
 
1788
    (TWinControl(AControl).FCompStyle = csListView) and
 
1789
    (TListView(AControl).ViewStyle in [vsIcon, vsSmallIcon]) and
 
1790
    TListView(AControl).MultiSelect then
 
1791
  begin
 
1792
    // issue #22991 - this fixes crash after click on listview when modal form
 
1793
    // is closed
 
1794
    FixListViewRubberBand(PGtkWidget(TWinControl(AControl).Handle));
1422
1795
  end;
1423
1796
end;
1424
1797
 
1456
1829
 
1457
1830
  Called whenever the mouse is over a widget and a mouse button is pressed.
1458
1831
-------------------------------------------------------------------------------}
1459
 
{-------------------------------------------------------------------------------
1460
 
  gtkMouseBtnPress
1461
 
  Params: widget: PGTKWidget; event: PGDKEventMotion; data: gPointer
1462
 
  Returns: GBoolean
1463
 
 
1464
 
  Called whenever the mouse is over a widget and a mouse button is pressed.
1465
 
-------------------------------------------------------------------------------}
1466
1832
function gtkMouseBtnPress(widget: PGtkWidget; event: pgdkEventButton; data: gPointer): GBoolean; cdecl;
1467
1833
 
1468
1834
  procedure CheckListSelection;
1501
1867
    gtk_list_item_select(PGtkListItem(List^.Data));
1502
1868
  end;
1503
1869
 
 
1870
  procedure FixTabControlFocusBehaviour;
 
1871
  var
 
1872
    Info: PWidgetInfo;
 
1873
  begin
 
1874
    {gtk_notebook have weird behaviour when clicked.
 
1875
     if there's active control on page it'll loose it's
 
1876
     focus and trigger OnExit (tab is taking focus).
 
1877
     issue #20493}
 
1878
    Info := GetWidgetInfo(Widget);
 
1879
    if not gtk_widget_is_focus(Widget) then
 
1880
      Include(Info^.Flags, wwiTabWidgetFocusCheck);
 
1881
  end;
 
1882
 
1504
1883
var
1505
1884
  DesignOnlySignal: boolean;
1506
1885
  Msg: TLMContextMenu;
1508
1887
  W: PGtkWidget;
1509
1888
  Info: PWidgetInfo;
1510
1889
  Old: TObject;
1511
 
  Mess: TLMessage;
 
1890
  Path: PGtkTreePath;
 
1891
  Column: PGtkTreeViewColumn;
1512
1892
  {$IFDEF VerboseMouseBugfix}
1513
1893
  AWinControl: TWinControl;
1514
1894
  {$ENDIF}
1533
1913
  {$ENDIF}
1534
1914
 
1535
1915
  ResetDefaultIMContext;
1536
 
  UpdateMouseCaptureControl;
 
1916
 
 
1917
  //debugln('[gtkMouseBtnPress] calling DeliverMouseDownMessage Result=',dbgs(Result));
 
1918
  {$IFDEF Gtk2CallMouseDownBeforeContext}
 
1919
  if DeliverMouseDownMessage(Widget, Event, TWinControl(Data))<>0 then
 
1920
  begin
 
1921
    // Debugln(['[gtkMouseBtnPress] DeliverMouseDownMessage handled, stopping event']);
 
1922
    g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
 
1923
    exit(false);
 
1924
  end;
 
1925
  {$ENDIF}
1537
1926
 
1538
1927
  if not (csDesigning in TComponent(Data).ComponentState) then
1539
1928
  begin
1542
1931
 
1543
1932
    DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMousePress);
1544
1933
    if DesignOnlySignal then exit;
1545
 
    if not ControlGetsMouseDownBefore(TControl(Data), Widget) then Exit;
 
1934
    if not ControlGetsMouseDownBefore(TControl(Data), Widget, Event) then Exit;
1546
1935
 
1547
1936
    if Event^.button = 1 then
1548
1937
    begin
1549
1938
      //CaptureMouseForWidget(CaptureWidget,mctGTKIntf);
 
1939
      if (TControl(Data) is TCustomTabControl) and
 
1940
        not (csDesigning in TControl(Data).ComponentState) then
 
1941
          FixTabControlFocusBehaviour;
1550
1942
    end
1551
1943
    else
1552
1944
    // if LCL process LM_CONTEXTMENU then stop the event propagation
1561
1953
        if (Info <> nil) and (Info^.LCLObject <> Old) then
1562
1954
        begin
1563
1955
          Old := Info^.LCLObject;
1564
 
          FillChar(Msg, SizeOf(Msg), #0);
 
1956
          FillChar(Msg{%H-}, SizeOf(Msg), #0);
1565
1957
          Msg.Msg := LM_CONTEXTMENU;
1566
 
          Msg.hWnd := HWND(W);
 
1958
          Msg.hWnd := {%H-}HWND(W);
1567
1959
          Msg.XPos := x;
1568
1960
          Msg.YPos := y;
1569
1961
 
1582
1974
       Issues #16972, #17888. }
1583
1975
      if Result and GTK_IS_TREE_VIEW(Widget) and (event^.button = 3) then
1584
1976
      begin
1585
 
        Result := False;
1586
 
        FillChar(Mess,SizeOf(Mess),0);
1587
 
        Mess.msg := LM_SelChange;
1588
 
        DeliverMessage(TWinControl(Data), Mess);
 
1977
        Column := gtk_tree_view_get_column(GTK_TREE_VIEW(Widget), 0);
 
1978
        Path:=nil;
 
1979
        if gtk_tree_view_get_path_at_pos(GTK_TREE_VIEW(Widget), Round(Event^.x), Round(Event^.y),
 
1980
          Path, Column, @x, @y) then
 
1981
        begin
 
1982
          gtk_tree_view_set_cursor(GTK_TREE_VIEW(Widget), Path, Column, False);
 
1983
          gtk_widget_queue_draw(Widget);
 
1984
        end;
1589
1985
        g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
1590
1986
      end;
1591
1987
 
1592
1988
    end;
1593
1989
  end else begin
1594
1990
    if (event^.Button=1) and
1595
 
       ((TControl(Data) is TCustomNoteBook) or (TControl(Data) is TCustomTabControl)) then
 
1991
       (TControl(Data) is TCustomTabControl) then
1596
1992
    begin
1597
 
      // clicks on the notebook should be handled by the gtk (switching page)
 
1993
      // clicks on the tab control should be handled by the gtk (switching page)
1598
1994
    end
1599
1995
    else
1600
1996
    begin
1603
1999
      g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
1604
2000
    end;
1605
2001
  end;
 
2002
  {$IFDEF Gtk2CallMouseDownBeforeContext}
 
2003
  {$ELSE}
1606
2004
  //debugln('[gtkMouseBtnPress] calling DeliverMouseDownMessage Result=',dbgs(Result));
1607
2005
  DeliverMouseDownMessage(Widget, Event, TWinControl(Data));
 
2006
  {$ENDIF}
 
2007
  //debugln(['gtkMouseBtnPress END Control=',DbgSName(TObject(Data))]);
1608
2008
end;
1609
2009
 
1610
2010
 
1614
2014
 
1615
2015
  Translate a gdk mouse press event into a LCL mouse down message and send it.
1616
2016
-------------------------------------------------------------------------------}
1617
 
procedure DeliverMouseDownMessage(widget: PGtkWidget; event : pgdkEventButton;
1618
 
  AWinControl: TWinControl);
 
2017
function DeliverMouseDownMessage(widget: PGtkWidget; event : pgdkEventButton;
 
2018
  AWinControl: TWinControl): PtrInt;
1619
2019
const
1620
2020
  LastModifierKeys: TShiftState = [];
1621
2021
  WHEEL_DELTA : array[Boolean] of Integer = (-120, 120);
1644
2044
 
1645
2045
    function LastClickInTime: boolean;
1646
2046
    begin
1647
 
      Result := ((now - LastMouse.TheTime) <= ((1/86400)*(DblClickTime/1000)));
 
2047
      Result:=(event^.time -  LastMouse.eventTime) <= DblClickTime;
1648
2048
    end;
1649
2049
 
1650
2050
    function TestIfMultiClick: boolean;
1660
2060
    Result := False;
1661
2061
 
1662
2062
    if (LastMouse.Down) and
1663
 
      (not (gdk_event_get_type(Event) in [gdk_2button_press, gdk_3button_press]))
 
2063
      (not (gdk_event_get_type(Event) in [GDK_BUTTON_PRESS, gdk_2button_press, gdk_3button_press]))
1664
2064
    then begin
1665
2065
      {$IFDEF VerboseMouseBugfix}
1666
 
      DebugLn(' NO CLICK: LastMouse.Down=',dbgs(LastMouse.Down),
 
2066
      DebugLn('DeliverMouseDownMessage: NO CLICK: LastMouse.Down=',dbgs(LastMouse.Down),
1667
2067
              ' Event^.theType=',dbgs(gdk_event_get_type(Event)));
1668
2068
      {$ENDIF}
1669
2069
      Exit;
1670
2070
    end;
1671
2071
 
 
2072
    if (LastMouse.Down) and (gdk_event_get_type(Event) = GDK_BUTTON_PRESS) and
 
2073
      (csDesigning in AWinControl.ComponentState) then
 
2074
        exit;
 
2075
 
1672
2076
    MessI.Keys := MessI.Keys or BtnKey;
1673
2077
    IsMultiClick := TestIfMultiClick;
1674
2078
 
1706
2110
          then begin
1707
2111
            // multi click
1708
2112
            {$IFDEF VerboseMouseBugfix}
1709
 
            DebugLn('  MULTI CLICK: ',dbgs(now),'-',dbgs(LastMouse.TheTime),'<= ',
 
2113
            DebugLn('  MULTI CLICK: ',dbgs(now),'-',dbgs(LastMouse.eventTime),'<= ',
1710
2114
              dbgs((1/86400)*(DblClickTime/1000)));
1711
2115
            {$ENDIF}
1712
2116
          end else begin
1719
2123
    DebugLn('  ClickCount=',dbgs(LastMouse.ClickCount));
1720
2124
    {$ENDIF}
1721
2125
 
1722
 
    LastMouse.TheTime := Now;
 
2126
    LastMouse.eventTime := event^.time;
1723
2127
    LastMouse.Window := Event^.Window;
1724
2128
    LastMouse.WindowPoint := EventXY;
1725
2129
    LastMouse.Down := True;
1739
2143
  end;
1740
2144
 
1741
2145
begin
1742
 
 
 
2146
  Result := 0;
1743
2147
  EventXY := Point(TruncToInt(Event^.X), TruncToInt(Event^.Y));
1744
2148
  ShiftState := GTKEventStateToShiftState(Event^.State);
1745
2149
 
1752
2156
  end;
1753
2157
 
1754
2158
  MappedXY := TranslateGdkPointToClientArea(Event^.Window, EventXY,
1755
 
                                            PGtkWidget(AWinControl.Handle));
1756
 
  MappedXY := SubtractScoll(PGtkWidget(AWinControl.Handle), MappedXY);
 
2159
                                            {%H-}PGtkWidget(AWinControl.Handle));
 
2160
  MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY);
1757
2161
  //DebugLn('DeliverMouseDownMessage ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y));
1758
2162
 
1759
2163
  if event^.Button in [4, 5] then
1768
2172
    MessE.Button := 0;
1769
2173
 
1770
2174
    // send the message directly to the LCL
1771
 
    NotifyApplicationUserInput(MessE.Msg);
1772
 
    DeliverMessage(AWinControl, MessE);
 
2175
    NotifyApplicationUserInput(AWinControl, MessE.Msg);
 
2176
    Result:=DeliverMessage(AWinControl, MessE);
1773
2177
  end
1774
2178
  else
1775
2179
  begin
1799
2203
 
1800
2204
    MessI.Result:=0;
1801
2205
    // send the message directly to the LCL
1802
 
    NotifyApplicationUserInput(MessI.Msg);
1803
 
    DeliverMessage(AWinControl, MessI);
 
2206
    NotifyApplicationUserInput(AWinControl, MessI.Msg);
 
2207
    Result := DeliverMessage(AWinControl, MessI);
 
2208
 
 
2209
    // issue #19914
 
2210
    if (Result = 0) and (Event^.button = 1) and
 
2211
      GTK_IS_NOTEBOOK({%H-}PGtkWidget(AWinControl.Handle)) and
 
2212
      DragManager.IsDragging then
 
2213
    begin
 
2214
      g_object_set_data({%H-}PGObject(AWinControl.Handle),
 
2215
        'lclnotebookdragging', gpointer(PtrInt(1)));
 
2216
    end;
1804
2217
  end;
1805
2218
end;
1806
2219
 
1825
2238
  {$ENDIF}
1826
2239
 
1827
2240
  ResetDefaultIMContext;
1828
 
  UpdateMouseCaptureControl;
1829
2241
 
1830
2242
  // stop the signal, so that it is not sent to the parent widgets
1831
2243
  g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-press-event');
1832
2244
 
1833
2245
  if (csDesigning in TComponent(Data).ComponentState) then exit;
1834
 
  if ControlGetsMouseDownBefore(TControl(Data),Widget) then exit;
 
2246
  if ControlGetsMouseDownBefore(TControl(Data),Widget, Event) then exit;
1835
2247
 
1836
2248
  //debugln('[gtkMouseBtnPressAfter] calling DeliverMouseDownMessage');
1837
2249
  DeliverMouseDownMessage(Widget, Event, TWinControl(Data));
1876
2288
  Result := False;
1877
2289
  MappedXY := TranslateGdkPointToClientArea(Event^.Window,
1878
2290
                               Point(TruncToInt(Event^.X), TruncToInt(Event^.Y)),
1879
 
                               PGtkWidget(AWinControl.Handle));
1880
 
  MappedXY := SubtractScoll(PGtkWidget(AWinControl.Handle), MappedXY);
 
2291
                               {%H-}PGtkWidget(AWinControl.Handle));
 
2292
  MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY);
1881
2293
  //DebugLn(['DeliverMouseUpMessage ',GetWidgetDebugReport(Widget),' ',dbgsName(AWinControl),' ',dbgs(MappedXY)]);
1882
2294
 
1883
2295
  case event^.Button of
1895
2307
  MessI.YPos := MappedXY.Y;
1896
2308
 
1897
2309
  ShiftState := GTKEventStateToShiftState(Event^.State);
 
2310
 
 
2311
  // do not send button in shiftstate on mouse up.issue #20916
 
2312
  case event^.Button of
 
2313
    1: ShiftState := ShiftState - [ssLeft];
 
2314
    2: ShiftState := ShiftState - [ssMiddle];
 
2315
    3: ShiftState := ShiftState - [ssRight];
 
2316
  end;
1898
2317
  MessI.Keys := ShiftStateToKeys(ShiftState);
1899
2318
 
1900
2319
  if MessI.Msg <> LM_NULL then
1903
2322
    // (Posting the message via queue
1904
2323
    //  has the risk of getting out of sync with the gtk)
1905
2324
    MessI.Result := 0;
1906
 
    NotifyApplicationUserInput(MessI.Msg);
 
2325
    NotifyApplicationUserInput(AWinControl, MessI.Msg);
1907
2326
    DeliverMessage(AWinControl, MessI);
1908
2327
    if MessI.Result <> 0 then
1909
2328
    begin
 
2329
      // issue #19914
 
2330
      if GTK_IS_NOTEBOOK(Widget) then
 
2331
      begin
 
2332
        if g_object_get_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging') <> nil then
 
2333
        begin
 
2334
          g_object_steal_data({%H-}PGObject(AWinControl.Handle),'lclnotebookdragging');
 
2335
          exit;
 
2336
        end;
 
2337
      end;
1910
2338
      // handled by the LCL
1911
2339
      //DebugLn(['DeliverMouseUpMessage msg was handled by the LCL, Stopping signal ...']);
1912
2340
      g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-release-event');
1943
2371
  //' GDK_BUTTON_RELEASE_MASK=',DbgS(GDK_BUTTON_RELEASE_MASK));
1944
2372
 
1945
2373
  ResetDefaultIMContext;
1946
 
  UpdateMouseCaptureControl;
1947
2374
 
1948
2375
  if not (csDesigning in TComponent(Data).ComponentState) then
1949
2376
  begin
1950
2377
    DesignOnlySignal := GetDesignOnlySignalFlag(Widget, dstMouseRelease);
 
2378
 
 
2379
    if (TControl(Data) is TCustomListView) and
 
2380
      (TListView(Data).ViewStyle in [vsIcon, vsSmallIcon]) and
 
2381
      TListView(Data).MultiSelect then
 
2382
    begin
 
2383
      // fixed crash.See issue #22778
 
2384
      FixListViewRubberBand(Widget);
 
2385
    end;
 
2386
 
1951
2387
    ReleaseMouseCapture;
1952
2388
    if DesignOnlySignal or (not ControlGetsMouseUpBefore(TControl(Data))) then
1953
2389
      Exit;
1954
2390
  end else
1955
2391
  begin
1956
2392
    // stop the signal, so that the widget does not auto react
1957
 
    if (not (TControl(Data) is TCustomNoteBook)) and
1958
 
       (not (TControl(Data) is TCustomTabControl))
1959
 
    then begin
 
2393
    if not (TControl(Data) is TCustomTabControl) then
 
2394
    begin
1960
2395
      g_signal_stop_emission_by_name(PGTKObject(Widget), 'button-release-event');
1961
2396
      Result := not CallBackDefaultReturn;
1962
2397
    end;
2003
2438
  g_signal_stop_emission_by_name(PGTKObject(Widget),'button-release-event');
2004
2439
 
2005
2440
  ResetDefaultIMContext;
2006
 
  UpdateMouseCaptureControl;
2007
2441
 
2008
2442
  if (csDesigning in TComponent(Data).ComponentState) then exit;
2009
2443
  if ControlGetsMouseUpBefore(TControl(Data)) then exit;
2026
2460
  EventXY:=Point(TruncToInt(Event^.X),TruncToInt(Event^.Y));
2027
2461
  ShiftState := GTKEventStateToShiftState(Event^.State);
2028
2462
  MappedXY:=TranslateGdkPointToClientArea(Event^.Window,EventXY,
2029
 
                                          PGtkWidget(AWinControl.Handle));
2030
 
  MappedXY := SubtractScoll(PGtkWidget(AWinControl.Handle), MappedXY);
 
2463
                                          {%H-}PGtkWidget(AWinControl.Handle));
 
2464
  MappedXY := SubtractScoll({%H-}PGtkWidget(AWinControl.Handle), MappedXY);
2031
2465
  //DebugLn('gtkMouseWheelCB ',DbgSName(AWinControl),' Mapped=',dbgs(MappedXY.X),',',dbgs(MappedXY.Y),' Event=',dbgs(EventXY.X),',',dbgs(EventXY.Y));
2032
2466
 
2033
2467
  // this is a mouse wheel event
2034
 
  FillChar(MessE,SizeOf(MessE),0);
 
2468
  FillChar(MessE{%H-},SizeOf(MessE),0);
2035
2469
  MessE.Msg := LM_MOUSEWHEEL;
2036
2470
  case event^.direction of
2037
2471
    GDK_SCROLL_UP: MessE.WheelDelta := 120;
2046
2480
  MessE.Button := 0;
2047
2481
 
2048
2482
  // send the message directly to the LCL
2049
 
  NotifyApplicationUserInput(MessE.Msg);
 
2483
  NotifyApplicationUserInput(AWinControl, MessE.Msg);
2050
2484
  if DeliverMessage(AWinControl, MessE) <> 0 then
2051
2485
    Result := True; // message handled by LCL, stop processing
2052
2486
end;
2114
2548
 
2115
2549
  EventTrace('size-allocate', data);
2116
2550
 
2117
 
  with Size^ do Assert(False, Format('Trace:[gtksize_allocateCB] %s --> X: %d, Y: %d, Width: %d, Height: %d', [TObject(data).ClassName, X, Y, Width, Height]));
 
2551
  //with Size^ do DebugLn(Format('Trace:[gtksize_allocateCB] %s --> X: %d, Y: %d, Width: %d, Height: %d', [TObject(data).ClassName, X, Y, Width, Height]));
2118
2552
 
2119
2553
  if not (TObject(Data) is TControl) then begin
2120
2554
    // owner is not TControl -> ignore
2171
2605
    if not TWinControl(Data).HandleAllocated then begin
2172
2606
      exit;
2173
2607
    end;
2174
 
    MainWidget:=PGtkWidget(TWinControl(Data).Handle);
 
2608
    MainWidget:={%H-}PGtkWidget(TWinControl(Data).Handle);
2175
2609
    ClientWidget:=GetFixedWidget(MainWidget);
2176
2610
    if GTK_WIDGET_REALIZED(ClientWidget) then begin
2177
2611
      // the gtk resizes bottom to top, that means the
2198
2632
    This event is fired when the form is sized, moved or changes Z order.
2199
2633
  }
2200
2634
 
2201
 
  FillChar(Allocation,SizeOf(TGtkAllocation),0);
 
2635
  FillChar(Allocation{%H-},SizeOf(TGtkAllocation),0);
2202
2636
  with Allocation do begin
2203
2637
    X:= Event^.X;
2204
2638
    Y:= Event^.Y;
2357
2791
begin
2358
2792
  EventTrace('Paste from clip', data);
2359
2793
  if (Widget=nil) then ;
2360
 
  if (gtk_major_version = 2) and (gtk_minor_version < 17) then
 
2794
 
 
2795
  // we must update cursor pos with delay otherwise selStart is wrong.issue #7243
 
2796
  if (Widget <> nil) and (GTK_IS_ENTRY(Widget)) then
2361
2797
  begin
2362
 
    if (Widget <> nil) and (GTK_IS_ENTRY(Widget)) then
2363
 
    begin
2364
 
      Info := GetWidgetInfo(Widget, False);
2365
 
      include(Info^.Flags, wwiInvalidEvent);
2366
 
    end;
 
2798
    Info := GetWidgetInfo(Widget, False);
 
2799
    Include(Info^.Flags, wwiInvalidEvent);
 
2800
    // happy end is inside gtkchanged_editbox() above.
 
2801
    g_object_set_data(PGObject(Widget),'lcl-delay-cm_textchaged', data);
2367
2802
  end;
2368
2803
  Mess.msg := LM_PASTE;
2369
2804
  Result:= DeliverMessage(Data, Mess) = 0;
2598
3033
  ScrollType: TGtkScrollType;
2599
3034
begin
2600
3035
  Result := CallBackDefaultReturn;
2601
 
  Assert(False, Format('Trace:[GTKHScrollCB] Value: %d', [RoundToInt(Adjustment^.Value)]));
 
3036
  //DebugLn(Format('Trace:[GTKHScrollCB] Value: %d', [RoundToInt(Adjustment^.Value)]));
2602
3037
  Scroll := PgtkRange(gtk_object_get_data(PGTKObject(Adjustment), odnScrollBar));
2603
3038
  if Scroll<>nil then begin
2604
3039
    Msg.Msg := LM_HSCROLL;
2607
3042
      if Pos < High(SmallPos)
2608
3043
      then SmallPos := Pos
2609
3044
      else SmallPos := High(SmallPos);
2610
 
      ScrollBar := HWND(PtrUInt(Scroll));
 
3045
      ScrollBar := HWND({%H-}PtrUInt(Scroll));
2611
3046
      ScrollType := get_gtk_scroll_type(Scroll);
2612
3047
      ScrollCode := ScrollTypeToSbCode(False, ScrollType,
2613
3048
                                       gtk_range_get_update_policy(Scroll));
2625
3060
  //TODO: implement SB_THUMBPOSITION message after track is finished
2626
3061
 
2627
3062
  Result := CallBackDefaultReturn;
2628
 
  Assert(False, Format('Trace:[GTKVScrollCB] Value: %d', [RoundToInt(Adjustment^.Value)]));
 
3063
  {$IFDEF SYNSCROLLDEBUG}
 
3064
  DebugLn(Format('Trace:[GTKVScrollCB] Value: %d', [RoundToInt(Adjustment^.Value)]));
 
3065
  {$ENDIF}
2629
3066
  Scroll := PgtkRange(gtk_object_get_data(PGTKObject(Adjustment), odnScrollBar));
2630
3067
  if Scroll<>nil then begin
2631
3068
    Msg.Msg := LM_VSCROLL;
2635
3072
      then SmallPos := Pos
2636
3073
      else SmallPos := High(SmallPos);
2637
3074
      //DebugLn('GTKVScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos));
2638
 
      ScrollBar := HWND(PtrUInt(Scroll));
 
3075
      ScrollBar := HWND({%H-}PtrUInt(Scroll));
2639
3076
      ScrollType := get_gtk_scroll_type(Scroll);
2640
3077
      // GTK1 has a bug with wheel mouse. It sometimes gives the wrong direction.
2641
3078
      ScrollCode := ScrollTypeToSbCode(True, ScrollType,
2651
3088
var
2652
3089
  Msg: TLMVScroll;
2653
3090
  MaxValue: gdouble;
 
3091
  Widget: PGTKWidget;
2654
3092
begin
2655
3093
  Result := CallBackDefaultReturn;
2656
3094
 
2657
 
  //Assert(False, Format('Trace:[Gtk2RangeScrollCB] Value: %d', [RoundToInt(AValue)]));
 
3095
  Widget:=PGTKWidget(ARange);
 
3096
  {$IFDEF SYNSCROLLDEBUG}
 
3097
  DebugLn(Format('Trace:[Gtk2RangeScrollCB] Value: %d', [RoundToInt(AValue)]));
 
3098
  {$ENDIF}
2658
3099
  if G_OBJECT_TYPE(ARange) = gtk_hscrollbar_get_type then
2659
3100
    Msg.Msg := LM_HSCROLL
2660
3101
  else
2661
3102
    Msg.Msg := LM_VSCROLL;
2662
3103
 
2663
 
  if (AWidgetInfo^.LCLObject is TScrollingWinControl) then
2664
 
  begin
2665
 
    if ARange^.adjustment^.page_size > 0 then
2666
 
      MaxValue := ARange^.adjustment^.upper - ARange^.adjustment^.page_size
2667
 
    else
2668
 
      MaxValue := ARange^.adjustment^.upper;
2669
 
    if (AValue > MaxValue) or (AValue < ARange^.adjustment^.lower) then
2670
 
    begin
2671
 
      Result := not Result;
2672
 
      AValue := MaxValue;
2673
 
    end;
2674
 
  end;
 
3104
  if ARange^.adjustment^.page_size > 0 then
 
3105
    MaxValue := ARange^.adjustment^.upper - ARange^.adjustment^.page_size
 
3106
  else
 
3107
    MaxValue := ARange^.adjustment^.upper;
 
3108
  if (AValue > MaxValue) or (AValue < ARange^.adjustment^.lower) then
 
3109
    AValue := MaxValue;
2675
3110
 
2676
3111
  with Msg do
2677
3112
  begin
2681
3116
    else
2682
3117
      SmallPos := High(SmallPos);
2683
3118
 
2684
 
    ScrollBar := HWND(PtrUInt(ARange));
 
3119
    ScrollBar := HWND({%H-}PtrUInt(ARange));
2685
3120
    ScrollCode := GtkScrollTypeToScrollCode(AScrollType);
2686
3121
  end;
 
3122
  DeliverMessage(AWidgetInfo^.LCLObject, Msg);
 
3123
 
 
3124
  if Msg.Scrollcode=SB_THUMBTRACK then
 
3125
  begin
 
3126
    if Widget^.state = 0 then
 
3127
    begin
 
3128
      Msg.ScrollCode := SB_THUMBPOSITION;
 
3129
      DeliverMessage(AWidgetInfo^.LCLObject, Msg);
 
3130
      Msg.ScrollCode:=SB_ENDSCROLL;
 
3131
      DeliverMessage(AWidgetInfo^.LCLObject, Msg);
 
3132
    end;
 
3133
  end
 
3134
  else Widget^.state := 1;
 
3135
 
 
3136
  if (AWidgetInfo^.LCLObject is TScrollingWinControl) and
 
3137
  ((Msg.ScrollCode=SB_LINEUP) or (Msg.ScrollCode=SB_LINEDOWN)) then
 
3138
  Result:=True;
 
3139
end;
 
3140
 
 
3141
function Gtk2RangeScrollPressCB(Widget: PGtkWidget;
 
3142
  Event: PGdkEventButton; Data: gPointer): gboolean; cdecl;
 
3143
begin
 
3144
  Widget^.state := 2;
 
3145
  Result := CallBackDefaultReturn;;
 
3146
end;
 
3147
 
 
3148
function Gtk2RangeScrollReleaseCB(Widget: PGtkWidget;
 
3149
  Event: PGdkEventButton; Data: gPointer): gboolean; cdecl;
 
3150
var
 
3151
  Avalue: gdouble;
 
3152
  WidgetInfo: PWidgetInfo;
 
3153
begin
 
3154
  AValue:=PGtkRange(Widget)^.adjustment^.value;
 
3155
  WidgetInfo:=GetWidgetInfo(Widget, False);
 
3156
  if not Assigned(WidgetInfo) then
 
3157
    WidgetInfo:=GetWidgetInfo(Widget^.parent, False);
 
3158
  if Assigned(WidgetInfo) and (Widget^.state = 1) then
 
3159
    Gtk2RangeScrollCB(PGtkRange(Widget), 0, AValue, WidgetInfo);
 
3160
  Widget^.state := 0;
 
3161
  Result := CallBackDefaultReturn;
 
3162
end;
 
3163
 
 
3164
function Gtk2RangeUbuntuScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl;
 
3165
var
 
3166
  Msg: TLMVScroll;
 
3167
  AWidgetInfo: PWidgetInfo;
 
3168
  Scroll: PGtkRange;
 
3169
  ScrollType: TGtkScrollType;
 
3170
  LastPos: PtrInt;
 
3171
begin
 
3172
  Result := CallBackDefaultReturn;
 
3173
  AWidgetInfo:=PWidgetInfo(Data);
 
3174
 
 
3175
  //debugln(['Gtk2RangeUbuntuScrollCB ',DbgSName(AWidgetInfo^.LCLObject)]);
 
3176
  Scroll := PgtkRange(gtk_object_get_data(PGTKObject(Adjustment), odnScrollBar));
 
3177
  if Scroll<>nil then begin
 
3178
    FillByte(Msg{%H-},SizeOf(Msg),0);
 
3179
    if Scroll^.orientation=GTK_ORIENTATION_VERTICAL then
 
3180
      Msg.Msg := LM_VSCROLL
 
3181
    else
 
3182
      Msg.Msg := LM_HSCROLL;
 
3183
    with Msg do begin
 
3184
      Pos := Round(Adjustment^.Value);
 
3185
      if Pos < High(SmallPos)
 
3186
      then SmallPos := Pos
 
3187
      else SmallPos := High(SmallPos);
 
3188
 
 
3189
      LastPos:={%H-}PtrInt(gtk_object_get_data(PGTKObject(Adjustment), odnScrollBarLastPos));
 
3190
      if LastPos=Pos then begin
 
3191
        //debugln(['Gtk2RangeUbuntuScrollCB duplicate message => skip']);
 
3192
        exit;
 
3193
      end;
 
3194
      gtk_object_set_data(PGTKObject(Adjustment), odnScrollBarLastPos, {%H-}gpointer(Pos));
 
3195
 
 
3196
      //DebugLn('Gtk2RangeUbuntuScrollCB A Adjustment^.Value=',dbgs(Adjustment^.Value),' SmallPos=',dbgs(SmallPos));
 
3197
      ScrollBar := HWND({%H-}PtrUInt(Scroll));
 
3198
      ScrollType := get_gtk_scroll_type(Scroll);
 
3199
      ScrollCode := ScrollTypeToSbCode(True, ScrollType,
 
3200
                                       gtk_range_get_update_policy(Scroll));
 
3201
      //DebugLn('Gtk2RangeUbuntuScrollCB B Adjustment^.Value=',dbgs(Adjustment^.Value),' ScrollCode=',dbgs(ScrollCode),' ScrollType=',dbgs(ScrollType));
 
3202
    end;
 
3203
    DeliverMessage(AWidgetInfo^.LCLObject, Msg);
 
3204
    Result:=true;
 
3205
  end;
 
3206
end;
 
3207
 
 
3208
function Gtk2ScrolledWindowScrollCB(AScrollWindow: PGtkScrolledWindow; AEvent: PGdkEventScroll; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
 
3209
var
 
3210
  Msg: TLMVScroll;
 
3211
  AValue: Double;
 
3212
  Range: PGtkRange;
 
3213
begin
 
3214
  {$IFDEF SYNSCROLLDEBUG}
 
3215
  debugln(['Gtk2ScrolledWindowScrollCB ']);
 
3216
  {$ENDIF}
 
3217
  case AEvent^.direction of
 
3218
    GDK_SCROLL_UP,
 
3219
    GDK_SCROLL_DOWN: Msg.Msg := LM_VSCROLL;
 
3220
    GDK_SCROLL_LEFT,
 
3221
    GDK_SCROLL_RIGHT: Msg.Msg := LM_HSCROLL;
 
3222
  end;
 
3223
 
 
3224
  case Msg.Msg of
 
3225
    LM_VSCROLL: Range := GTK_RANGE(AScrollWindow^.vscrollbar);
 
3226
    LM_HSCROLL: Range := GTK_RANGE(AScrollWindow^.hscrollbar);
 
3227
  end;
 
3228
 
 
3229
  AValue :=  power(Range^.adjustment^.page_size, 2 / 3);
 
3230
 
 
3231
  if (AEvent^.direction = GDK_SCROLL_UP) or
 
3232
     (AEvent^.direction = GDK_SCROLL_LEFT)
 
3233
  then
 
3234
    AValue := -AValue;
 
3235
 
 
3236
  AValue := gtk_range_get_value(Range) + AValue;
 
3237
 
 
3238
  AValue := Max(AValue, Range^.adjustment^.lower);
 
3239
  AValue := Min(AValue, Range^.adjustment^.upper - Range^.adjustment^.page_size);
 
3240
 
 
3241
  with Msg do
 
3242
  begin
 
3243
    Pos := Round(AValue);
 
3244
    if Pos < High(SmallPos) then
 
3245
      SmallPos := Pos
 
3246
    else
 
3247
      SmallPos := High(SmallPos);
 
3248
 
 
3249
    ScrollBar := HWND({%H-}PtrUInt(Range));
 
3250
    ScrollCode := SB_THUMBPOSITION;
 
3251
  end;
2687
3252
  Result := DeliverMessage(AWidgetInfo^.LCLObject, Msg) <> 0;
2688
3253
end;
2689
3254
 
2707
3272
    // Check for a toggle
2708
3273
    // If the remove was successfull, the key was on
2709
3274
    // else it was off so we should set the toggle flag
2710
 
    if KeyStateList.Remove(Pointer(PtrInt(AVKeyCode or KEYMAP_TOGGLE))) < 0
2711
 
    then KeyStateList.Add(Pointer(PtrInt(AVKeyCode or KEYMAP_TOGGLE)));
 
3275
    if KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode or KEYMAP_TOGGLE))) < 0
 
3276
    then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode or KEYMAP_TOGGLE)));
2712
3277
  end;
2713
3278
 
2714
3279
  procedure UpdateList(const AVKeyCode: Integer; const APressed: Boolean);
2716
3281
    if AVKeyCode = 0 then Exit;
2717
3282
    if APressed
2718
3283
    then begin
2719
 
      if KeyStateList.IndexOf(Pointer(PtrInt(AVKeyCode))) < 0
2720
 
      then KeyStateList.Add(Pointer(PtrInt(AVKeyCode)));
 
3284
      if KeyStateList.IndexOf({%H-}Pointer(PtrUInt(AVKeyCode))) < 0
 
3285
      then KeyStateList.Add({%H-}Pointer(PtrUInt(AVKeyCode)));
2721
3286
    end
2722
3287
    else begin
2723
 
      KeyStateList.Remove(Pointer(PtrInt(AVKeyCode)));
 
3288
      KeyStateList.Remove({%H-}Pointer(PtrUInt(AVKeyCode)));
2724
3289
    end;
2725
3290
  end;
2726
3291
 
3174
3739
  GtkList:=PGtkList(widget);
3175
3740
  if (GtkList^.selection = nil) or (LockOnChange(PGtkObject(widget),0) > 0) then
3176
3741
    Exit;
3177
 
  FillChar(Mess,SizeOf(Mess),0);
 
3742
  FillChar(Mess{%H-},SizeOf(Mess),0);
3178
3743
  Mess.msg := LM_SelChange;
3179
3744
  if gtkListGetSelectionMode(GtkList)=GTK_SELECTION_SINGLE then
3180
3745
    gtk_list_set_selection_mode(GtkList,GTK_SELECTION_BROWSE);
3181
3746
  DeliverMessage(Data, Mess);
3182
3747
end;
3183
3748
 
3184
 
{$I gtk2DragCallback.inc}
3185
 
{$I gtk2ComboBoxCallback.inc}
3186
 
{$I gtk2PageCallback.inc}
 
3749
//DRAG CALLBACK FUNCTIONS
 
3750
 
 
3751
function edit_drag_data_received(widget : pgtkWidget;
 
3752
  Context : pGdkDragContext;
 
3753
  X, Y : Integer;
 
3754
  SelData : pGtkSelectionData;
 
3755
  info : Integer;
 
3756
  time : Integer;
 
3757
  data : pointer) : GBoolean; cdecl;
 
3758
Var
 
3759
  Texts : String;
 
3760
Begin
 
3761
  Result:=false;
 
3762
  if (Widget=nil) or (X=0) or (Y=0) or (Info=0) then exit;
 
3763
  //DebugLn('Trace:***********Drag Data Received*******************');
 
3764
  if Seldata^.Length > 0 then
 
3765
  Begin
 
3766
    Texts := StrPas(PChar(SelData^.data));
 
3767
    //DebugLn('Trace:' + Texts);
 
3768
    //DebugLn('Trace:0');
 
3769
    TCustomEdit(Data).Caption := Texts;
 
3770
    //DebugLn('Trace:1');
 
3771
  end;
 
3772
  gtk_drag_finish(Context,false,false,time);
 
3773
end;
 
3774
 
 
3775
function edit_source_drag_data_get(widget : pgtkWidget;
 
3776
  Context : pGdkDragContext;
 
3777
  Selection_data : pGtkSelectionData;
 
3778
  info : Integer;
 
3779
  time : Integer;
 
3780
  data : pointer) : GBoolean; cdecl;
 
3781
var
 
3782
  strTemp : PChar;
 
3783
  Texts : String;
 
3784
Begin
 
3785
  Result:=false;
 
3786
  if (Time=0) or (Context=nil) or (Widget=nil) then ;
 
3787
  if (info = TARGET_ROOTWIN) then begin
 
3788
    //DebugLn('Trace:I WAS DROPPED ON THE ROOTWIN')
 
3789
  end
 
3790
  else Begin
 
3791
    //DebugLn('Trace:*********Setting Data************');
 
3792
    Texts := TCustomEdit(data).Text;
 
3793
    //DebugLn('Trace:0');
 
3794
    strTemp := StrAlloc(length(Texts) + 1);
 
3795
    try
 
3796
      StrPCopy(strTemp, Texts);
 
3797
      //DebugLn('Trace:1');
 
3798
      gtk_selection_data_set(selection_data,selection_data^.target,
 
3799
                    8,
 
3800
                    PGUChar(StrTemp),
 
3801
                    length(Texts)+1);
 
3802
      //DebugLn('Trace:2');
 
3803
    finally
 
3804
      strDispose(strTemp);
 
3805
    end;
 
3806
    //DebugLn('Trace:3');
 
3807
  end;
 
3808
end;
 
3809
 
 
3810
 
 
3811
function Edit_source_drag_data_delete (Widget: pGtkWidget;
 
3812
  Context: pGdkDragContext; Data: gpointer): gBoolean ; cdecl;
 
3813
begin
 
3814
  if (Widget=nil) or (Context=nil) or (Data=nil) then ;
 
3815
  //DebugLn('Trace:***************');
 
3816
  //DebugLn('Trace:DELETE THE DATA');
 
3817
  Result:=false;
 
3818
end;
 
3819
 
 
3820
// combobox callbacks
 
3821
function gtkComboBoxShowAfter(widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
 
3822
var
 
3823
  Mess : TLMCommand;
 
3824
  AComboBox: TCustomComboBox;
 
3825
begin
 
3826
  Result := True;
 
3827
  EventTrace('ComboBoxShowAfter', data);
 
3828
 
 
3829
  AComboBox:=TObject(Data) as TCustomComboBox;
 
3830
  AComboBox.IntfGetItems;
 
3831
 
 
3832
  if (Widget=nil) then ;
 
3833
  FillChar(Mess{%H-},SizeOf(Mess),0);
 
3834
  Mess.Msg := CN_Command;
 
3835
  Mess.NotifyCode := CBN_DROPDOWN;
 
3836
 
 
3837
  Result := DeliverMessage(Data, Mess) = 0;
 
3838
end;
 
3839
 
 
3840
function gtkComboBoxHideAfter(widget: PGtkWidget; data: gPointer): GBoolean; cdecl;
 
3841
var
 
3842
  Mess : TLMCommand;
 
3843
begin
 
3844
  Result := True;
 
3845
  if (Widget=nil) then ;
 
3846
  EventTrace('ComboBoxHideAfter', data);
 
3847
  FillChar(Mess{%H-},SizeOf(Mess),0);
 
3848
  Mess.Msg := CN_Command;
 
3849
  Mess.NotifyCode := CBN_CLOSEUP;
 
3850
 
 
3851
  Result := DeliverMessage(Data, Mess) = 0;
 
3852
end;
 
3853
 
 
3854
// notebook callbacks
 
3855
procedure DrawNotebookPageIcon(Page: TCustomPage; Widget: PGtkWidget);
 
3856
var
 
3857
  NoteBook: TCustomTabControl;
 
3858
  NoteBookWidget: PGtkWidget;
 
3859
  PageWidget: PGtkWidget;
 
3860
  TabWidget: PGtkWidget;
 
3861
  ImageIndex: Integer;
 
3862
begin
 
3863
  NoteBook := Page.Parent as TCustomTabControl;
 
3864
  ImageIndex := NoteBook.GetImageIndex(Page.PageIndex);
 
3865
  if (NoteBook.Images = nil) or (ImageIndex < 0)
 
3866
  or (Page.ImageIndex >= NoteBook.Images.Count)
 
3867
  or (not NoteBook.HandleAllocated)
 
3868
  or (not Page.HandleAllocated)
 
3869
  then exit;
 
3870
  NoteBookWidget := {%H-}PGtkWidget(NoteBook.Handle);
 
3871
  PageWidget := {%H-}PGtkWidget(Page.Handle);
 
3872
 
 
3873
  // get the tab container and the tab icon widget
 
3874
  TabWidget := gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget),
 
3875
                                        PageWidget);
 
3876
  if TabWidget = nil then exit;
 
3877
  {$IFDEF VerboseGtkToDos}{$note reimplement}{$ENDIF}
 
3878
  DrawImageListIconOnWidget(NoteBook.Images, ImageIndex, Widget);
 
3879
end;
 
3880
 
 
3881
function PageIconWidgetExposeAfter(Widget: PGtkWidget; Event: PGDKEventExpose;
 
3882
  Data: gPointer): GBoolean; cdecl;
 
3883
var
 
3884
  ThePage: TCustomPage;
 
3885
begin
 
3886
  Result := false;
 
3887
  //DebugLn('PageIconWidgetExposeAfter ',DbgS(Widget));
 
3888
  EventTrace('PageIconWidgetExposeAfter', Data);
 
3889
  if (Event^.Count > 0) then exit;
 
3890
  ThePage := TObject(Data) as TCustomPage;
 
3891
  DrawNotebookPageIcon(ThePage, Widget);
 
3892
end;
 
3893
 
3187
3894