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

« back to all changes in this revision

Viewing changes to lcl/interfaces/gtk/gtkproc.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
[ 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:
82
82
  {$EndIF}
83
83
end;
84
84
 
85
 
procedure gdk_event_key_set_string(Event: PGDKEventKey; const NewString: PChar
86
 
  );
 
85
procedure gdk_event_key_set_string(Event: PGDKEventKey; const NewString: PChar);
87
86
var
88
87
  OldString: PChar;
89
88
begin
1536
1535
 
1537
1536
  Allocated a GDKColor from a winapi color
1538
1537
 ------------------------------------------------------------------------------}
1539
 
function AllocGDKColor(const AColor: LongInt): TGDKColor;
 
1538
function AllocGDKColor(const AColor: TColorRef): TGDKColor;
1540
1539
begin
1541
1540
  with Result do
1542
1541
  begin
1634
1633
 
1635
1634
Procedure AllocGDIColor(DC: hDC; GDIColor: PGDIColor);
1636
1635
var
1637
 
  RGBColor : Longint;
 
1636
  RGBColor : TColorRef;
1638
1637
begin
1639
1638
  if DC=0 then ;
1640
1639
  if not (cfColorAllocated in GDIColor^.ColorFlags) then begin
2248
2247
      Msg.KeyData := CommonKeyData or (Flags shl 16) or $0001 {TODO:  repeatcount};
2249
2248
 
2250
2249
      // send the (Sys)KeyDown message directly to the LCL
2251
 
      NotifyApplicationUserInput(Msg.Msg);
 
2250
      NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
2252
2251
      DeliverKeyMessage(TargetObj, Msg);
2253
2252
    end;
2254
2253
    {$ENDIF}
2401
2400
      if not KeyAlreadyHandledByGtk
2402
2401
      then begin
2403
2402
        // send the (Sys)KeyDown message directly to the LCL
2404
 
        NotifyApplicationUserInput(Msg.Msg);
 
2403
        NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
2405
2404
        if DeliverKeyMessage(TargetObj, Msg)
2406
2405
        and (Msg.CharCode <> Vkey) then
2407
2406
          StopKeyEvent;
2424
2423
 
2425
2424
      // send the message directly to the LCL
2426
2425
      Msg.Result:=0;
2427
 
      NotifyApplicationUserInput(Msg.Msg);
 
2426
      NotifyApplicationUserInput(TControl(TargetObj), Msg.Msg);
2428
2427
 
2429
2428
      if DeliverKeyMessage(TargetObj, Msg)
2430
2429
      and (Msg.CharCode <> VKey)
3155
3154
  end;
3156
3155
  
3157
3156
  procedure UpdateModifierMap(const AModMap: TModMap; AKeyCode: Byte; AKeySym: Cardinal);
 
3157
  var
3158
3158
  {$ifdef VerboseModifiermap}
3159
 
  const
3160
 
    STATE_NAME: array[TShiftStateEnum] of String = ('ssShift', 'ssAlt', 'ssCtrl',
3161
 
      'ssLeft', 'ssRight', 'ssMiddle', 'ssDouble',
3162
 
      'ssMeta', 'ssSuper', 'ssHyper', 'ssAltGr', 'ssCaps', 'ssNum',
3163
 
      'ssScroll', 'ssTriple', 'ssQuad', 'ssExtra1', 'ssExtra2');
 
3159
    s: string;
3164
3160
  {$endif}
3165
 
  var
3166
3161
    ShiftState: TShiftStateEnum;
3167
3162
  begin
3168
3163
    if AModMap[AKeyCode] = 0 then Exit;
3197
3192
    MModifiers[ShiftState].UseValue := False;
3198
3193
    
3199
3194
    {$ifdef VerboseModifiermap}
3200
 
    DebugLn('Mapped keycode=%u, keysym=$%x, modifier=$%2.2x to shiftstate %s', [AKeyCode, AKeySym, AModMap[AKeyCode], STATE_NAME[ShiftState]]);
 
3195
    WriteStr(s, ShiftState);
 
