← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/interfaces/gtk2/gtk2proc.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/gtk2proc.inc
377
377
begin
378
378
  case ScrollType of
379
379
      GTK_SCROLL_NONE          : Result := SB_ENDSCROLL;
380
 
      GTK_SCROLL_JUMP          : Result := SB_THUMBPOSITION;
 
380
      GTK_SCROLL_JUMP          : Result := SB_THUMBTRACK;
381
381
      GTK_SCROLL_STEP_BACKWARD : Result := SB_LINELEFT;
382
382
      GTK_SCROLL_STEP_FORWARD  : Result := SB_LINERIGHT;
383
383
      GTK_SCROLL_PAGE_BACKWARD : Result := SB_PAGELEFT;
395
395
    end;
396
396
end;
397
397
 
 
398
function Gtk2TranslateScrollStyle(const SS: TScrollStyle): TPoint;
 
399
begin
 
400
  case SS of
 
401
    ssAutoBoth: Result:=Point(GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC);
 
402
    ssAutoHorizontal: Result:=Point(GTK_POLICY_AUTOMATIC, GTK_POLICY_NEVER);
 
403
    ssAutoVertical: Result:=Point(GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC);
 
404
    ssBoth: Result:=Point(GTK_POLICY_ALWAYS, GTK_POLICY_ALWAYS);
 
405
    ssHorizontal: Result:=Point(GTK_POLICY_ALWAYS, GTK_POLICY_NEVER);
 
406
    ssNone: Result:=Point(GTK_POLICY_NEVER, GTK_POLICY_NEVER);
 
407
    ssVertical: Result:=Point(GTK_POLICY_NEVER, GTK_POLICY_ALWAYS);
 
408
  end;
 
409
end;
 
410
 
