← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/interfaces/qt/qtwsextctrls.pp

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
lcl/interfaces/qt/qtwsextctrls.pp
1
 
{ $Id: qtwsextctrls.pp 27789 2010-10-21 11:10:57Z zeljko $}
 
1
{ $Id: qtwsextctrls.pp 33661 2011-11-21 07:03:31Z zeljko $}
2
2
{
3
3
 *****************************************************************************
4
4
 *                              QtWSExtCtrls.pp                              * 
33
33
  qt4,
34
34
  qtwidgets, qtobjects, qtproc, QtWSControls,
35
35
  // LCL
36
 
  LMessages, LCLMessageGlue, LCLProc,
37
 
  SysUtils, Classes, Controls, Graphics, Forms, StdCtrls, ExtCtrls, LCLType,
 
36
  LCLProc,
 
37
  SysUtils, Classes, Controls, Graphics, Forms, ExtCtrls, LCLType,
38
38
  ImgList,
39
39
  // Widgetset
40
40
  WSExtCtrls, WSProc, WSLCLClasses;
41
41
 
42
42
type
43
 
 
44
 
  { TQtWSCustomPage }
45
 
 
46
 
  TQtWSCustomPage = class(TWSCustomPage)
47
 
  published
48
 
    class function CreateHandle(const AWinControl: TWinControl;
49
 
          const AParams: TCreateParams): TLCLIntfHandle; override;
50
 
    class procedure UpdateProperties(const ACustomPage: TCustomPage); override;
51
 
  end;
52
 
 
53
 
  { TQtWSCustomNotebook }
54
 
 
55
 
  TQtWSCustomNotebook = class(TWSCustomNotebook)
56
 
  published
57
 
    class function  CreateHandle(const AWinControl: TWinControl;
58
 
          const AParams: TCreateParams): TLCLIntfHandle; override;
59
 
 
60
 
    class procedure AddPage(const ANotebook: TCustomNotebook;
61
 
      const AChild: TCustomPage; const AIndex: integer); override;
62
 
    class procedure MovePage(const ANotebook: TCustomNotebook;
63
 
      const AChild: TCustomPage; const NewIndex: integer); override;
64
 
    class procedure RemovePage(const ANotebook: TCustomNotebook;
65
 
      const AIndex: integer); override;
66
 
 
67
 
    class function GetCapabilities: TNoteBookCapabilities; override;
68
 
    class function GetDesignInteractive(const AWinControl: TWinControl; AClientPos: TPoint): Boolean; override;
69
 
    class function GetTabIndexAtPos(const ANotebook: TCustomNotebook; const AClientPos: TPoint): integer; override;
70
 
    class function GetTabRect(const ANotebook: TCustomNotebook; const AIndex: Integer): TRect; override;
71
 
    class procedure SetPageIndex(const ANotebook: TCustomNotebook; const AIndex: integer); override;
72
 
    class procedure SetTabCaption(const ANotebook: TCustomNotebook; const AChild: TCustomPage; const AText: string); override;
73
 
    class procedure SetTabPosition(const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition); override;
74
 
    class procedure ShowTabs(const ANotebook: TCustomNotebook; AShowTabs: boolean); override;
75
 
    class procedure UpdateProperties(const ANotebook: TCustomNotebook); override;
76
 
  end;
77
 
 
78
43
  { TQtWSPage }
79
44
 
80
45
  TQtWSPage = class(TWSPage)
196
161
 
197
162
implementation
198
163
 
199
 
const
200
 
  QTabWidgetTabPositionMap: array[TTabPosition] of QTabWidgetTabPosition =
201
 
  (
202
 
{ tpTop    } QTabWidgetNorth,
203
 
{ tpBottom } QTabWidgetSouth,
204
 
{ tpLeft   } QTabWidgetWest,
205
 
{ tpRight  } QTabWidgetEast
206
 
  );
207
 
 
208
164
{ TQtWSCustomPanel }
209
165
 
210
166
{------------------------------------------------------------------------------
229
185
  Result := TLCLIntfHandle(QtFrame);
230
186
end;
231
187
 
232
 
{ TQtWSCustomPage }
233
 
 
234
 
{------------------------------------------------------------------------------
235
 
  Method: TQtWSCustomPage.CreateHandle
236
 
  Params:  None
237
 
  Returns: Nothing
238
 
 
239
 
  Allocates memory and resources for the control and shows it
240
 
 ------------------------------------------------------------------------------}
241
 
class function TQtWSCustomPage.CreateHandle(const AWinControl: TWinControl;
242
 
  const AParams: TCreateParams): TLCLIntfHandle;
243
 
var
244
 
  QtPage: TQtPage;
245
 
begin
246
 
  {$ifdef VerboseQt}
247
 
    WriteLn('Trace:> [TQtWSCustomPage.CreateHandle]');
248
 
  {$endif}
249
 
 
250
 
  QtPage := TQtPage.Create(AWinControl, AParams);
251
 
  QtPage.AttachEvents;
252
 
 
253
 
  // Returns the Handle
254
 
  Result := TLCLIntfHandle(QtPage);
255
 
 
256
 
  {$ifdef VerboseQt}
257
 
    WriteLn('Trace:< [TQtWSCustomPage.CreateHandle] Result: ', IntToStr(Result));
258
 
  {$endif}
259
 
end;
260
 
 
261
 
class procedure TQtWSCustomPage.UpdateProperties(const ACustomPage: TCustomPage);
262
 
var
263
 
  ImageList: TCustomImageList;
264
 
  ImageIndex: Integer;
265
 
  Bmp: TBitmap;
266
 
begin
267
 
  ImageList := TCustomNoteBook(ACustomPage.Parent).Images;
268
 
 
269
 
  if Assigned(ImageList) then
270
 
  begin
271
 
    ImageIndex := TCustomNoteBook(ACustomPage.Parent).GetImageIndex(ACustomPage.PageIndex);
272
 
    if (ImageIndex >= 0) and (ImageIndex < ImageList.Count) then
273
 
    begin
274
 
      Bmp := TBitmap.Create;
275
 
      try
276
 
        ImageList.GetBitmap(ACustomPage.ImageIndex, Bmp);
277
 
        TQtPage(ACustomPage.Handle).setIcon(TQtImage(Bmp.Handle).AsIcon);
278
 
      finally
279
 
        Bmp.Free;
280
 
      end;
281
 
    end;
282
 
  end;
283
 
end;
284
 
 
285
 
{ TQtWSCustomNotebook }
286
 
 
287
 
{------------------------------------------------------------------------------
288
 
  Method: TQtWSCustomNotebook.CreateHandle
289
 
  Params:  None
290
 
  Returns: Nothing
291
 
 
292
 
  Allocates memory and resources for the control and shows it
293
 
 ------------------------------------------------------------------------------}
294
 
class function TQtWSCustomNotebook.CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
295
 
var
296
 
  QtTabWidget: TQtTabWidget;
297
 
begin
298
 
  {$ifdef VerboseQt}
299
 
    WriteLn('TQtWSCustomNotebook.CreateHandle');
300
 
  {$endif}
301
 
  QtTabWidget := TQtTabWidget.Create(AWinControl, AParams);
302
 
  QtTabWidget.setTabPosition(QTabWidgetTabPositionMap[TCustomNoteBook(AWinControl).TabPosition]);
303
 
  QtTabWidget.setTabsClosable(nboShowCloseButtons in TCustomNotebook(AWinControl).Options);
304
 
  QtTabWidget.AttachEvents;
305
 
 
306
 
  // Returns the Handle
307
 
 
308
 
  Result := TLCLIntfHandle(QtTabWidget);
309
 
end;
310
 
 
311
 
class procedure TQtWSCustomNotebook.AddPage(const ANotebook: TCustomNotebook;
312
 
  const AChild: TCustomPage; const AIndex: integer);
313
 
var
314
 
  QtTabWidget: TQtTabWidget;
315
 
begin
316
 
  {$ifdef VerboseQt}
317
 
    WriteLn('TQtWSCustomNotebook.AddPage');
318
 
  {$endif}
319
 
  QtTabWidget := TQtTabWidget(ANotebook.Handle);
320
 
  QtTabWidget.setUpdatesEnabled(False);
321
 
  QtTabWidget.insertTab(AIndex, TQtPage(AChild.Handle).Widget,
322
 
    GetUtf8String(AChild.Caption));
323
 
  QtTabWidget.setUpdatesEnabled(True);
324
 
  TQtPage(AChild.Handle).ChildOfComplexWidget := ccwTabWidget;
325
 
  TQtWsCustomPage.UpdateProperties(AChild);
326
 
end;
327
 
 
328
 
class procedure TQtWSCustomNotebook.MovePage(const ANotebook: TCustomNotebook;
329
 
  const AChild: TCustomPage; const NewIndex: integer);
330
 
var
331
 
  TabWidget: TQtTabWidget;
332
 
  Index: Integer;
333
 
  Page: TQtPage;
334
 
begin
335
 
  Page := TQtPage(AChild.Handle);
336
 
  TabWidget := TQtTabWidget(ANotebook.Handle);
337
 
  Index := AChild.PageIndex;
338
 
  if Index < 0 then
339
 
    Index := ANoteBook.IndexOf(AChild);
340
 
 
341
 
  TabWidget.BeginUpdate;
342
 
  TabWidget.setUpdatesEnabled(false);
343
 
  TabWidget.removeTab(Index);
344
 
  TabWidget.insertTab(NewIndex, Page.Widget, Page.getIcon, Page.getText);
345
 
  TabWidget.setUpdatesEnabled(true);
346
 
  if TabWidget.getCurrentIndex <> NewIndex then
347
 
    TabWidget.setCurrentWidget(Page);
348
 
  TabWidget.EndUpdate;
349
 
end;
350
 
 
351
 
class procedure TQtWSCustomNotebook.RemovePage(const ANotebook: TCustomNotebook;
352
 
  const AIndex: integer);
353
 
var
354
 
  TabWidget: TQtTabWidget;
355
 
begin
356
 
  {$ifdef VerboseQt}
357
 
    WriteLn('TQtWSCustomNotebook.RemovePage');
358
 
  {$endif}
359
 
  TabWidget := TQtTabWidget(ANotebook.Handle);
360
 
  TabWidget.setUpdatesEnabled(false);
361
 
  TabWidget.removeTab(AIndex);
362
 
  TabWidget.setUpdatesEnabled(true);
363
 
end;
364
 
 
365
 
class function TQtWSCustomNotebook.GetCapabilities: TNoteBookCapabilities;
366
 
begin
367
 
  Result := [nbcShowCloseButtons];
368
 
end;
369
 
 
370
 
class function TQtWSCustomNotebook.GetDesignInteractive(
371
 
  const AWinControl: TWinControl; AClientPos: TPoint): Boolean;
372
 
var
373
 
  TabWidget: TQtTabWidget;
374
 
  TabBar: TQtTabBar;
375
 
  TabIndex: Integer;
376
 
  p: TQtPoint;
377
 
begin
378
 
  Result := False;
379
 
  if not WSCheckHandleAllocated(AWinControl, 'GetDesignInteractive') then
380
 
    Exit;
381
 
  TabWidget := TQtTabWidget(AWinControl.Handle);
382
 
  TabBar := TabWidget.TabBar;
383
 
  p := QtPoint(AClientPos.x, AClientPos.y);
384
 
  TabIndex := QTabBar_tabAt(QTabBarH(TabBar.Widget), @p);
385
 
  Result := (TabIndex >= 0) and (TabWidget.getCurrentIndex <> TabIndex);
386
 
end;
387
 
 
388
 
class function TQtWSCustomNotebook.GetTabIndexAtPos(
389
 
  const ANotebook: TCustomNotebook; const AClientPos: TPoint): integer;
390
 
var
391
 
  TabWidget: TQtTabWidget;
392
 
  NewPos: TPoint;
393
 
  R: TRect;
394
 
begin
395
 
  TabWidget := TQtTabWidget(ANotebook.Handle);
396
 
  NewPos := AClientPos;
397
 
  R := TabWidget.TabBar.getGeometry;
398
 
  case ANoteBook.TabPosition of
399
 
    tpTop: if NewPos.Y < 0 then NewPos.Y := R.Bottom + NewPos.Y;
400
 
    tpLeft: if NewPos.X < 0 then NewPos.X := R.Left + NewPos.X;
401
 
    tpRight: NewPos.X := R.Right - NewPos.X;
402
 
    tpBottom: NewPos.Y := R.Bottom - NewPos.Y;
403
 
  end;
404
 
  Result := TabWidget.tabAt(NewPos);
405
 
end;
406
 
 
407
 
class function TQtWSCustomNotebook.GetTabRect(const ANotebook: TCustomNotebook;
408
 
  const AIndex: Integer): TRect;
409
 
var
410
 
  TabWidget: TQtTabWidget;
411
 
begin
412
 
  Result := Rect(-1, -1, -1, -1);
413
 
  if not WSCheckHandleAllocated(ANotebook, 'GetTabRect') then
414
 
    Exit;
415
 
  TabWidget := TQtTabWidget(ANotebook.Handle);
416
 
  Result := TabWidget.TabBar.GetTabRect(AIndex);
417
 
  case ANoteBook.TabPosition of
418
 
    tpTop: OffsetRect(Result, 0, -Result.Bottom);
419
 
    tpLeft: OffsetRect(Result, -Result.Right, 0);
420
 
    tpRight: OffsetRect(Result, Result.Left, 0);
421
 
    tpBottom: OffsetRect(Result, Result.Top, 0);
422
 
  end;
423
 
end;
424
 
 
425
 
class procedure TQtWSCustomNotebook.SetPageIndex(
426
 
  const ANotebook: TCustomNotebook; const AIndex: integer);
427
 
var
428
 
  TabWidget: TQtTabWidget;
429
 
begin
430
 
  if not WSCheckHandleAllocated(ANotebook, 'SetPageIndex') then
431
 
    Exit;
432
 
  TabWidget := TQtTabWidget(ANotebook.Handle);
433
 
  TabWidget.setCurrentIndex(AIndex);
434
 
end;
435
 
 
436
 
class procedure TQtWSCustomNotebook.SetTabCaption(
437
 
  const ANotebook: TCustomNotebook; const AChild: TCustomPage;
438
 
  const AText: string);
439
 
var
440
 
  Index: Integer;
441
 
begin
442
 
  Index := AChild.PageIndex;
443
 
  if Index < 0 then
444
 
    Index := ANotebook.IndexOf(AChild);
445
 
  TQtTabWidget(ANotebook.Handle).setTabText(Index, GetUtf8String(AText));
446
 
end;
447
 
 
448
 
class procedure TQtWSCustomNotebook.SetTabPosition(
449
 
  const ANotebook: TCustomNotebook; const ATabPosition: TTabPosition);
450
 
begin
451
 
  TQtTabWidget(ANotebook.Handle).SetTabPosition(QTabWidgetTabPositionMap[ATabPosition]);
452
 
end;
453
 
 
454
 
class procedure TQtWSCustomNotebook.ShowTabs(const ANotebook: TCustomNotebook;
455
 
  AShowTabs: boolean);
456
 
var
457
 
  TabWidget: TQtTabWidget;
458
 
begin
459
 
  TabWidget := TQtTabWidget(ANotebook.Handle);
460
 
  if TabWidget.TabBar <> nil then
461
 
    TabWidget.ShowTabs := AShowTabs;
462
 
end;
463
 
 
464
 
class procedure TQtWSCustomNotebook.UpdateProperties(const ANotebook: TCustomNotebook);
465
 
begin
466
 
  TQtTabWidget(ANotebook.Handle).setTabsClosable(nboShowCloseButtons in ANotebook.Options);
467
 
end;
468
 
 
469
188
{ TQtWSCustomRadioGroup }
470
189
 
471
190
{------------------------------------------------------------------------------
577
296
class procedure TQtWSCustomTrayIcon.InternalUpdate(const ATrayIcon: TCustomTrayIcon);
578
297
var
579
298
  SystemTrayIcon: TQtSystemTrayIcon;
 
299
  AIcon: QIconH;
580
300
begin
581
301
  if (ATrayIcon.Handle = 0) then Exit;
582
302
 
583
303
  SystemTrayIcon := TQtSystemTrayIcon(ATrayIcon.Handle);
 
304
  if Assigned(ATrayIcon.Icon) then
 
305
  begin
 
306
    // normal icon
 
307
    if (ATrayIcon.Icon.HandleAllocated) then
 
308
      SystemTrayIcon.setIcon(TQtIcon(ATrayIcon.Icon.Handle).Handle)
 
309
    else
 
310
    // image list (animate)
 
311
    if (ATrayIcon.Icon.BitmapHandle <> 0) then
 
312
      SystemTrayIcon.setIcon(TQtImage(ATrayIcon.Icon.BitmapHandle).AsIcon)
 
313
    else
 
314
    begin
 
315
      AIcon := QIcon_create;
 
316
      SystemTrayIcon.setIcon(AIcon);
 
317
      QIcon_destroy(AIcon);
 
318
    end;
 
319
  end else
 
320
  begin
 
321
    AIcon := QIcon_create;
 
322
    SystemTrayIcon.setIcon(AIcon);
 
323
    QIcon_destroy(AIcon);
 
324
  end;
 
325
 
584
326
 
585
327
  { PopUpMenu }
586
328
  if Assigned(ATrayIcon.PopUpMenu) then