3196
    DebugLn('Mapped keycode=%u, keysym=$%x, modifier=$%2.2x to shiftstate %s',
 
3197
            [AKeyCode, AKeySym, AModMap[AKeyCode], s]);
3201
3198
    {$endif}
3202
3199
 
3203
3200
  end;
3277
3274
  FillChar(XKeyEvent, SizeOf(XKeyEvent), 0);
3278
3275
  XKeyEvent._Type := GDK_KEY_PRESS;
3279
3276
  XKeyEvent.Display := XDisplay;
3280
 
{$ifdef ver2_2}
3281
 
  XKeyEvent.Same_Screen := True;
3282
 
{$else}
3283
3277
  XKeyEvent.Same_Screen := 1;
3284
 
{$endif}
3285
3278
 
3286
3279
  // Retrieve the KeyCode bounds
3287
3280
  XDisplayKeyCodes(XDisplay, @LoKey, @HiKey);
3813
3806
    handle := TCommonDialog(AnObject).Handle;
3814
3807
  end
3815
3808
  else begin
3816
 
    Assert(False, Format('Trace:  [ObjectToGtkObject] Message received with unhandled class-type <%s>', [AnObject.ClassName]));
 
3809
    //DebugLn(Format('Trace:  [ObjectToGtkObject] Message received with unhandled class-type <%s>', [AnObject.ClassName]));
3817
3810
  end;
3818
3811
  Result := PGTKObject(handle);
3819
3812
  if handle = 0 then
4306
4299
  ClientWidget: PGtkWidget;
4307
4300
  NoteBookWidget: PGtkNotebook;
4308
4301
begin
4309
 
  if not TCustomNotebook(ANoteBook).HandleAllocated then exit;
4310
 
  NoteBookWidget := PGtkNotebook(TCustomNotebook(ANoteBook).Handle);
 
4302
  if not TCustomTabControl(ANoteBook).HandleAllocated then exit;
 
4303
  NoteBookWidget := PGtkNotebook(TCustomTabControl(ANoteBook).Handle);
4311
4304
  ClientWidget := nil;
4312
4305
  SetFixedWidget(NoteBookWidget, ClientWidget);
4313
4306
end;
4359
4352
  Params:
4360
4353
  Result: none
4361
4354
 
4362
 
  Loads the image for the close button in the tabs of the TCustomNoteBook(s).
 
4355
  Loads the image for the close button in the tabs of the TCustomTabControl(s).
4363
4356
-------------------------------------------------------------------------------}
4364
4357
{$IfDef GTK1}
4365
4358
procedure GetNoteBookCloseBtnImage(Window: PGdkWindow;
4377
4370
 
4378
4371
{-------------------------------------------------------------------------------
4379
4372
  method UpdateNotebookPageTab
4380
 
  Params: ANoteBook: TCustomNotebook; APage: TCustomPage
 
4373
  Params: ANoteBook: TCustomTabControl; APage: TCustomPage
4381
4374
  Result: none
4382
4375
 
4383
4376
  Updates the tab of a page of a notebook. This contains the image to the left
4385
4378
-------------------------------------------------------------------------------}
4386
4379
procedure UpdateNotebookPageTab(ANoteBook, APage: TObject);
4387
4380
var
4388
 
  TheNoteBook: TCustomNotebook;
 
4381
  TheNoteBook: TCustomTabControl;
4389
4382
  ThePage: TCustomPage;
4390
4383
 
4391
4384
  NoteBookWidget: PGtkWidget;  // the notebook
4563
4556
 
4564
4557
begin
4565
4558
  ThePage := TCustomPage(APage);
4566
 
  TheNoteBook := TCustomNotebook(ANoteBook);
 
4559
  TheNoteBook := TCustomTabControl(ANoteBook);
4567
4560
  if (APage=nil) or (not ThePage.HandleAllocated) then exit;
4568
4561
  if TheNoteBook=nil then begin
4569
 
    TheNoteBook:=TCustomNotebook(ThePage.Parent);
 
4562
    TheNoteBook:=TCustomTabControl(ThePage.Parent);
4570
4563
    if TheNoteBook=nil then exit;
4571
4564
  end;
4572
4565
  NoteBookWidget:=PGtkWidget(TWinControl(TheNoteBook).Handle);
6048
6041
 
6049
6042
procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem; MenuItemWidget: PGtkWidget);
6050
6043
begin
6051
 
  UpdateInnerMenuItem(LCLMenuItem, MenuItemWidget, LCLMenuItem.ShortCut);
 