398
411
{------------------------------------------------------------------------------
399
412
  function GtkWidgetIsA(Widget: PGtkWidget; AType: TGtkType): boolean;
400
413
 
465
478
  if LCLObject is TWinControl then begin
466
479
    AWinControl:=TWinControl(LCLObject);
467
480
    if AWinControl.HandleAllocated then begin
468
 
      MainWidget:=PGTKWidget(AWinControl.Handle);
 
481
      MainWidget:={%H-}PGTKWidget(AWinControl.Handle);
469
482
      if MainWidget=Widget
470
483
      then Result:=Result+'<Is MainWidget>'
471
484
      else Result:=Result+Format('<MainWidget=%p=%s>', [Pointer(MainWidget), GetWidgetClassName(MainWidget)]);
667
680
  Result:=
668
681
    (AWinControl<>nil) and (AWinControl is TWinControl)
669
682
    and (AWinControl.HandleAllocated)
670
 
    and WidgetIsDestroyingHandle(PGtkWidget(AWinControl.Handle));
 
683
    and WidgetIsDestroyingHandle({%H-}PGtkWidget(AWinControl.Handle));
671
684
end;
672
685
 
673
686
{------------------------------------------------------------------------------
698
711
procedure InvalidateLastWFPResult(AControl: TWinControl; const ABounds: TRect);
699
712
begin
700
713
  if PtInRect(ABounds, LastWFPMousePos) and
701
 
    GTK_IS_OBJECT(Pointer(LastWFPResult)) then
 
714
    GTK_IS_OBJECT({%H-}Pointer(LastWFPResult)) then
702
715
  begin
703
716
    if (AControl <> nil) and (AControl.Handle = LastWFPResult) and
704
717
      AControl.Enabled and AControl.Visible then
705
718
        exit;
706
 
    g_signal_handlers_disconnect_by_func(GPointer(LastWFPResult),
 
719
    g_signal_handlers_disconnect_by_func({%H-}GPointer(LastWFPResult),
707
720
      TGTKSignalFunc(@DestroyWindowFromPointCB), nil);
708
721
    LastWFPResult := 0;
709
722
    LastWFPMousePos := Point(High(Integer), High(Integer));
720
733
     (AForm.ParentWindow <> 0) or
721
734
     not (AForm.HandleAllocated) then Exit;
722
735
 
723
 
  Widget := PGtkWidget(AForm.Handle);
 
736
  Widget := {%H-}PGtkWidget(AForm.Handle);
724
737
  // if widget not yet realized then exit
725
738
  if Widget^.Window = nil then
726
739
    Exit;
751
764
procedure SetWindowFullScreen(AForm: TCustomForm; const AValue: Boolean);
752
765
begin
753
766
  If AValue then
754
 
    GTK_Window_FullScreen(PGTKWindow(AForm.Handle))
 
767
    GTK_Window_FullScreen({%H-}PGTKWindow(AForm.Handle))
755
768
  else
756
 
    GTK_Window_UnFullScreen(PGTKWindow(AForm.Handle));
 
769
    GTK_Window_UnFullScreen({%H-}PGTKWindow(AForm.Handle));
757
770
end;
758
771
 
759
772
procedure GrabKeyBoardToForm(AForm: TCustomForm);
805
818
  {$IFDEF HASX}
806
819
  if Gtk2WidgetSet.GetDesktopWidget <> nil then
807
820
    gtk_window_set_transient_for(GtkWindow, PGtkWindow(Gtk2WidgetSet.GetDesktopWidget));
808
 
  // gtk_widget_set_parent(GtkWindow, Gtk2WidgetSet.GetDesktopWidget);
809
821
  {$ENDIF}
810
822
  {$IFNDEF gtk_no_set_modal}
811
823
  gtk_window_set_modal(GtkWindow, true);
812
824
  {$ENDIF}
813
825
 
 
826
  gtk_window_present(GtkWindow);
 
827
 
814
828
  if (AForm <> nil) and (AForm.ShowInTaskBar <> stAlways) and
815
829
    (gtk_window_get_type_hint(GtkWindow) <> GDK_WINDOW_TYPE_HINT_DIALOG) then
816
830
    gtk_window_set_skip_taskbar_hint(GtkWindow, True);
817
 
  gtk_window_present(GtkWindow);
 
831
 
818
832
  {$IFDEF VerboseTransient}
819
833
  DebugLn('TGtkWidgetSet.ShowModal ',Sender.ClassName);
820
834
  {$ENDIF}
821
 
  //TGtk2WidgetSet(WidgetSet).
822
835
  GTK2WidgetSet.UpdateTransientWindows;
823
836
end;
824
837
 
829
842
begin
830
843
  Result:=0;
831
844
  if (AForm=nil) or (not AForm.HandleAllocated) then exit;
832
 
  Widget:=PGtkWidget(AForm.Handle);
 
845
  Widget:={%H-}PGtkWidget(AForm.Handle);
833
846
  if Widget^.window = nil then exit;
834
847
  Result := gdk_window_xwindow(Widget^.window);
835
848
end;
860
873
  PS : PPaintStruct;
861
874
  Widget: PGtkWidget;
862
875
begin
863
 
  FillByte(Result,SizeOf(Result),0);
 
876
  FillByte(Result{%H-},SizeOf(Result),0);
864
877
  Result.Msg := LM_PAINT;
865
878
  New(PS);
866
879
  FillChar(PS^, SizeOf(TPaintStruct), 0);
870
883
  else
871
884
    PS^.rcPaint := GtkPaintMsg.Data.Rect;
872
885
 
873
 
  Result.DC := BeginPaint(THandle(PtrUInt(Widget)), PS^);
 
886
  Result.DC := BeginPaint(THandle({%H-}PtrUInt(Widget)), PS^);
874
887
  Result.PaintStruct := PS;
875
888
  Result.Result := 0;
876
889
  if FreeGtkPaintMsg then
886
899
  begin
887
900
    if Msg^.LParam <> 0 then
888
901
    begin
889
 
      PS := PPaintStruct(Msg^.LParam);
 
902
      PS := {%H-}PPaintStruct(Msg^.LParam);
890
903
      if Msg^.WParam <> 0 then
891
904
        DC := TGtkDeviceContext(Msg^.WParam)
892
905
      else
893
906
        DC := TGtkDeviceContext(PS^.hdc);
894
 
      EndPaint(THandle(PtrUInt(DC.Widget)), PS^);
 
907
      EndPaint(THandle({%H-}PtrUInt(DC.Widget)), PS^);
895
908
      Dispose(PS);
896
909
      Msg^.LParam:=0;
897
910
      Msg^.WParam:=0;
916
929
  begin
917
930
    if Msg^.LParam <> 0 then
918
931
    begin
919
 
      PS := PPaintStruct(Msg^.LParam);
 
932
      PS := {%H-}PPaintStruct(Msg^.LParam);
920
933
      if Msg^.WParam<>0 then
921
934
        DC := TGtkDeviceContext(Msg^.WParam)
922
935
      else
923
936
        DC := TGtkDeviceContext(PS^.hdc);
924
 
      EndPaint(THandle(PtrUInt(DC.Widget)), PS^);
 
937
      EndPaint(THandle({%H-}PtrUInt(DC.Widget)), PS^);
925
938
      Dispose(PS);
926
939
      Msg^.LParam:=0;
927
940
      Msg^.WParam:=0;
961
974
procedure MergeClipping(DestinationDC: TGtkDeviceContext; DestinationGC: PGDKGC;
962
975
  X,Y,Width,Height: integer; ClipMergeMask: PGdkBitmap;
963
976
  ClipMergeMaskX, ClipMergeMaskY: integer;
964
 
  var NewClipMask: PGdkBitmap);
 
977
  out NewClipMask: PGdkBitmap);
965
978
// merge ClipMergeMask into the destination clipping mask at the
966
979
// destination rectangle
967
980
var
1214
1227
    DestLeft := DestWidget^.allocation.x - Offset.x + ((WindowWidth-ImageWidth) div 2);
1215
1228
  if CenterVertically then
1216
1229
    DestTop := DestWidget^.allocation.y - Offset.y +  ((WindowHeight-ImageHeight) div 2);
1217
 
  DestDC := GetDC(HDC(PtrUInt(DestWidget)));
 
1230
  DestDC := GetDC(HDC({%H-}PtrUInt(DestWidget)));
1218
1231
 
1219
1232
  //DebugLn('DrawImageListIconOnWidget B DestXY=',DestLeft,',',DestTop,
1220
1233
  //  ' DestWindowSize=',WindowWidth,',',WindowWidth,
1222
1235
  StretchBlt(DestDC, DestLeft, DestTop, ImageWidth, ImageHeight,
1223
1236
    Bitmap.Canvas.Handle, 0, 0, ImageWidth, ImageHeight,
1224
1237
    SRCCOPY);
1225
 
  ReleaseDC(HDC(PtrUInt(DestWidget)),DestDC);
 
1238
  ReleaseDC(HDC({%H-}PtrUInt(DestWidget)),DestDC);
1226
1239
  Bitmap.Free;
1227
1240
end;
1228
1241
 
1362
1375
  if Bitmap=nil then exit;
1363
1376
  MaxRect:=Rect(0,0,0,0);
1364
1377
  gdk_window_get_size(Bitmap,@MaxRect.Right,@MaxRect.Bottom);
1365
 
  IntersectRect(SourceRect,SrcRect,MaxRect);
 
1378
  IntersectRect(SourceRect{%H-},SrcRect,MaxRect);
1366
1379
  SrcWidth:=SourceRect.Right-SourceRect.Left;
1367
1380
  SrcHeight:=SourceRect.Bottom-SourceRect.Top;
1368
1381
  DebugLn('ExtractGdkBitmap SourceRect=',dbgs(SourceRect));
1393
1406
  // on windows or bigendian servers the bits need to be swapped
1394
1407
  
1395
1408
  // align dataptr first
1396
 
  count := PtrUint(AData) and 3;
 
1409
  count := {%H-}PtrUint(AData) and 3;
1397
1410
  if count > ADataCount then count := ADataCount;
1398
1411
  Dec(ADataCount, Count);
1399
1412
  
1449
1462
 
1450
1463
  Allocated a GDKColor from a winapi color
1451
1464
 ------------------------------------------------------------------------------}
1452
 
function AllocGDKColor(const AColor: LongInt): TGDKColor;
 
1465
function AllocGDKColor(const AColor: TColorRef): TGDKColor;
1453
1466
begin
1454
1467
  with Result do
1455
1468
  begin
1547
1560
 
1548
1561
procedure AllocGDIColor(DC: hDC; GDIColor: PGDIColor);
1549
1562
var
1550
 
  RGBColor : Longint;
 
1563
  RGBColor : DWord;
1551
1564
begin
1552
1565
  if not (cfColorAllocated in GDIColor^.ColorFlags) then
1553
1566
  begin
1554
 
    RGBColor := ColorToRGB(GDIColor^.ColorRef);
 
1567
    RGBColor := ColorToRGB(TColor(GDIColor^.ColorRef));
1555
1568
 
1556
1569
    with GDIColor^.Color do
1557
1570
    begin
1758
1771
 
1759
1772
function GetIndexAsKey(p: pointer): pointer;
1760
1773
begin
1761
 
  Result:=Pointer(PIndexRGB(p)^.Index + 1);
 
1774
  Result:={%H-}Pointer(PIndexRGB(p)^.Index + 1);
1762
1775
end;
1763
1776
 
1764
1777
function GetRGBAsKey(p: pointer): pointer;
1765
1778
begin
1766
 
  Result:=Pointer(PIndexRGB(p)^.RGB + 1);
 
1779
  Result:={%H-}Pointer(PIndexRGB(p)^.RGB + 1);
1767
1780
end;
1768
1781
 
1769
1782
function PaletteIndexToIndexRGB(Pal : PGDIObject; I : longint): PIndexRGB;
1771
1784
  HashItem: PDynHashArrayItem;
1772
1785
begin
1773
1786
  Result := nil;
1774
 
  HashItem:=Pal^.IndexTable.FindHashItemWithKey(Pointer(I + 1));
 
1787
  HashItem:=Pal^.IndexTable.FindHashItemWithKey({%H-}Pointer(I + 1));
1775
1788
  if HashItem<>nil then
1776
1789
    Result:=PIndexRGB(HashItem^.Item);
1777
1790
end;
1781
1794
  HashItem: PDynHashArrayItem;
1782
1795
begin
1783
1796
  Result := nil;
1784
 
  HashItem:=Pal^.RGBTable.FindHashItemWithKey(Pointer(RGB + 1));
 
1797
  HashItem:=Pal^.RGBTable.FindHashItemWithKey({%H-}Pointer(RGB + 1));
1785
1798
  if HashItem<>nil then
1786
1799
    Result:=PIndexRGB(HashItem^.Item);
1787
1800
end;
1790
1803
 
1791
1804
function PaletteIndexExists(Pal : PGDIObject; I : longint): Boolean;
1792
1805
begin
1793
 
  Result := Pal^.IndexTable.ContainsKey(Pointer(I + 1));
 
1806
  Result := Pal^.IndexTable.ContainsKey({%H-}Pointer(I + 1));
1794
1807
end;
1795
1808
 
1796
1809
function PaletteRGBExists(Pal : PGDIObject; RGB : longint): Boolean;
1797
1810
begin
1798
 
  Result := Pal^.RGBTable.ContainsKey(Pointer(RGB + 1));
 
1811
  Result := Pal^.RGBTable.ContainsKey({%H-}Pointer(RGB + 1));
1799
1812
end;
1800
1813
 
1801
1814
function PaletteAddIndex(Pal : PGDIObject; I, RGB : Longint): Boolean;
1914
1927
  TargetWidget: PGtkWidget;
1915
1928
  TargetObj: gPointer;
1916
1929
  KeyPressesChar: char;
 
1930
  PassUTF8AsKeyPress: Boolean;
1917
1931
 
1918
1932
  procedure StopKeyEvent;
1919
1933
  begin
1948
1962
  function GetSpecialChar: Char;
1949
1963
  begin
1950
1964
    if (AEvent^.keyval > $FF00) and (AEvent^.keyval < $FF20) and
1951
 
       (AEvent^.keyval <> GDK_KEY_Tab) then
 
1965
       (AEvent^.keyval <> GDK_KEY_TAB) then
1952
1966
      Result := Chr(AEvent^.keyval xor $FF00)
1953
1967
    else
1954
1968
      Result := #0;
2062
2076
    var
2063
2077
      i: Integer;
2064
2078
      Item: TMenuItem;
2065
 
      MenuItemWidget: PGtkWidget;
2066
2079
    begin
2067
2080
      Result:=false;
2068
2081
      if (AMenuItem=nil) or (not AMenuItem.HandleAllocated) then exit;
2069
2082
      for i:=0 to AMenuItem.Count-1 do begin
2070
2083
        Item:=AMenuItem[i];
2071
2084
        if not Item.HandleAllocated then continue;
2072
 
        if not GTK_WIDGET_SENSITIVE(PGTKWidget(Item.Handle)) then continue;
2073
 
        if IsAccel(Msg.CharCode,Item.Caption) then begin
2074
 
          // found
2075
 
          Result:=true;
2076
 
          MenuItemWidget:=PGTKWidget(Item.Handle);
2077
 
          if GtkWidgetIsA(MenuItemWidget,gtk_menu_item_get_type) then begin
2078
 
            //DebugLn(['CheckMenuChilds popup: ',dbgsName(Item)]);
2079
 
            // popup the submenu
2080
 
            gtk_signal_emit_by_name(PGtkObject(MenuItemWidget),'activate-item');
2081
 
          end;
2082
 
          exit;
2083
 
        end;
 
2085
        if not GTK_WIDGET_SENSITIVE({%H-}PGTKWidget(Item.Handle)) then continue;
 
2086
        if IsAccel(Msg.CharCode,Item.Caption) then Result:=true;
2084
2087
      end;
2085
2088
    end;
2086
2089
  
2147
2150
    // the gtk2 gtkentry handles the return key and emits an activate signal
2148
2151
    // The LCL does not use that and needs the return key event
2149
2152
    // => emulate it
2150
 
    if GtkWidgetIsA(TargetWidget, gtk_type_entry)
2151
 
    and (gdk_event_get_type(AEvent) = GDK_KEY_PRESS)
2152
 
    and (VKey=13)
2153
 
    then begin
2154
 
      //DebugLn(['EmulateKeysEatenByGtk ']);
 
2153
 
 
2154
    // emulate VK_RETURN on GtkButton. issue #21483
 
2155
    // spin button needs VK_RETURN to send OnEditingDone. issue #21224
 
2156
    if GtkWidgetIsA(TargetWidget, gtk_type_button) or
 
2157
     GtkWidgetIsA(TargetWidget, gtk_type_spin_button) then
 
2158
    begin
 
2159
      if (gdk_event_get_type(AEvent) = GDK_KEY_RELEASE) and
 
2160
        (VKey = VK_RETURN) then
 
2161
      begin
 
2162
        FillChar(Msg, SizeOf(Msg), 0);
 
2163
        Msg.CharCode := VKey;
 
2164
        if SysKey then
 
2165
          Msg.msg := LM_SYSKEYUP
 
2166
        else
 
2167
          Msg.msg := LM_KEYUP;
 
2168
        Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {TODO:  repeatcount};
 
2169
        // do not send next LM_CLICKED. issue #21483
 
2170
        g_object_set_data(PGObject(TargetWidget),'lcl-button-stop-clicked', TargetWidget);
 
2171
        NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
 
2172
        DeliverKeyMessage(TargetObj, Msg);
 
2173
      end;
 
2174
 
 
2175
    end else
 
2176
 
 
2177
    if (
 
2178
        GtkWidgetIsA(TargetWidget, gtk_type_entry) or
 
2179
        GtkWidgetIsA(TargetWidget, gtk_type_text_view)
 
2180
       )
 
2181
       and
 
2182
      (gdk_event_get_type(AEvent) = GDK_KEY_PRESS) and
 
2183
      ((VKey = VK_RETURN) or (VKey = VK_TAB)) then
 
2184
    begin
 
2185
      // DebugLn(['EmulateKeysEatenByGtk ']);
2155
2186
      FillChar(Msg, SizeOf(Msg), 0);
2156
2187
      Msg.CharCode := VKey;
2157
2188
      if SysKey then
2161
2192
      Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {TODO:  repeatcount};
2162
2193
 
2163
2194
      // send the (Sys)KeyDown message directly to the LCL
2164
 
      NotifyApplicationUserInput(Msg.Msg);
 
2195
      NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
2165
2196
      DeliverKeyMessage(TargetObj, Msg);
2166
2197
    end;
2167
2198
  end;
2195
2226
  {$ENDIF}
2196
2227
  
2197
2228
  // handle every key event only once
2198
 
  if HandledByLCL then Exit;
 
2229
  if HandledByLCL then exit;
2199
2230
 
2200
2231
  TargetWidget := AWidget;
2201
2232
  TargetObj := AData;
2242
2273
  //DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget),' ',DbgStr(EventString),' state=',AEvent^.state,' keyval=',AEvent^.keyval]);
2243
2274
  FillChar(Msg, SizeOf(Msg), 0);
2244
2275
 
2245
 
  gdk_event_key_get_string(AEvent, EventString);
 
2276
  gdk_event_key_get_string(AEvent, EventString{%H-});
2246
2277
  //DebugLn(['HandleGTKKeyUpDown TargetWidget=',GetWidgetDebugReport(TargetWidget),' ',DbgStr(EventString),' state=',AEvent^.state,' keyval=',AEvent^.keyval]);
2247
2278
  CheckDeadKey;
2248
2279
  Flags := 0;
2307
2338
      if not KeyAlreadyHandledByGtk
2308
2339
      then begin
2309
2340
        // send the (Sys)KeyDown message directly to the LCL
2310
 
        NotifyApplicationUserInput(Msg.Msg);
 
2341
        NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
2311
2342
        if DeliverKeyMessage(TargetObj, Msg)
2312
2343
        and (Msg.CharCode <> Vkey) then
2313
2344
          StopKeyEvent;
2330
2361
 
2331
2362
      // send the message directly to the LCL
2332
2363
      Msg.Result:=0;
2333
 
      NotifyApplicationUserInput(Msg.Msg);
 
2364
      NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
2334
2365
 
2335
2366
      if DeliverKeyMessage(TargetObj, Msg)
2336
2367
      and (Msg.CharCode <> VKey)
2345
2376
  if not EventStopped and AHandleDown then begin
2346
2377
 
2347
2378
    // send the UTF8 keypress
 
2379
    PassUTF8AsKeyPress := False;
2348
2380
    if ABeforeEvent then begin
2349
2381
      // try to get the UTF8 representation of the key
2350
2382
        if im_context_string <> '' then
2362
2394
        end;
2363
2395
 
2364
2396
      {$IFDEF VerboseKeyboard}
2365
 
      debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS UTF8="',DbgStr(Character),'"');
 
2397
      debugln('[HandleGTKKeyUpDown] GDK_KEY_PRESS UTF8="',DbgStr(Character),'"',
 
2398
      ' EventStopped ',dbgs(EventStopped),' CanSendChar ',dbgs(CanSendChar));
2366
2399
      {$ENDIF}
2367
2400
 
2368
 
      if Character <> ''
2369
 
      then begin
 
2401
      // we must pass KeyPress if UTF8KeyPress returned false result. issue #21489
 
2402
      if Character <> '' then
 
2403
      begin
2370
2404
        LCLObject := GetNearestLCLObject(TargetWidget);
2371
 
        if LCLObject is TWinControl
2372
 
        then begin
 
2405
        if LCLObject is TWinControl then
 
2406
        begin
2373
2407
          OldCharacter := Character;
2374
2408
          // send the key after navigation keys were handled
2375
2409
          Result := TWinControl(LCLObject).IntfUTF8KeyPress(Character, 1, SysKey);
2376
 
          if Result or (Character = '')
2377
 
          then StopKeyEvent
2378
 
          else if (Character <> OldCharacter)
2379
 
          then begin
 
2410
          if Result or (Character = '') then
 
2411
            StopKeyEvent
 
2412
          else
 
2413
          if (Character <> OldCharacter) then
 
2414
          begin
2380
2415
            WS := UTF8ToUTF16(Character);
2381
2416
            if Length(WS) > 0 then
2382
2417
            begin
2395
2430
              end
2396
2431
              else
2397
2432
                AEvent^.length := 1;
2398
 
            end
2399
 
            else
 
2433
            end else
2400
2434
              StopKeyEvent;
2401
2435
          end;
2402
2436
        end;
 
2437
        PassUTF8AsKeyPress := not EventStopped and not Result;
2403
2438
      end;
2404
2439
    end;
2405
2440
 
2406
2441
    //  send a normal KeyPress Event for Delphi compatibility
2407
 
    if not EventStopped and CanSendChar
2408
 
    then begin
 
2442
    if not EventStopped and (CanSendChar or PassUTF8AsKeyPress) then
 
2443
    begin
2409
2444
      {$IFDEF EventTrace}
2410
2445
      EventTrace('char', data);
2411
2446
      {$ENDIF}
2412
2447
 
2413
2448
      KeyPressesChar := #0;
2414
 
      if AEvent^.Length = 1
2415
 
      then begin
 
2449
      if AEvent^.Length = 1 then
 
2450
      begin
2416
2451
        // ASCII key was pressed
2417
2452
        KeyPressesChar := EventString^;
2418
 
      end
2419
 
      else
 
2453
      end else
 
2454
      begin
2420
2455
        KeyPressesChar := GetSpecialChar;
 
2456
        //NonAscii key was pressed, and UTF8KeyPress didn't handle it.issue #21489
 
2457
        if PassUTF8AsKeyPress and (KeyPressesChar = #0) then
 
2458
          KeyPressesChar := Char($3F);
 
2459
      end;
2421
2460
 
2422
 
      if KeyPressesChar <> #0
2423
 
      then begin
 
2461
      if KeyPressesChar <> #0 then
 
2462
      begin
2424
2463
        FillChar(Msg, SizeOf(Msg), 0);
2425
2464
 
2426
2465
        Msg.KeyData := CommonKeyData;
2429
2468
        // send the (Sys)Char message directly (not queued) to the LCL
2430
2469
        Msg.Result:=0;
2431
2470
        Msg.CharCode := Ord(KeyPressesChar);
2432
 
        if DeliverKeyMessage(TargetObj, Msg)
2433
 
        and (Ord(KeyPressesChar) <> Msg.CharCode)
2434
 
        then begin
 
2471
        if DeliverKeyMessage(TargetObj, Msg) and
 
2472
          (Ord(KeyPressesChar) <> Msg.CharCode) then
 
2473
        begin
2435
2474
          // key was changed by lcl
2436
 
          if (Msg.CharCode=0) or (Msg.CharCode>=128)
2437
 
          then begin
 
2475
          if (Msg.CharCode=0) or (Msg.CharCode>=128) then
 
2476
          begin
2438
2477
            // key set to invalid => just stop
2439
2478
            StopKeyEvent;
2440
 
          end
2441
 
          else begin
 
2479
          end else
 
2480
          begin
2442
2481
            // try to change the key
2443
2482
            CharToKeyVal(chr(Msg.CharCode), AEvent^.KeyVal, AEvent^.length);
2444
2483
            if AEvent^.length = 1 then
2445
2484
            begin
2446
2485
              EventString^ := Character[1];
2447
2486
              EventString[1] := #0;
2448
 
            end
2449
 
            else
 
2487
            end else
2450
2488
              EventString^ := #0;
2451
2489
            gdk_event_key_set_string(AEvent, EventString);
2452
2490
          end;
2470
2508
procedure InitKeyboardTables;
2471
2509
 
2472
2510
  procedure FindVKeyInfo(const AKeySym: Cardinal; var AVKey: Byte;
2473
 
    var AExtended, AHasMultiVK, ASecondKey: Boolean);
 
2511
    out AExtended, AHasMultiVK, ASecondKey: Boolean);
2474
2512
  var
2475
2513
    ByteKey: Byte;
2476
2514
  begin
3058
3096
  end;
3059
3097
  
3060
3098
  procedure UpdateModifierMap(const AModMap: TModMap; AKeyCode: Byte; AKeySym: Cardinal);
 
3099
  var
3061
3100
  {$ifdef VerboseModifiermap}
3062
 
  const
3063
 
    STATE_NAME: array[TShiftStateEnum] of String = ('ssShift', 'ssAlt', 'ssCtrl',
3064
 
      'ssLeft', 'ssRight', 'ssMiddle', 'ssDouble',
3065
 
      'ssMeta', 'ssSuper', 'ssHyper', 'ssAltGr', 'ssCaps', 'ssNum',
3066
 
      'ssScroll', 'ssTriple', 'ssQuad', 'ssExtra1', 'ssExtra2');
 
3101
    s: string;
3067
3102
  {$endif}
3068
 
  var
3069
3103
    ShiftState: TShiftStateEnum;
3070
3104
  begin
3071
3105
    if AModMap[AKeyCode] = 0 then Exit;
3100
3134
    MModifiers[ShiftState].UseValue := False;
3101
3135
    
3102
3136
    {$ifdef VerboseModifiermap}
3103
 
    DebugLn('Mapped keycode=%u, keysym=$%x, modifier=$%2.2x to shiftstate %s', [AKeyCode, AKeySym, AModMap[AKeyCode], STATE_NAME[ShiftState]]);
 
3137
    WriteStr(s, ShiftState);
 
3138
    DebugLn('Mapped keycode=%u, keysym=$%x, modifier=$%2.2x to shiftstate %s',
 
3139
            [AKeyCode, AKeySym, AModMap[AKeyCode], s]);
3104
3140
    {$endif}
3105
3141
 
3106
3142
  end;
3138
3174
 
3139
3175
var
3140
3176
  KeySyms: array of guint;
3141
 
  KeyVals: Pguint;
3142
 
  KeymapKeys: PGdkKeymapKey;
 
3177
  KeyVals: Pguint = nil;
 
3178
  KeymapKeys: PGdkKeymapKey = nil;
3143
3179
  UniChar: gunichar;
3144
3180
 
3145
3181
  KeySymCount: Integer;
3166
3202
  if XDisplay = nil then Exit;
3167
3203
 
3168
3204
  FillByte(MKeyStateMap, SizeOF(MKeyStateMap), 0);
3169
 
  SetupModifiers(XDisplay, ModMap);
 
3205
  SetupModifiers(XDisplay, ModMap{%H-});
3170
3206
{$endif}
3171
3207
 
3172
3208
  LoKey := 0;
3211
3247
    for m := 0 to KeySymCount - 1 do
3212
3248
    begin
3213
3249
      if KeySyms[m] = 0 then Continue;
3214
 
      FindVKeyInfo(KeySyms[m], VKey, Extended, HasMultiVK, SecondKey);
 
3250
      FindVKeyInfo(KeySyms[m], VKey, Extended{%H-}, HasMultiVK,{%H-} SecondKey);
3215
3251
    {$ifdef Windows}
3216
3252
      // on windows, the keycode is perdef the VK,
3217
3253
      // we only enter this loop to set the correct flags
3257
3293
        // In that case we have to FIndKeyInfo for every keysym
3258
3294
        if m = 1
3259
3295
        then begin
3260
 
          FindVKeyInfo(KeySyms[m], VKey, Extended, DummyBool, DummyBool);
 
3296
          FindVKeyInfo(KeySyms[m], VKey, Extended, DummyBool, DummyBool{%H-});
3261
3297
          MKeyCodeInfo[KeyCode].VKey2 := VKey;
3262
3298
        end;
3263
3299
      end;
3265
3301
 
3266
3302
      MKeyCodeInfo[KeyCode].Flags := MKeyCodeInfo[KeyCode].Flags or KEYFLAGS[m];
3267
3303
 
3268
 
      FillByte(KeySymChars, SizeOf(KeySymChars), 0);
 
3304
      FillByte(KeySymChars{%H-}, SizeOf(KeySymChars), 0);
3269
3305
 
3270
3306
      UniChar := gdk_keyval_to_unicode(KeySyms[m]);
3271
3307
      if UniChar = 0 then Continue;
3393
3429
var DlgWindow: PGtkWidget;
3394
3430
begin
3395
3431
  if (ADialog=nil) or (ADialog.Handle=0) then exit;
3396
 
  DlgWindow:=PGtkWidget(ADialog.Handle);
 
3432
  DlgWindow:={%H-}PGtkWidget(ADialog.Handle);
3397
3433
  if DlgWindow^.Allocation.Width>0 then
3398
3434
    ADialog.Width:=DlgWindow^.Allocation.Width;
3399
3435
  if DlgWindow^.Allocation.Height>0 then
3417
3453
  LCLHistoryMenu: PGTKWidget;
3418
3454
begin
3419
3455
  if (ADialog=nil) or (not ADialog.HandleAllocated) then exit;
3420
 
  DlgWindow:=PGtkWidget(ADialog.Handle);
 
3456
  DlgWindow:={%H-}PGtkWidget(ADialog.Handle);
3421
3457
  {$IFDEF VerboseTransient}
3422
3458
  DebugLn('DestroyCommonDialogAddOns ',ADialog.Name,':',ADialog.ClassName);
3423
3459
  {$ENDIF}
3594
3630
    handle := TCommonDialog(AnObject).Handle;
3595
3631
  end
3596
3632
  else begin
3597
 
    Assert(False, Format('Trace:  [ObjectToGtkObject] Message received with unhandled class-type <%s>', [AnObject.ClassName]));
 
3633
    //DebugLn(Format('Trace:  [ObjectToGtkObject] Message received with unhandled class-type <%s>', [AnObject.ClassName]));
3598
3634
  end;
3599
 
  Result := PGTKObject(handle);
 
3635
  Result := {%H-}PGTKObject(handle);
3600
3636
  if handle = 0 then
3601
3637
    Assert (false, 'Trace:  [ObjectToGtkObject]****** Warning: handle = 0 *******');
3602
3638
end;
3707
3743
end;
3708
3744
 
3709
3745
{-------------------------------------------------------------------------------
3710
 
 Some need the HiddenLCLobject which created a parent of this widget.
3711
 
 
3712
 
 MWE: is this obsolete ?
3713
 
-------------------------------------------------------------------------------}
3714
 
procedure SetHiddenLCLObject(const Widget: Pointer; const AnObject: TObject);
3715
 
begin
3716
 
  if (Widget <> nil) then
3717
 
    gtk_object_set_data(Widget, 'LCLHiddenClass', Pointer(AnObject));
3718
 
end;
3719
 
 
3720
 
function GetHiddenLCLObject(const Widget: Pointer): TObject;
3721
 
begin
3722
 
  Result := TObject(gtk_object_get_data(Widget, 'LCLHiddenClass'));
3723
 
end;
3724
 
 
3725
 
{-------------------------------------------------------------------------------
3726
3746
  function GetNearestLCLObject(Widget: PGtkWidget): TObject;
3727
3747
  
3728
3748
  Retrieves the LCLObject belonging to the widget. If the widget is created as
3803
3823
  if (LCLParent=nil) or (not (LCLParent is TWinControl))
3804
3824
  or (not TWinControl(LCLParent).HandleAllocated)
3805
3825
  then exit;
3806
 
  Result:=PGtkWidget(TWinControl(LCLParent).Handle);
 
3826
  Result:={%H-}PGtkWidget(TWinControl(LCLParent).Handle);
3807
3827
end;
3808
3828
 
3809
3829
function GetWinControlFixedWidget(Child: PGtkWidget): PGtkWidget;
3932
3952
    New(Result);
3933
3953
    FillChar(Result^, SizeOf(Result^), 0);
3934
3954
    gtk_object_set_data(AWidget, 'widgetinfo', Result);
3935
 
    Result^.DefaultCursor := HCursor(-1);
3936
3955
  end;
3937
3956
end;
3938
3957
 
3948
3967
  Result^.CoreWidget := AWidget;
3949
3968
  Result^.Style := AParams.Style;
3950
3969
  Result^.ExStyle := AParams.ExStyle;
3951
 
  Result^.WndProc := PtrUInt(AParams.WindowClass.lpfnWndProc);
 
3970
  Result^.WndProc := {%H-}PtrUInt(AParams.WindowClass.lpfnWndProc);
3952
3971
end;
3953
3972
 
3954
3973
function GetWidgetInfo(const AWidget: Pointer {; const Create: Boolean = False}): PWidgetInfo;
4031
4050
    if (Info^.LCLObject is TWinControl) then begin
4032
4051
      AWinControl:=TWinControl(Info^.LCLObject);
4033
4052
      if AWinControl.HandleAllocated
4034
 
      and (PGtkWidget(AWinControl.Handle)=Widget) then begin
 
4053
      and ({%H-}PGtkWidget(AWinControl.Handle)=Widget) then begin
4035
4054
        // send the LM_DESTROY message before destroying the widget
4036
 
        FillChar(Mess,SizeOf(Mess),0);
 
4055
        FillChar(Mess{%H-},SizeOf(Mess),0);
4037
4056
        Mess.msg := LM_DESTROY;
4038
4057
        DeliverMessage(Info^.LCLObject, Mess);
4039
4058
      end;
4047
4066
  //DebugLn(['DestroyWidget B']);
4048
4067
end;
4049
4068
 
 
4069
function IsTTabControl(AWidget: PGtkWidget): Boolean;
 
4070
var
 
4071
  WidgetInfo: PWidgetInfo;
 
4072
begin
 
4073
  if AWidget = nil then
 
4074
    exit(False);
 
4075
  WidgetInfo := GetWidgetInfo(AWidget);
 
4076
  if (WidgetInfo = nil) or (WidgetInfo^.CoreWidget = nil) then
 
4077
    exit(False);
 
4078
  Result := gtk_object_get_data(PGtkObject(WidgetInfo^.CoreWidget),'lcl_ttabcontrol') <> nil;
 
4079
end;
 
4080
 
4050
4081
{-------------------------------------------------------------------------------
4051
4082
  function GetGtkNoteBookDummyPage(ANoteBookWidget: PGtkNoteBook): PGtkWidget;
4052
4083
 
4081
4112
  ClientWidget: PGtkWidget;
4082
4113
  NoteBookWidget: PGtkNotebook;
4083
4114
begin
4084
 
  if not TCustomNotebook(ANoteBook).HandleAllocated then exit;
4085
 
  NoteBookWidget := PGtkNotebook(TCustomNotebook(ANoteBook).Handle);
 
4115
  if not TCustomTabControl(ANoteBook).HandleAllocated then exit;
 
4116
  NoteBookWidget := {%H-}PGtkNotebook(TCustomTabControl(ANoteBook).Handle);
4086
4117
  ClientWidget := nil;
4087
4118
  SetFixedWidget(NoteBookWidget, ClientWidget);
4088
4119
end;
4125
4156
 
4126
4157
{-------------------------------------------------------------------------------
4127
4158
  method UpdateNotebookPageTab
4128
 
  Params: ANoteBook: TCustomNotebook; APage: TCustomPage
 
4159
  Params: ANoteBook: TCustomTabControl; APage: TCustomPage
4129
4160
  Result: none
4130
4161
 
4131
4162
  Updates the tab of a page of a notebook. This contains the image to the left
4133
4164
-------------------------------------------------------------------------------}
4134
4165
procedure UpdateNotebookPageTab(ANoteBook, APage: TObject);
4135
4166
var
4136
 
  TheNoteBook: TCustomNotebook;
 
4167
  TheNoteBook: TCustomTabControl;
4137
4168
  ThePage: TCustomPage;
4138
4169
 
4139
4170
  NoteBookWidget: PGtkWidget;  // the notebook
4288
4319
 
4289
4320
begin
4290
4321
  ThePage := TCustomPage(APage);
4291
 
  TheNoteBook := TCustomNotebook(ANoteBook);
 
4322
  TheNoteBook := TCustomTabControl(ANoteBook);
4292
4323
  if (APage=nil) or (not ThePage.HandleAllocated) then exit;
4293
4324
  if TheNoteBook=nil then begin
4294
 
    TheNoteBook:=TCustomNotebook(ThePage.Parent);
 
4325
    TheNoteBook:=TCustomTabControl(ThePage.Parent);
4295
4326
    if TheNoteBook=nil then exit;
4296
4327
  end;
4297
 
  NoteBookWidget:=PGtkWidget(TWinControl(TheNoteBook).Handle);
4298
 
  PageWidget:=PGtkWidget(TWinControl(ThePage).Handle);
 
4328
  NoteBookWidget:={%H-}PGtkWidget(TWinControl(TheNoteBook).Handle);
 
4329
  PageWidget:={%H-}PGtkWidget(TWinControl(ThePage).Handle);
4299
4330
 
4300
4331
  // get the tab container and the tab components: pixmap, label and closebtn
4301
4332
  TabWidget:=gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget),
4315
4346
                                          PageWidget);
4316
4347
  if MenuWidget<>nil then begin
4317
4348
    MenuImageWidget:=gtk_object_get_data(PGtkObject(MenuWidget), 'TabImage');
4318
 
    MenuLabelWidget:=gtk_object_get_data(PGtkObject(MenuWidget), 'TabLabel');
 
4349
    MenuLabelWidget:=gtk_object_get_data(PGtkObject(MenuWidget), 'TabMenuLabel');
4319
4350
  end else begin
4320
4351
    MenuImageWidget:=nil;
4321
4352
    MenuLabelWidget:=nil;
4326
4357
  UpdateTabCloseBtn;
4327
4358
end;
4328
4359
 
 
4360
procedure UpdateNotebookTabFont(APage: TWinControl; AFont: TFont);
 
4361
var
 
4362
  NoteBookWidget: PGtkWidget;
 
4363
  PageWidget: PGtkWidget;
 
4364
  TabWidget: PGtkWidget;
 
4365
  TabLabelWidget: PGtkWidget;
 
4366
begin
 
4367
 
 
4368
  NoteBookWidget:={%H-}PGtkWidget((APage.Parent).Handle);
 
4369
  PageWidget:={%H-}PGtkWidget(APage.Handle);
 
4370
  TabWidget:=gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget),
 