6044
  UpdateInnerMenuItem(LCLMenuItem, MenuItemWidget, LCLMenuItem.ShortCut, LCLMenuItem.ShortCutKey2);
6052
6045
end;
6053
6046
 
6054
6047
{------------------------------------------------------------------------------
6055
 
  procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem;
6056
 
    MenuItemWidget: PGtkWidget; NewShortCut: TShortCut);
6057
 
 
6058
6048
  Update the inner widgets of a menuitem widget.
6059
6049
 ------------------------------------------------------------------------------}
6060
 
procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem;
6061
 
  MenuItemWidget: PGtkWidget; NewShortCut: TShortCut);
 
6050
procedure UpdateInnerMenuItem(LCLMenuItem: TMenuItem; MenuItemWidget: PGtkWidget;
 
6051
  NewShortCut, ShortCutKey2: TShortCut);
6062
6052
{$ifdef GTK2}
6063
6053
const
6064
6054
  WidgetDirection : array[boolean] of longint = (GTK_TEXT_DIR_LTR, GTK_TEXT_DIR_RTL);
6088
6078
  var
6089
6079
    LabelWidget: PGtkLabel;
6090
6080
    NeedShortCut: Boolean;
6091
 
    Key: Word;
6092
 
    Shift: TShiftState;
 
6081
    Key, Key2: Word;
 
6082
    Shift, Shift2: TShiftState;
6093
6083
    s: String;
6094
6084
  begin
6095
6085
    //DebugLn(['UpdateShortCutLabel ',dbgsName(LCLMenuItem),' ',ShortCutToText(NewShortCut)]);
6096
6086
    ShortCutToKey(NewShortCut, Key, Shift);
6097
 
 
6098
 
    // check if shortcut is needed
6099
 
    NeedShortCut := Key <> 0;
6100
 
 
6101
 
    if NeedShortCut and
6102
 
       (LCLMenuItem.Parent <> nil) and
6103
 
       LCLMenuItem.Parent.HandleAllocated and
6104
 
       GtkWidgetIsA(PGtkWidget(LCLMenuItem.Parent.Handle), GTK_TYPE_MENU_BAR) then
6105
 
    begin
6106
 
      // no shortcut captions for items in menubar
6107
 
      NeedShortCut := False;
6108
 
    end;
6109
 
 
6110
 
    LabelWidget := PGtkLabel(gtk_object_get_data(PGtkObject(MenuItemWidget),
6111
 
      'LCLShortCutLabel'));
6112
 
                               
 
6087
    ShortCutToKey(ShortCutKey2, Key2, Shift2);
 
6088
 
 
6089
    // Check if shortcut is needed. No shortcut captions for items in menubar
 
6090
    NeedShortCut := (Key <> 0) and
 
6091
       not ( (LCLMenuItem.Parent <> nil) and LCLMenuItem.Parent.HandleAllocated and
 
6092
       GtkWidgetIsA(PGtkWidget(LCLMenuItem.Parent.Handle), GTK_TYPE_MENU_BAR) );
 
6093
 
 
6094
    LabelWidget := PGtkLabel(gtk_object_get_data(PGtkObject(MenuItemWidget),'LCLShortCutLabel'));
6113
6095
    if NeedShortCut then
6114
6096
    begin
6115
 
      ShortCutToKey(NewShortCut, Key, Shift);
6116
6097
      s := GetAcceleratorString(Key, Shift);
 
6098
      if Key2 <> 0 then
 
6099
        s := s + ', ' + GetAcceleratorString(Key2, Shift2);
6117
6100
      //  ShortCutToText(NewShortCut);
6118
6101
      if LabelWidget = nil then
6119
6102
      begin