4371
                                        PageWidget);
 
4372
  if TabWidget<>nil then
 
4373
    TabLabelWidget:=gtk_object_get_data(PGtkObject(TabWidget), 'TabLabel')
 
4374
  else
 
4375
    TabLabelWidget:=nil;
 
4376
 
 
4377
  // set new font to page
 
4378
  Gtk2WidgetSet.SetWidgetFont(PageWidget, AFont);
 
4379
  Gtk2WidgetSet.SetWidgetColor(PageWidget, AFont.Color, clNone,
 
4380
                            [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,
 
4381
                             GTK_STATE_PRELIGHT,GTK_STATE_SELECTED,
 
4382
                             GTK_STYLE_TEXT]);
 
4383
 
 
4384
  // set new font to tab
 
4385
 
 
4386
  if TabLabelWidget = nil then
 
4387
    exit;
 
4388
 
 
4389
  Gtk2WidgetSet.SetWidgetFont(TabLabelWidget, AFont);
 
4390
  Gtk2WidgetSet.SetWidgetColor(TabLabelWidget, AFont.Color, clNone,
 
4391
    [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,
 
4392
    GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
 
4393
end;
 
4394
 
4329
4395
 
4330
4396
{-------------------------------------------------------------------------------
4331
4397
  GetWidgetScreenPos
4360
4426
    Result.X:=0;
4361
4427
    Result.Y:=0;
4362
4428
  end;
 
4429
 
 
4430
  {gtk2 < 2.10 sometimes raises assertion here. That's because of gtk2 bug and
 
4431
   cannot be fixed by us.
 
4432
   http://gitorious.org/gsettings-gtk/gtk/blobs/gsettings-gtk/ChangeLog.pre-2-10
 
4433
   look for gtk_widget_get_parent_window() in changes.}
 
4434
 
4363
4435
  // check if the gdkwindow is the clientwindow of the parent
4364
4436
  if gtk_widget_get_parent_window(TheWidget)=TheWindow then begin
4365
4437
    // the widget is using its parent window
4452
4524
  Result := GetWidgetOrigin(TheWidget);
4453
4525
end;
4454
4526
 
 
4527
function GetWidgetClientRect(TheWidget: PGtkWidget): TRect;
 
4528
var
 
4529
  Widget, ClientWidget: PGtkWidget;
 
4530
  AChild: PGtkWidget;
 
4531
 
 
4532
  procedure GetNoteBookClientRect(NBWidget: PGtkNotebook);
 
4533
  var
 
4534
    PageIndex: LongInt;
 
4535
    PageWidget: PGtkWidget;
 
4536
    FrameBorders: TRect;
 
4537
    aWidth: LongInt;
 
4538
    aHeight: LongInt;
 
4539
  begin
 
4540
    // get current page
 
4541
    PageIndex:=gtk_notebook_get_current_page(NBWidget);
 
4542
    if PageIndex>=0 then
 
4543
      PageWidget:=gtk_notebook_get_nth_page(NBWidget,PageIndex)
 
4544
    else
 
4545
      PageWidget:=nil;
 
4546
    if (PageWidget<>nil) and GTK_WIDGET_RC_STYLE(PageWidget)
 
4547
    and ((PageWidget^.Allocation.Width>1) or (PageWidget^.Allocation.Height>1))
 
4548
    then begin
 
4549
      // get the size of the current page
 
4550
      Result.Right:=PageWidget^.Allocation.Width;
 
4551
      Result.Bottom:=PageWidget^.Allocation.Height;
 
4552
      //DebugLn(['GetNoteBookClientRect using pagewidget: ',GetWidgetDebugReport(Widget),' ARect=',dbgs(aRect)]);
 
4553
    end else begin
 
4554
      // use defaults
 
4555
      FrameBorders:=GetStyleNotebookFrameBorders;
 
4556
      aWidth:=Widget^.allocation.width;
 
4557
      aHeight:=Widget^.allocation.height;
 
4558
      Result:=Rect(0,0,
 
4559
         Max(0,AWidth-FrameBorders.Left-FrameBorders.Right),
 
4560
         Max(0,aHeight-FrameBorders.Top-FrameBorders.Bottom));
 
4561
      //DebugLn(['GetNoteBookClientRect using defaults: ',GetWidgetDebugReport(Widget),' ARect=',dbgs(aRect),' Frame=',dbgs(FrameBorders)]);
 
4562
    end;
 
4563
  end;
 
4564
begin
 
4565
  Result := Rect(0, 0, 0, 0);
 
4566
  Widget := TheWidget;
 
4567
  ClientWidget := GetFixedWidget(Widget);
 
4568
  if (ClientWidget <> nil) then
 
4569
    Widget := ClientWidget;
 
4570
  if (Widget <> nil) then
 
4571
  begin
 
4572
    Result.Right:=Widget^.Allocation.Width;
 
4573
    Result.Bottom:=Widget^.Allocation.Height;
 
4574
    if GtkWidgetIsA(Widget,gtk_notebook_get_type) then
 
4575
      GetNoteBookClientRect(PGtkNoteBook(Widget))
 
4576
    else
 
4577
    if GTK_IS_SCROLLED_WINDOW(Widget) and GTK_IS_BIN(Widget) then
 
4578
    begin
 
4579
      AChild := gtk_bin_get_child(PGtkBin(Widget));
 
4580
      if (AChild <> nil) and GTK_IS_TREE_VIEW(AChild) then
 
4581
      begin
 
4582
        Result.Right := AChild^.allocation.width - AChild^.allocation.x;
 
4583
        Result.Bottom := AChild^.allocation.height - AChild^.allocation.y;
 
4584
      end;
 
4585
    end;
 
4586
  end;
 
4587
  {$IfDef VerboseGetClientRect}
 
4588
  if ClientWidget<>nil then begin
 
4589
    DebugLn('GetClientRect  Widget=',GetWidgetDebugReport(PgtkWidget(Handle)),
 
4590
       ' Client=',DbgS(ClientWidget),WidgetFlagsToString(ClientWidget),
 
4591
       ' WindowSize=',dbgs(Result.Right),',',dbgs(Result.Bottom),
 
4592
       ' Allocation=',dbgs(ClientWidget^.Allocation.Width),',',dbgs(ClientWidget^.Allocation.Height)
 
4593
       );
 
4594
  end else begin
 
4595
    DebugLn('GetClientRect  Widget=',GetWidgetDebugReport(PgtkWidget(Handle)),
 
4596
       ' Client=',DbgS(ClientWidget),WidgetFlagsToString(ClientWidget),
 
4597
       ' WindowSize=',dbgs(Result.Right),',',dbgs(Result.Bottom),
 
4598
       ' Allocation=',dbgs(Widget^.Allocation.Width),',',dbgs(Widget^.Allocation.Height)
 
4599
       );
 
4600
  end;
 
4601
  if GetLCLObject(Widget) is TCustomPage then begin
 
4602
    DebugLn(['TGtk2WidgetSet.GetClientRect Rect=',dbgs(Result),' ',GetWidgetDebugReport(Widget)]);
 
4603
  end;
 
4604
  {$EndIf}
 
4605
end;
 
4606
 
4455
4607
{-------------------------------------------------------------------------------
4456
4608
  TranslateGdkPointToClientArea
4457
4609
 
4494
4646
  end;
4495
4647
end;
4496
4648
 
4497
 
{------------------------------------------------------------------------------
4498
 
  Function: UpdateMouseCaptureControl
4499
 
  Params: none
4500
 
  Returns:  none
4501
 
 
4502
 
  Sets MouseCaptureWidget to the current capturing widget.
4503
 
 ------------------------------------------------------------------------------}
4504
 
procedure UpdateMouseCaptureControl;
4505
 
var
4506
 
  OldMouseCaptureWidget,
4507
 
  CurMouseCaptureWidget: PGtkWidget;
4508
 
begin
4509
 
  {$IFNDEF GTK2_USE_OLD_CAPTURE}
4510
 
  exit;
4511
 
  {$ENDIF}
4512
 
  OldMouseCaptureWidget:=MouseCaptureWidget;
4513
 
  CurMouseCaptureWidget:=gtk_grab_get_current;
4514
 
 
4515
 
  if OldMouseCaptureWidget<>CurMouseCaptureWidget then begin
4516
 
    // the mouse grab changed
4517
 
    // -> this means the gtk itself has changed the mouse grab
4518
 
    {$IFDEF VerboseMouseCapture}
4519
 
    DebugLn('UpdateMouseCaptureControl Capture changed from ',
4520
 
      '[',GetWidgetDebugReport(OldMouseCaptureWidget),' type=',MouseCaptureTypeNames[MouseCaptureType],']',
4521
 
      ' to [',GetWidgetDebugReport(CurMouseCaptureWidget),' type=GTK]');
4522
 
    if CurMouseCaptureWidget<>nil then
4523
 
    DebugLn('parent ',    GetWidgetDebugReport(CurMouseCaptureWidget^.Parent));
4524
 
    {$ENDIF}
4525
 
 
4526
 
    // notify the new capture control
4527
 
    MouseCaptureWidget:=CurMouseCaptureWidget;
4528
 
    MouseCaptureType:=mctGTK;
4529
 
    if MouseCaptureWidget<>nil then begin
4530
 
      // the MouseCaptureWidget is probably not a main widget
4531
 
      SendMessage(HWnd(PtrUInt(MouseCaptureWidget)), LM_CAPTURECHANGED, 0,
4532
 
        HWnd(PtrUInt(OldMouseCaptureWidget)));
4533
 
    end;
4534
 
  end;
4535
 
end;
4536
 
 
4537
4649
procedure IncreaseMouseCaptureIndex;
4538
4650
begin
4539
4651
  if MouseCaptureIndex<$ffffffff then
4542
4654
    MouseCaptureIndex:=0;
4543
4655
end;
4544
4656
 
4545
 
{$IFDEF GTK2_USE_OLD_CAPTURE}
4546
 
procedure CaptureMouseForWidget(Widget: PGtkWidget; Owner: TMouseCaptureType);
4547
 
var
4548
 
  CaptureWidget: PGtkWidget;
4549
 
  NowIndex: Cardinal;
4550
 
begin
4551
 
  {$IFDEF VerboseMouseCapture}
4552
 
  DebugLn('CaptureMouseForWidget START ',GetWidgetDebugReport(Widget));
4553
 
  {$ENDIF}
4554
 
  if not (Owner in [mctGTKIntf,mctLCL]) then exit;
4555
 
  // not every widget can capture the mouse
4556
 
  CaptureWidget := GetDefaultMouseCaptureWidget(Widget);
4557
 
  if CaptureWidget=nil then exit;
4558
 
 
4559
 
  UpdateMouseCaptureControl;
4560
 
  if (MouseCaptureType<>mctGTK) then begin
4561
 
    // we are capturing
4562
 
    if (MouseCaptureWidget=CaptureWidget) then begin
4563
 
      // we are already capturing this widget
4564
 
      exit;
4565
 
    end;
4566
 
    // release old capture
4567
 
    ReleaseMouseCapture;
4568
 
  end;
4569
 
 
4570
 
  {$IFDEF VerboseMouseCapture}
4571
 
  DebugLn('CaptureMouseForWidget Start Capturing for ',GetWidgetDebugReport(CaptureWidget));
4572
 
  {$ENDIF}
4573
 
  IncreaseMouseCaptureIndex;
4574
 
  NowIndex:=MouseCaptureIndex;
4575
 
  if not gtk_widget_has_focus(CaptureWidget) then
4576
 
    gtk_widget_grab_focus(CaptureWidget);
4577
 
  if NowIndex=MouseCaptureIndex then begin
4578
 
    {$IFDEF VerboseMouseCapture}
4579
 
    DebugLn('CaptureMouseForWidget Commit Capturing for ',GetWidgetDebugReport(CaptureWidget));
4580
 
    {$ENDIF}
4581
 
    MouseCaptureWidget:=CaptureWidget;
4582
 
    MouseCaptureType:=Owner;
4583
 
    gtk_grab_add(CaptureWidget);
4584
 
  end;
4585
 
end;
4586
 
{$ENDIF}
4587
 
 
4588
4657
function GetDefaultMouseCaptureWidget(Widget: PGtkWidget
4589
4658
  ): PGtkWidget;
4590
4659
var
4615
4684
 
4616
4685
  if CanCapture then
4617
4686
  begin
4618
 
    if GTK_IS_NOTEBOOK(PGtkWidget(TWinControl(LCLObject).Handle)) then
 
4687
    if GTK_IS_NOTEBOOK({%H-}PGtkWidget(TWinControl(LCLObject).Handle)) then
4619
4688
      exit;
4620
4689
 
4621
4690
    Parent := TWinControl(LCLObject).Parent;
4622
4691
    if Assigned(Parent) then
4623
4692
    begin
4624
 
      if GTK_IS_NOTEBOOK(PGtkWidget(Parent.Handle)) then
 
4693
      if GTK_IS_NOTEBOOK({%H-}PGtkWidget(Parent.Handle)) then
4625
4694
        exit;
4626
4695
    end;
4627
 
    WidgetInfo:=GetWidgetInfo(PGtkWidget(TWinControl(LCLObject).Handle),false);
 
4696
    WidgetInfo:=GetWidgetInfo({%H-}PGtkWidget(TWinControl(LCLObject).Handle),false);
4628
4697
    if WidgetInfo <> nil then
4629
4698
    begin
4630
4699
      {$IFDEF VerboseMouseCapture}
4631
4700
      CurrentGrab := gtk_grab_get_current;
4632
 
      writeln('GetDefaultMouseCaptureWidget: ',TWinControl(LCLObject).ClassName,' core ',
4633
 
        dbghex(PtrUInt(WidgetInfo^.CoreWidget)),' client ',dbghex(PtrUInt(WidgetInfo^.ClientWidget)),
4634
 
        ' currentgrab ', dbghex(PtrUInt(CurrentGrab)));
 
4701
      debugln(['GetDefaultMouseCaptureWidget: ',TWinControl(LCLObject).ClassName,
 
4702
        ' core ',dbghex({%H-}PtrUInt(WidgetInfo^.CoreWidget)),
 
4703
        ' client ',dbghex({%H-}PtrUInt(WidgetInfo^.ClientWidget)),
 
4704
        ' currentgrab ', dbghex({%H-}PtrUInt(CurrentGrab))]);
4635
4705
      if CurrentGrab <> nil then
4636
4706
      begin
4637
4707
        GrabInfo := GetWidgetInfo(CurrentGrab);
4638
4708
        if GrabInfo <> nil then
4639
 
          writeln('GetDefaultMouseCaptureWidget: CURRENT GRAB ',GrabInfo^.LCLObject.ClassName);
 
4709
          debugln('GetDefaultMouseCaptureWidget: CURRENT GRAB ',GrabInfo^.LCLObject.ClassName);
4640
4710
      end;
4641
4711
      {$ENDIF}
4642
4712
      if WidgetInfo^.ClientWidget <> nil then
4645
4715
          Result := WidgetInfo^.ClientWidget
4646
4716
        else
4647
4717
          Result := WidgetInfo^.CoreWidget;
 
4718
      end else
 
4719
      if GTK_IS_SCROLLED_WINDOW(Widget) and (GTK_IS_BIN(Widget)) then
 
4720
      begin
 
4721
        {$IFDEF VerboseMouseCapture}
 
4722
        debugln('GetDefaultMouseCaptureWidget: **',TWinControl(LCLObject).ClassName,' grabbing viewport ...');
 
4723
        {$ENDIF}
 
4724
        Result := gtk_bin_get_child(PGtkBin(Widget));
4648
4725
      end;
4649
4726
    end;
4650
4727
  end;
4662
4739
  OldMouseCaptureWidget: PGtkWidget;
4663
4740
  Info: PWidgetInfo;
4664
4741
begin
 
4742
  OldMouseCaptureWidget := gtk_grab_get_current;
 
4743
  if (OldMouseCaptureWidget=nil) and (MouseCaptureWidget=nil) then exit;
4665
4744
  {$IFDEF VerboseMouseCapture}
4666
 
  DebugLn('ReleaseMouseCapture ',dbgs(ord(MouseCaptureType)),' MouseCaptureWidget=[',GetWidgetDebugReport(MouseCaptureWidget),']');
 
4745
  DebugLn('ReleaseMouseCapture gtk_grab=[',GetWidgetDebugReport(OldMouseCaptureWidget),'] MouseCaptureWidget=[',GetWidgetDebugReport(MouseCaptureWidget),']');
4667
4746
  {$ENDIF}
4668
 
  if MouseCaptureType=mctGTK then
 
4747
  Info := GetWidgetInfo(OldMouseCaptureWidget, false);
 
4748
  if (Info <> nil) and (Info^.CoreWidget <> nil) then
4669
4749
  begin
4670
 
    Info := GetWidgetInfo(gtk_grab_get_current, false);
4671
 
    if (Info <> nil) and (Info^.CoreWidget <> nil) then
 
4750
    if GtkWidgetIsA(Info^.CoreWidget, gtk_list_get_type) then
4672
4751
    begin
4673
 
      if GtkWidgetIsA(Info^.CoreWidget, gtk_list_get_type) then
4674
 
      begin
4675
 
        // Paul Ishenin:
4676
 
        // listbox grabs pointer and other control for itself, when we click on listbox item
4677
 
        // also it changes its state to drag_selection
4678
 
        // this is not expected in LCL and as result cause bugs, such as 7892
4679
 
        // so we need end drag selection manually
4680
 
        OldMouseCaptureWidget := Info^.CoreWidget;
4681
 
        gtk_list_end_drag_selection(PGtkList(OldMouseCaptureWidget));
4682
 
      end;
 
4752
      // Paul Ishenin:
 
4753
      // listbox grabs pointer and other control for itself, when we click on listbox item
 
4754
      // also it changes its state to drag_selection
 
4755
      // this is not expected in LCL and as result cause bugs, such as 7892
 
4756
      // so we need end drag selection manually
 
4757
      OldMouseCaptureWidget := Info^.CoreWidget;
 
4758
      gtk_list_end_drag_selection(PGtkList(OldMouseCaptureWidget));
 
4759
      exit;
4683
4760
    end;
4684
 
    exit;
4685
4761
  end;
4686
 
  OldMouseCaptureWidget:=MouseCaptureWidget;
4687
 
  MouseCaptureWidget:=nil;
4688
 
  MouseCaptureType:=mctGTK;
4689
 
  if OldMouseCaptureWidget<>nil then
 
4762
  if MouseCaptureWidget<>nil then begin
 
4763
    {$IfDef VerboseMouseCapture}
 
4764
    DebugLn('TGtk2WidgetSet.ReleaseMouseCapture gtk_grab_remove=[',GetWidgetDebugReport(OldMouseCaptureWidget),']');
 
4765
    {$EndIf}
 
4766
    OldMouseCaptureWidget:=MouseCaptureWidget;
 
4767
    MouseCaptureWidget:=nil;
4690
4768
    gtk_grab_remove(OldMouseCaptureWidget);
 
4769
  end;
4691
4770
  // tell the LCL
4692
4771
  SetCaptureControl(nil);
4693
4772
end;
4764
4843
 
4765
4844
function GetDesignSignalMask(Widget: PGtkWidget): TDesignSignalMask;
4766
4845
begin
4767
 
  Result:=TDesignSignalMask(PtrUInt(gtk_object_get_data(PGtkObject(Widget),
 
4846
  Result:=TDesignSignalMask({%H-}PtrUInt(gtk_object_get_data(PGtkObject(Widget),
4768
4847
                                                'LCLDesignMask')));
4769
4848
end;
4770
4849
 
4771
4850
procedure SetDesignSignalMask(Widget: PGtkWidget; NewMask: TDesignSignalMask);
4772
4851
begin
4773
 
  gtk_object_set_data(PGtkObject(Widget),'LCLDesignMask',Pointer(PtrInt(NewMask)));
 
4852
  gtk_object_set_data(PGtkObject(Widget),'LCLDesignMask',{%H-}Pointer(PtrInt(NewMask)));
4774
4853
end;
4775
4854
 
4776
4855
function GetDesignOnlySignalFlag(Widget: PGtkWidget;
4780
4859
          and DesignSignalMasks[DesignSignalType])<>0;
4781
4860
end;
4782
4861
 
4783
 
function SignalConnected(const AnObject:PGTKObject; const ASignal: PChar;
 
4862
function SignalConnected(const AnObject:PGTKObject; const {%H-}ASignal: PChar;
4784
4863
  const ACallBackProc: Pointer; const ALCLObject: TObject;
4785
 
  const ASFlags: TConnectSignalFlags): boolean;
 
4864
  const {%H-}ASFlags: TConnectSignalFlags): boolean;
4786
4865
begin
4787
4866
  Result:=g_signal_handler_find(AnObject,
4788
4867
    G_SIGNAL_MATCH_FUNC or G_SIGNAL_MATCH_DATA,
4837
4916
  if (csfUpdateSignalMask in ASFlags) and (AReqSignalMask <> 0)
4838
4917
  then begin
4839
4918
    MainWidget := GetMainWidget(PGtkWidget(AnObject));
4840
 
    if MainWidget=nil
4841
 
    then MainWidget := PGtkWidget(AnObject);
4842
4919
    WinWidgetInfo := GetWidgetInfo(MainWidget,true);
4843
4920
    WinWidgetInfo^.EventMask := WinWidgetInfo^.EventMask or AReqSignalMask;
4844
4921
  end;
4915
4992
procedure ConnectInternalWidgetsSignals(AWidget: PGtkWidget;
4916
4993
  AWinControl: TWinControl);
4917
4994
 
4918
 
  function WidgetIsInternal(TheWidget: PGtkWidget): boolean;
4919
 
  begin
4920
 
    Result:=(TheWidget<>nil)
4921
 
      and (PGtkWidget(AWinControl.Handle)<>TheWidget)
4922
 
      and (GetMainWidget(TheWidget)=nil);
4923
 
  end;
4924
 
 
4925
4995
  procedure ConnectSignals(TheWidget: PGtkWidget); forward;
4926
4996
 
4927
4997
  procedure ConnectChilds(TheWidget: PGtkWidget);
4963
5033
 
4964
5034
  procedure ConnectSignals(TheWidget: PGtkWidget);
4965
5035
  var
4966
 
    LCLObject, HiddenLCLObject: TObject;
 
5036
    LCLObject: TObject;
4967
5037
    DesignSignalType: TDesignSignalType;
4968
5038
    DesignFlags: TConnectSignalFlags;
4969
5039
  begin
4970
5040
    //if AWinControl is TListView then DebugLn('ConnectSignals A ',DbgS(TheWidget));
4971
5041
    if TheWidget=nil then exit;
4972
 
    
4973
5042
    // check if TheWidget belongs to another LCL object
4974
5043
    LCLObject:=GetLCLObject(TheWidget);
4975
 
    HiddenLCLObject:=GetHiddenLCLObject(TheWidget);
4976
5044
    if (LCLObject<>nil) and (LCLObject<>AWinControl) then begin
4977
5045
      exit;
4978
5046
    end;
4979
 
    if (HiddenLCLObject<>nil) and (HiddenLCLObject<>AWinControl) then begin
4980
 
      exit;
4981
 
    end;
4982
5047
 
4983
5048
    //if AWinControl is TListView then DebugLn('ConnectSignals B ',DbgS(TheWidget));
4984
5049
    // connect signals needed for design mode:
4997
5062
                    DesignFlags);
4998
5063
    end;
4999
5064
 
5000
 
    if WidgetIsInternal(TheWidget) then
5001
 
      // mark widget as 'hidden' connected
5002
 
      SetHiddenLCLObject(TheWidget,AWinControl);
5003
 
 
5004
5065
    // connect recursively ...
5005
5066
    ConnectChilds(TheWidget);
5006
5067
  end;
5110
5171
    or (csDesigning in CurForm.ComponentState)
5111
5172
    then continue;
5112
5173
    
5113
 
    CurWindow:=PGtkWidget(CurForm.Handle);
 
5174
    CurWindow:={%H-}PGtkWidget(CurForm.Handle);
5114
5175
    CurAccelGroup:=GetAccelGroup(CurWindow,false);
5115
5176
    {$IFDEF VerboseAccelerator}
5116
5177
    DebugLn('ShareWindowAccelGroups ',TheForm.Name,':',TheForm.ClassName,
5156
5217
    or (not CurForm.HandleAllocated)
5157
5218
    then continue;
5158
5219
 
5159
 
    CurWindow:=PGtkWidget(CurForm.Handle);
 
5220
    CurWindow:={%H-}PGtkWidget(CurForm.Handle);
5160
5221
    CurAccelGroup:=GetAccelGroup(CurWindow,false);
5161
5222
    {$IFDEF VerboseAccelerator}
5162
5223
    DebugLn('UnshareWindowAccelGroups ',TheForm.Name,':',TheForm.ClassName,
5194
5255
    if Control is TCustomForm then begin
5195
5256
      Form:=TCustomForm(Control);
5196
5257
      if Form.HandleAllocated then begin
5197
 
        Result:=GetAccelGroup(PGtkWidget(Form.Handle),CreateIfNotExists);
 
5258
        Result:=GetAccelGroup({%H-}PGtkWidget(Form.Handle),CreateIfNotExists);
5198
5259
        {$IFDEF VerboseAccelerator}
5199
5260
        DebugLn('GetAccelGroupForComponent C ',Component.Name,':',Component.ClassName);
5200
5261
        {$ENDIF}
5728
5789
 
5729
5790
procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem; MenuItemWidget: PGtkWidget);
5730
5791
begin
5731
 
  UpdateInnerMenuItem(LCLMenuItem, MenuItemWidget, LCLMenuItem.ShortCut);
 
5792
  UpdateInnerMenuItem(LCLMenuItem, MenuItemWidget, LCLMenuItem.ShortCut, LCLMenuItem.ShortCutKey2);
5732
5793
end;
5733
5794
 
5734
5795
{------------------------------------------------------------------------------
5735
 
  procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem;
5736
 
    MenuItemWidget: PGtkWidget; NewShortCut: TShortCut);
5737
 
 
5738
5796
  Update the inner widgets of a menuitem widget.
5739
5797
 ------------------------------------------------------------------------------}
5740
 
procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem;
5741
 
  MenuItemWidget: PGtkWidget; NewShortCut: TShortCut);
 
5798
procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem; MenuItemWidget: PGtkWidget;
 
5799
  NewShortCut, ShortCutKey2: TShortCut);
5742
5800
const
5743
5801
  WidgetDirection : array[boolean] of longint = (GTK_TEXT_DIR_LTR, GTK_TEXT_DIR_RTL);
5744
5802
 
5765
5823
  var
5766
5824
    LabelWidget: PGtkLabel;
5767
5825
    NeedShortCut: Boolean;
5768
 
    Key: Word;
5769
 
    Shift: TShiftState;
 
5826
    Key, Key2: Word;
 
5827
    Shift, Shift2: TShiftState;
5770
5828
    s: String;
5771
5829
  begin
5772
 
    //DebugLn(['UpdateShortCutLabel ',dbgsName(LCLMenuItem),' ',ShortCutToText(NewShortCut)]);
5773
5830
    ShortCutToKey(NewShortCut, Key, Shift);
5774
 
 
5775
 
    // check if shortcut is needed
5776
 
    NeedShortCut := Key <> 0;
5777
 
 
5778
 
    if NeedShortCut and
5779
 
       (LCLMenuItem.Parent <> nil) and
5780
 
       LCLMenuItem.Parent.HandleAllocated and
5781
 
       GtkWidgetIsA(PGtkWidget(LCLMenuItem.Parent.Handle), GTK_TYPE_MENU_BAR) then
5782
 
    begin
5783
 
      // no shortcut captions for items in menubar
5784
 
      NeedShortCut := False;
5785
 
    end;
5786
 
 
5787
 
    LabelWidget := PGtkLabel(gtk_object_get_data(PGtkObject(MenuItemWidget),
5788
 
      'LCLShortCutLabel'));
5789
 
                               
 
5831
    ShortCutToKey(ShortCutKey2, Key2, Shift2);
 
5832
 
 
5833
    // Check if shortcut is needed. No shortcut captions for items in menubar
 
5834
    NeedShortCut := (Key <> 0) and
 
5835
       not ( (LCLMenuItem.Parent <> nil) and LCLMenuItem.Parent.HandleAllocated and
 
5836
       GtkWidgetIsA({%H-}PGtkWidget(LCLMenuItem.Parent.Handle), GTK_TYPE_MENU_BAR) );
 
5837
 
 
5838
    LabelWidget := PGtkLabel(gtk_object_get_data(PGtkObject(MenuItemWidget),'LCLShortCutLabel'));
5790
5839
    if NeedShortCut then
5791
5840
    begin
5792
 
      ShortCutToKey(NewShortCut, Key, Shift);
5793
5841
      s := GetAcceleratorString(Key, Shift);
 
5842
      if Key2 <> 0 then
 
5843
        s := s + ', ' + GetAcceleratorString(Key2, Shift2);
5794
5844
      //  ShortCutToText(NewShortCut);
5795
5845
      if LabelWidget = nil then
5796
5846
      begin
5987
6037
  if TStatusBar(Data).Panels[ItemId].Style <> psOwnerDraw then
5988
6038
    exit;
5989
6039
 
5990
 
  FillChar(Msg, SizeOf(Msg), #0);
5991
 
  FillChar(PS, SizeOf(PS), #0);
5992
 
  FillChar(ItemStruct, SizeOf(ItemStruct), #0);
 
6040
  FillChar(Msg{%H-}, SizeOf(Msg), #0);
 
6041
  FillChar(PS{%H-}, SizeOf(PS), #0);
 
6042
  FillChar(ItemStruct{%H-}, SizeOf(ItemStruct), #0);
5993
6043
  New(ItemStruct);
5994
6044
  // we must fill up complete area otherwise gtk2 will do
5995
6045
  // strange paints when item is not fully exposed.
6011
6061
 
6012
6062
  ItemStruct^.itemID := ItemID;
6013
6063
  PS.rcPaint := ItemStruct^.rcItem;
6014
 
  ItemStruct^._hDC := BeginPaint(THandle(PtrUInt(Widget)), PS);
 
6064
  ItemStruct^._hDC := BeginPaint(THandle({%H-}PtrUInt(Widget)), PS);
6015
6065
  Msg.Ctl := TStatusBar(Data).Handle;
6016
6066
  Msg.DrawItemStruct := ItemStruct;
6017
6067
  Msg.Msg := LM_DRAWITEM;
6020
6070
    Result := not CallBackDefaultReturn;
6021
6071
  finally
6022
6072
    PS.hdc := ItemStruct^._hDC;
6023
 
    EndPaint(THandle(PtrUInt(TGtkDeviceContext(PS.hdc).Widget)), PS);
 
6073
    EndPaint(THandle({%H-}PtrUInt(TGtkDeviceContext(PS.hdc).Widget)), PS);
6024
6074
    Dispose(ItemStruct);
6025
6075
  end;
6026
6076
end;
6291
6341
  Widget: PGtkWidget;
6292
6342
  Requisition: TGtkRequisition;
6293
6343
begin
6294
 
  Widget := PGtkWidget(AWinControl.Handle);
 
6344
  Widget := {%H-}PGtkWidget(AWinControl.Handle);
6295
6345
  // set size to default
6296
6346
  //DebugLn(['GetGTKDefaultWidgetSize ',GetWidgetDebugReport(Widget)]);
6297
6347
  gtk_widget_set_size_request(Widget, -1, -1);
6299
6349
  gtk_widget_size_request(Widget,@Requisition);
6300
6350
  PreferredWidth:=Requisition.width;
6301
6351
  PreferredHeight:=Requisition.height;
6302
 
  if WithThemeSpace then begin
6303
 
 
6304
 
  end else begin
6305
 
    //debugLn('GetGTKDefaultWidgetSize ',DbgSName(AWinControl),' ',dbgs(gtk_widget_get_xthickness(Widget)),' ythickness=',dbgs(gtk_widget_get_ythickness(Widget)));
6306
 
    //debugLn(['GetGTKDefaultWidgetSize ',GetWidgetDebugReport(Widget)]);
6307
 
    //dec(PreferredWidth,gtk_widget_get_xthickness(Widget));
6308
 
    //if gtk_class_get_type(gtk_object_get_class(Widget))=GTK_TYPE_BUTTON then
6309
 
    //  dec(PreferredHeight,2*gtk_widget_get_ythickness(Widget));
6310
 
  end;
6311
6352
  {DebugLn(['GetGTKDefaultWidgetSize Allocation=',Widget^.allocation.x,',',Widget^.allocation.y,',',Widget^.allocation.width,',',Widget^.allocation.height,
6312
6353
   ' requisition=',Widget^.requisition.width,',',Widget^.requisition.height,
6313
6354
   ' PreferredWidth=',PreferredWidth,' PreferredHeight=',PreferredHeight,
6314
6355
   ' WithThemeSpace=',WithThemeSpace]);}
6315
 
  // set new size
 
6356
 
 
6357
  // restore size
6316
6358
  gtk_widget_set_size_request(Widget, AWinControl.Width, AWinControl.Height);
6317
6359
  //debugln('GetGTKDefaultSize PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight));
6318
6360
end;
6355
6397
  {$IFDEF VerboseSizeMsg}
6356
6398
  DebugLn('SendSizeNotificationToLCL checking ... ',DbgSName(LCLControl),' Widget=',WidgetFlagsToString(aWidget));
6357
6399
  {$ENDIF}
6358
 
  MainWidget:=PGtkWidget(LCLControl.Handle);
 
6400
  MainWidget:={%H-}PGtkWidget(LCLControl.Handle);
6359
6401
  FixedWidget:=PGtkWidget(GetFixedWidget(MainWidget));
6360
6402
 
6361
6403
  FWidgetsResized.Remove(MainWidget);
6441
6483
      Result := 0;
6442
6484
      Msg := LM_SIZE;
6443
6485
      if LCLControl is TCustomForm then begin
6444
 
        // if the LCL gets an event without a State it resets it to SIZENORMAL
 
6486
        // if the LCL gets an event without a State it resets it to SIZE_RESTORED
6445
6487
        // so we send it the state it already is
6446
6488
        case TCustomForm(LCLControl).WindowState of
6447
 
          wsNormal: SizeType := SIZENORMAL;
6448
 
          wsMinimized: SizeType := SIZEICONIC;
6449
 
          wsMaximized: SizeType := SIZEFULLSCREEN;
 
6489
          wsNormal: SizeType := SIZE_RESTORED;
 
6490
          wsMinimized: SizeType := SIZE_MINIMIZED;
 
6491
          wsMaximized: SizeType := SIZE_MAXIMIZED;
 
6492
          wsFullScreen: SizeType := SIZE_FULLSCREEN;
6450
6493
        end;
6451
6494
      end
6452
6495
      else
6580
6623
  Later: Boolean;
6581
6624
  IsTopLevelWidget: Boolean;
6582
6625
begin
6583
 
  Widget := PGtkWidget(LCLControl.Handle);
 
6626
  Widget := {%H-}PGtkWidget(LCLControl.Handle);
6584
6627
  if not WidgetSizeIsEditable(Widget) then
6585
6628
    Exit;
6586
6629
  Later := true;
6636
6679
  {$IFDEF VerboseSizeMsg}
6637
6680
  DebugLn(['SetWidgetSizeAndPosition ',DbgSName(LCLControl)]);
6638
6681
  {$ENDIF}
6639
 
  Widget:=PGtkWidget(LCLControl.Handle);
 
6682
  Widget:={%H-}PGtkWidget(LCLControl.Handle);
6640
6683
  
6641
6684
  LCLLeft := LCLControl.Left;
6642
6685
  LCLTop := LCLControl.Top;
6646
6689
     ((LCLControl.Parent = nil) and (LCLControl.ParentWindow <> 0)) then
6647
6690
  begin
6648
6691
    if LCLControl.Parent <> nil then
6649
 
      ParentWidget := PGtkWidget(LCLControl.Parent.Handle)
 
6692
      ParentWidget := {%H-}PGtkWidget(LCLControl.Parent.Handle)
6650
6693
    else
6651
 
      ParentWidget := PGtkWidget(LCLControl.ParentWindow);
 
6694
      ParentWidget := {%H-}PGtkWidget(LCLControl.ParentWindow);
6652
6695
    ParentFixed := GetFixedWidget(ParentWidget);
6653
6696
    if GtkWidgetIsA(ParentFixed,GTK_FIXED_GET_TYPE) or
6654
6697
       GtkWidgetIsA(ParentFixed,GTK_LAYOUT_GET_TYPE) then
6793
6836
  
6794
6837
  Returns the Left, Top, relative to the client origin of its parent
6795
6838
-------------------------------------------------------------------------------}
6796
 
procedure GetWidgetRelativePosition(aWidget: PGtkWidget; var Left, Top: integer);
 
6839
procedure GetWidgetRelativePosition(aWidget: PGtkWidget; out Left, Top: integer);
6797
6840
var
6798
6841
  GdkWindow: PGdkWindow;
6799
6842
  LCLControl: TWinControl;
6941
6984
  newColor : TGDKColor;
6942
6985
begin
6943
6986
  if Value<0 then begin
6944
 
    FillChar(Result,SizeOf(Result),0);
 
6987
    FillChar(Result{%H-},SizeOf(Result),0);
6945
6988
    exit;
6946
6989
  end;
6947
6990
 
7262
7305
  {$IFDEF DEBUG_CLIPBOARD}
7263
7306
  DebugLn('[RequestSelectionData] FormatID=',dbgs(FormatID));
7264
7307
  {$ENDIF}
7265
 
  FillChar(Result,SizeOf(TGtkSelectionData),0);
 
7308
  FillChar(Result{%H-},SizeOf(TGtkSelectionData),0);
7266
7309
  if (ClipboardWidget=nil) or (FormatID=0) 
7267
7310
  or (ClipboardTypeAtoms[ClipboardType]=0) then exit;
7268
7311
 
7397
7440
        TGCallback(@Gtk2RangeScrollCB), AWidgetInfo);
7398
7441
      g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.vscrollbar, 'change-value',
7399
7442
        TGCallback(@Gtk2RangeScrollCB), AWidgetInfo);
 
7443
      g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.hscrollbar, 'button-press-event',
 
7444
        TGCallback(@Gtk2RangeScrollPressCB), AWidgetInfo);
 
7445
      g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.hscrollbar, 'button-release-event',
 
7446
        TGCallback(@Gtk2RangeScrollReleaseCB), AWidgetInfo);
 
7447
      g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.vscrollbar, 'button-press-event',
 
7448
        TGCallback(@Gtk2RangeScrollPressCB), AWidgetInfo);
 
7449
      g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.vscrollbar, 'button-release-event',
 
7450
        TGCallback(@Gtk2RangeScrollReleaseCB), AWidgetInfo);
7400
7451
    end;
7401
7452
 
7402
7453
  end;
7444
7495
begin
7445
7496
  if StyleObject <> nil then
7446
7497
  begin
7447
 
    if StyleObject^.Obj <> nil then
7448
 
      gtk_object_destroy(StyleObject^.Obj);
7449
 
    if StyleObject^.Widget <> nil then
 
7498
    if StyleObject^.Owner <> nil then
7450
7499
    begin
7451
 
      // first unref
7452
 
      gtk_widget_unref(StyleObject^.Widget);
7453
 
      // then destroy
7454
 
      gtk_widget_destroy(StyleObject^.Widget);
 
7500
      // GTK owns the reference to top level widgets created by application,
 
7501
      // so they cannot be destroyed by unreferencing.
 
7502
      if GTK_WIDGET_TOPLEVEL(StyleObject^.Owner) then
 
7503
        gtk_widget_destroy(StyleObject^.Owner)
 
7504
      else
 
7505
        g_object_unref(StyleObject^.Owner);
7455
7506
    end;
7456
7507
    if StyleObject^.Style <> nil then
7457
7508
      if StyleObject^.Style^.attach_count > 0 then
7530
7581
    Result := GetStyleWithName(LazGtkStyleNames[aStyle]);
7531
7582
end;
7532
7583
 
7533
 
procedure tooltip_window_style_set(Widget: PGtkWidget; PreviousStyle: PGtkStyle;
 
7584
procedure tooltip_window_style_set(Widget: PGtkWidget; {%H-}PreviousStyle: PGtkStyle;
7534
7585
          StyleObject: PStyleObject); cdecl;
7535
7586
begin
7536
7587
  StyleObject^.Style := gtk_widget_get_style(Widget);
7593
7644
var
7594
7645
  Tp : Pointer;
7595
7646
  l : Longint;
7596
 
  NoName: PGChar;
7597
7647
  lgs: TLazGtkStyle;
7598
7648
  WidgetName: String;
7599
 
  //VBox: PGtkWidget;
7600
7649
  AddToStyleWindow: Boolean;
 
7650
  AddReference: Boolean;
7601
7651
  StyleWindowWidget: PGtkWidget;
7602
7652
  Requisition: TGtkRequisition;
7603
7653
  WindowFixedWidget: PGtkWidget;
7624
7674
    lgs := lgsUserDefined;
7625
7675
    Tp := nil;
7626
7676
    AddToStyleWindow := True;
 
7677
    AddReference := True;
7627
7678
    WidgetName := 'LazStyle' + WName;
7628
7679
    // create a style widget
7629
7680
    If CompareText(WName,LazGtkStyleNames[lgsButton])=0 then begin
7639
7690
      If CompareText(WName,LazGtkStyleNames[lgsDefault])=0 then begin
7640
7691
        lgs:=lgsDefault;
7641
7692
        AddToStyleWindow:=false;
7642
 
        NoName:=nil;
7643
 
        StyleObject^.Widget :=
7644
 
          // GTK2 does not allow to instantiate the abstract base Widget
7645
 
          // so we use the "invisible" widget, which should never be defined
7646
 
          // by the theme
7647
 
          GTK_WIDGET_NEW( GTK_TYPE_INVISIBLE, NoName,[]);
 
7693
        AddReference:=false;
 
7694
        // GTK2 does not allow to instantiate the abstract base Widget
 
7695
        // so we use the "invisible" widget, which should never be defined
 
7696
        // by the theme.
 
7697
        // It is created with a real reference count=1 (not floating)
 
7698
        // because it is a treated as top level widget.
 
7699
        StyleObject^.Widget := gtk_invisible_new;
7648
7700
      end
7649
7701
    else
7650
7702
      If CompareText(WName,LazGtkStyleNames[lgsWindow])=0 then begin
7651
7703
        lgs:=lgsWindow;
7652
7704
        StyleObject^.Widget := GTK_WINDOW_NEW(GTK_WINDOW_TOPLEVEL);
7653
7705
        AddToStyleWindow:=false;
 
7706
        AddReference:=false;
7654
7707
        gtk_widget_hide(StyleObject^.Widget);
7655
7708
        // create the fixed widget
7656
7709
        // (where to put all style widgets, that need a parent for realize)
7675
7728
        StyleObject^.Widget := GTK_RADIO_BUTTON_NEW(nil);
7676
7729
      end
7677
7730
    else
7678
 
      If CompareText(WName,LazGtkStyleNames[lgsMenu])=0 then begin
 
7731
      if CompareText(WName,LazGtkStyleNames[lgsMenu])=0 then
 
7732
      begin
7679
7733
        lgs:=lgsMenu;
7680
7734
        StyleObject^.Widget := gtk_menu_new;
 
7735
        // we need REAL menu size for SM_CYMENU
 
7736
        // menuitem will be destroyed with menu by gtk.
 
7737
        VBox := gtk_menu_item_new_with_label('DUMMYITEM');
 
7738
        gtk_menu_shell_append(PGtkMenuShell(StyleObject^.Widget), VBox);
7681
7739
      end
7682
7740
    else
7683
7741
      If CompareText(WName,LazGtkStyleNames[lgsMenuBar])=0 then begin
7739
7797
        Tp := gtk_tooltips_new;
7740
7798
        gtk_tooltips_force_window(Tp);
7741
7799
        StyleObject^.Widget := PGTKTooltips(Tp)^.Tip_Window;
7742
 
        gtk_widget_ref(StyleObject^.Widget);// MG: why is this needed?
7743
7800
 
7744
7801
        g_signal_connect(StyleObject^.Widget, 'style-set',
7745
 
                         TGCallback(@tooltip_window_style_set), StyleObject);
 
7802
          TGCallback(@tooltip_window_style_set), StyleObject);
7746
7803
 
7747
7804
        WidgetName := 'gtk-tooltip-lcl';
7748
 
        StyleObject^.Obj := Tp;
 
7805
        StyleObject^.Owner := Tp;
7749
7806
        Tp := nil;
7750
7807
      end
7751
7808
    else
7774
7831
      If CompareText(WName,LazGtkStyleNames[lgsTreeView])=0 then begin
7775
7832
        lgs:=lgsTreeView;
7776
7833
        StyleObject^.Widget := gtk_tree_view_new;
7777
 
        gtk_tree_view_append_column(PGtkTreeView(StyleObject^.Widget), gtk_tree_view_column_new);
7778
7834
      end
7779
7835
 
7780
7836
    else
7785
7841
    else
7786
7842
      If CompareText(WName,LazGtkStyleNames[lgsToolButton])=0 then begin
7787
7843
        lgs:=lgsToolButton;
7788
 
        StyleObject^.Widget := gtk_toolbar_append_item(PGtkToolBar(GetStyleWidget(lgsToolBar)), 'B', nil, nil, nil, nil, nil);
 
7844
        StyleObject^.Widget := PGtkWidget(gtk_tool_button_new(nil, 'B'));
 
7845
        gtk_toolbar_insert(PGtkToolbar(GetStyleWidget(lgsToolBar)), PGtkToolItem(StyleObject^.Widget), -1);
7789
7846
      end
7790
7847
    else
7791
7848
      if CompareText(WName,LazGtkStyleNames[lgsScrolledWindow])=0 then begin
7810
7867
      // consistency error
7811
7868
      RaiseGDBException('');
7812
7869
    end;
7813
 
    
 
7870
 
7814
7871
    // ensure style of the widget
7815
7872
    If (StyleObject^.Widget <> nil) then begin
7816
 
      gtk_widget_ref(StyleObject^.Widget);
7817
 
 
7818
 
      // put style widget on style window, so that it can be realized
 
7873
 
 
7874
      if not Assigned(StyleObject^.Owner) then
 
7875
        StyleObject^.Owner := StyleObject^.Widget;
 
7876
 
 
7877
      // Widgets are created with a floating reference, except for top level.
 
7878
      // Here the floating reference is acquired, or reference count increased
 
7879
      // in case the floating reference is already owned (the widget has been
 
7880
      // added to a container).
 
7881
      if AddReference then
 
7882
      begin
 
7883
        if g_object_ref_sink = nil then
 
7884
        begin
 
7885
          // Deprecated since 2.10.
 
7886
          gtk_object_ref(PGtkObject(StyleObject^.Owner));
 
7887
          gtk_object_sink(PGtkObject(StyleObject^.Owner));
 
7888
        end
 
7889
        else
 
7890
          g_object_ref_sink(PGObject(StyleObject^.Owner));
 
7891
      end;
 
7892
 
 
7893
      // Put style widget on style window, so that it can be realized.
7819
7894
      if AddToStyleWindow then
7820
7895
      begin
7821
7896
        gtk_widget_show_all(StyleObject^.Widget);
7822
7897
        if GtkWidgetIsA(StyleObject^.Widget,GTK_TYPE_MENU) then
7823
7898
        begin
7824
 
          // attach menu to window
7825
 
          gtk_menu_attach_to_widget(PGtkMenu(StyleObject^.Widget),
7826
 
            GetStyleWidget(lgsWindow), nil);
 
7899
          // Do nothing. Don't need to attach it to a widget to get the style.
7827
7900
        end
7828
7901
        else
7829
7902
        if GtkWidgetIsA(StyleObject^.Widget,GTK_TYPE_MENU_BAR) then
7840
7913
          gtk_menu_bar_append( GetStyleWidget(lgsMenuBar), StyleObject^.Widget);
7841
7914
        end
7842
7915
        else
7843
 
 
7844
 
        if GtkWidgetIsA(StyleObject^.Widget, GTK_TYPE_TOOL_BUTTON) then
7845
 
        begin
7846
 
          //gtk_toolbar_insert();
7847
 
          gtk_toolbar_append_widget(GTK_TOOLBAR(GetStyleWidget(lgsToolBar)),
7848
 
            StyleObject^.Widget, nil, nil);
7849
 
        end
7850
 
        else
7851
 
 
7852
7916
        if (lgs = lgsToolButton) or
7853
7917
           (lgs = lgsTooltip) then
7854
7918
        begin
7868
7932
 
7869
7933
      gtk_widget_set_name(StyleObject^.Widget,PChar(WidgetName));
7870
7934
      gtk_widget_ensure_style(StyleObject^.Widget);
7871
 
      
 
7935
 
7872
7936
      // request default sizing
7873
 
      FillChar(Requisition,SizeOf(Requisition),0);
 
7937
      FillChar(Requisition{%H-},SizeOf(Requisition),0);
7874
7938
      gtk_widget_size_request(StyleObject^.Widget, @Requisition);
7875
7939
      
7876
7940
      StyleObject^.Style:=gtk_widget_get_style(StyleObject^.Widget);
7885
7949
        if not GtkWidgetIsA(StyleObject^.Widget,GTK_WINDOW_GET_TYPE) then begin
7886
7950
          //DebugLn(['GetStyleWithName realizing ...']);
7887
7951
          gtk_widget_realize(StyleObject^.Widget);
 
7952
          //treeview columns must be added after realize otherwise they will have invalid styles
 
7953
          if lgs = lgsTreeView then
 
7954
          begin
 
7955
            gtk_tree_view_append_column(PGtkTreeView(StyleObject^.Widget), gtk_tree_view_column_new);
 
7956
            gtk_tree_view_append_column(PGtkTreeView(StyleObject^.Widget), gtk_tree_view_column_new);
 
7957
            gtk_tree_view_append_column(PGtkTreeView(StyleObject^.Widget), gtk_tree_view_column_new);
 
7958
          end;
7888
7959
          //DebugLn('AddToStyleWindow realized: ',WName,' ',GetWidgetDebugReport(StyleObject^.Widget));
7889
7960
        end;
7890
7961
        ResizeWidget(StyleObject^.Widget,200,200);
8061
8132
  Style: PGTKStyle;
8062
8133
  GC: PGDKGC;
8063
8134
  Pixmap: PGDKPixmap;
8064
 
  SysColor: TColorRef;
8065
 
  BaseColor: TColorRef;
 
8135
  BaseColor: TColor;
8066
8136
  Red, Green, Blue: byte;
8067
8137
begin
8068
8138
  // Set defaults in case something goes wrong
8069
 
  FillChar(Result, SizeOf(Result), 0);
 
8139
  FillChar(Result{%H-}, SizeOf(Result), 0);
8070
8140
  Style := nil;
8071
8141
  GC := nil;
8072
8142
  Pixmap := nil;
8073
8143
 
8074
 
  SysColor := ColorToRGB(Color);
8075
8144
  Result.Fill := GDK_Solid;
8076
 
  RedGreenBlue(TColor(SysColor), Red, Green, Blue);
 
8145
  RedGreenBlue(ColorToRGB(TColor(Color)), Red, Green, Blue);
8077
8146
  Result.foreground.Red:=gushort(Red) shl 8 + Red;
8078
8147
  Result.foreground.Green:=gushort(Green) shl 8 + Green;
8079
8148
  Result.foreground.Blue:=gushort(Blue) shl 8 + Blue;
8081
8150
  {$IfDef Disable_GC_SysColors}
8082
8151
  exit;
8083
8152
  {$EndIf}
8084
 
  BaseColor := Color and $FF;
 
8153
  BaseColor := TColor(Color and $FF);
8085
8154
  case BaseColor of
8086
8155
    {These are WM/X defined, but might be possible to get
8087
8156
 
8539
8608
end;
8540
8609
 
8541
8610
procedure StyleFillRectangle(drawable : PGDKDrawable; GC : PGDKGC;
8542
 
  Color : TColorRef; x, y, width, height : gint);
 
8611
  Color : TColorRef; x, y, width, height : gint;
 
8612
  AClipArea: PGdkRectangle);
8543
8613
var
8544
8614
  style: PGTKStyle;
8545
8615
  widget: PGTKWidget;
8597
8667
  end;
8598
8668
 
8599
8669
  if Assigned(Style) then
8600
 
    gtk_paint_flat_box(style, drawable, state, shadow, nil, widget,
 
8670
    gtk_paint_flat_box(style, drawable, state, shadow, AClipArea, widget,
8601
8671
                       detail, x, y, width, height)
8602
8672
  else
8603
8673
    gdk_draw_rectangle(drawable, GC, 1, x, y, width, height);
8623
8693
 
8624
8694
  if not AWinControl.HandleAllocated then exit;
8625
8695
 
8626
 
  MainWidget:=PGtkWidget(AWinControl.Handle);
 
8696
  MainWidget:={%H-}PGtkWidget(AWinControl.Handle);
8627
8697
  FixWidget:=GetFixedWidget(MainWidget);
8628
8698
  if (FixWidget <> nil) and (FixWidget <> MainWidget) then
8629
8699
    Widget := FixWidget
9090
9160
var
9091
9161
  Color: TGDKColor;
9092
9162
begin
9093
 
  FillChar(Result, SizeOf(TGDIRGB),0);
 
9163
  FillChar(Result{%H-}, SizeOf(TGDIRGB),0);
9094
9164
 
9095
9165
  If (Visual = nil) or (Colormap = nil) then begin
9096
9166
    Visual := GDK_Visual_Get_System;
9176
9246
    bsDialog : Result := GDK_FUNC_CLOSE or GDK_FUNC_MINIMIZE
9177
9247
                or GDK_FUNC_MOVE;
9178
9248
 
9179
 
    bsToolWindow : Result := GDK_FUNC_MOVE or GDK_FUNC_CLOSE;
 
9249
    bsToolWindow : Result := GDK_FUNC_MOVE or GDK_FUNC_CLOSE or
 
9250
      GDK_FUNC_MINIMIZE;
9180
9251
 
9181
 
    bsSizeToolWin : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or GDK_FUNC_CLOSE;
 
9252
    bsSizeToolWin : Result := GDK_FUNC_RESIZE or GDK_FUNC_MOVE or
 
9253
      GDK_FUNC_CLOSE or GDK_FUNC_MINIMIZE or GDK_FUNC_MAXIMIZE;
9182
9254
  end;
9183
9255
 
9184
9256
  // X warns if marking a fixed size window resizeable:
9198
9270
  //DebugLn('GetWindowFunction ',DbgSName(AForm),' ',dbgs(ord(ABorderStyle)),' ',binStr(Result,8));
9199
9271
end;
9200
9272
 
 
9273
{$IFDEF GTK2OLDENUMFONTFAMILIES}
9201
9274
procedure FillScreenFonts(ScreenFonts : TStrings);
9202
9275
var
9203
9276
  Widget : PGTKWidget;
9228
9301
  if (families <> nil) then
9229
9302
    g_free(families);
9230
9303
end;
 
9304
{$ENDIF}
9231
9305
 
9232
9306
function GetTextHeight(DCTextMetric: TDevContextTextMetric): integer;
9233
9307
// IMPORTANT: Before this call:  UpdateDCTextMetric(TGtkDeviceContext(DC));
9240
9314
end;
9241
9315
 
9242
9316
{$IFDEF HasX}
9243
 
function  XGetWorkarea(var ax,ay,awidth,aheight:gint): gint;
 
9317
function  XGetWorkarea(out ax,ay,awidth,aheight:gint): gint;
9244
9318
 
9245
9319
var
9246
9320
  XDisplay: PDisplay;
9267
9341
    ay:=current_desktop[1];
9268
9342
    awidth:=current_desktop[2];
9269
9343
    aheight:=current_desktop[3];
 
9344
  end else begin
 
9345
    ax:=0;
 
9346
    ay:=0;
 
9347
    awidth:=0;
 
9348
    aheight:=0;
9270
9349
  end;
9271
9350
  if current_desktop <> nil then
9272
9351
    XFree (current_desktop);