← Back to branch summary

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

« back to all changes in this revision

Viewing changes to lcl/interfaces/qt/qtobject.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/qt/qtobject.inc
20
20
// with various styles under X11.
21
21
procedure QtX11InitializePalettes;
22
22
var
23
 
  StyleName: WideString;
24
23
  Palette: QPaletteH;
25
24
  LineEditPalette: QPaletteH;
26
25
  ComboBoxPalette: QPaletteH;
27
26
  TextEditPalette: QPaletteH;
28
27
  Brush: QBrushH;
29
28
begin
30
 
  QObject_objectName(QApplication_style(), @StyleName);
31
 
 
32
29
  //palette for disabled viewports and edit controls
33
30
  Palette := QPalette_create();
34
31
  QApplication_palette(Palette);
78
75
begin
79
76
  FLastWFPMousePos := Point(MaxInt, MaxInt);
80
77
  FLastWFPResult := 0;
81
 
 
82
78
  inherited Create;
83
 
 
84
 
  App := QApplication_Create(@argc, argv);
 
79
  FIsLibraryInstance := QCoreApplication_instance() <> nil;
 
80
  if FIsLibraryInstance then
 
81
    App := QApplicationH(QCoreApplication_instance())
 
82
  else
 
83
    App := QApplication_Create(@argc, argv);
85
84
  {$J+}
86
85
  QtVersionInt(QtVersionMajor, QtVersionMinor, QtVersionMicro);
87
86
  {$J-}
 
87
  FCachedMenuBarHeight := -1;
 
88
  FAppEvenFilterHook := nil;
 
89
  FAppFocusChangedHook := nil;
 
90
 
 
91
  QtGDIObjects := TQtGDIObjects.Create;
88
92
  InitStockItems;
89
93
  QtWidgetSet := Self;
90
94
  ClearCachedColors;
94
98
  SavedHandlesList := TMap.Create(TMapIdType(ituPtrSize), SizeOf(TObject));
95
99
  FSocketEventMap := TMap.Create(TMapIdType(its4), SizeOf(Pointer));
96
100
  StayOnTopList := nil;
97
 
  FEatNextDeactivate := False;
 
101
  FAppActive := False;
98
102
  {$IFDEF HASX11}
99
103
  FMinimizedByPager := False;
100
104
  FLastMinimizeEvent := 0;
101
 
  if ((QtVersionMajor = 4) and (QtVersionMinor < 6)) or IsOldKDEInstallation then
102
 
    QtX11InitializePalettes;
 
105
  if not FIsLibraryInstance and
 
106
    ((QtVersionMajor = 4) and (QtVersionMinor < 6)) or IsOldKDEInstallation then
 
107
      QtX11InitializePalettes;
103
108
  FWindowManagerName := LowerCase(GetWindowManager);
104
109
  {$ENDIF}
 
110
  {$IFDEF DARWIN}
 
111
  // do not swap meta and ctrl keys, issue #20897
 
112
  if not FIsLibraryInstance and (QtVersionMajor = 4) and (QtVersionMinor > 5) then
 
113
    QCoreApplication_setAttribute(QtAA_MacDontSwapCtrlAndMeta, True);
 
114
  {$ENDIF}
105
115
  FGlobalActions := TFPList.Create;
106
116
end;
107
117
 
147
157
 
148
158
  System.DoneCriticalsection(CriticalSection);
149
159
 
 
160
  if Assigned(QtGDIObjects) then
 
161
    FreeThenNil(QtGDIObjects);
 
162
 
150
163
  inherited Destroy;
151
164
end;
152
165
 
200
213
  // install global event filter
201
214
  FAppEvenFilterHook := QObject_hook_create(App);
202
215
  QObject_hook_hook_events(FAppEvenFilterHook, @EventFilter);
203
 
  
204
 
  // install focus change slot
 
216
 
 
217
    // install focus change slot
205
218
 
206
219
  FAppFocusChangedHook := QApplication_hook_create(App);
207
220
  QApplication_hook_hook_focusChanged(FAppFocusChangedHook, @FocusChanged);
265
278
 ------------------------------------------------------------------------------}
266
279
procedure TQtWidgetSet.AppProcessMessages;
267
280
begin
268
 
  {we must use QEventLoopDefferedDeletion because of SlotClose.
269
 
   Normal forms are NOT closed without this ...}
270
281
  QCoreApplication_processEvents(QEventLoopAllEvents);
271
282
end;
272
283
 
282
293
  // free hooks
283
294
  QObject_hook_destroy(FAppEvenFilterHook);
284
295
  QApplication_hook_destroy(FAppFocusChangedHook);
285
 
 
286
 
  QCoreApplication_quit;
 
296
  // do not quit application if we are library
 
297
  if not FIsLibraryInstance then
 
298
    QCoreApplication_quit;
287
299
end;
288
300
 
289
301
procedure TQtWidgetSet.AppMinimize;
483
495
var
484
496
  AppFont: QFontH;
485
497
begin
 
498
  FCachedMenuBarHeight := -1;
486
499
  AppFont := QFont_create();
487
500
  QApplication_font(AppFont);
488
501
  QFont_family(AppFont, @FDefaultAppFontName);
498
511
var
499
512
  AObject: TQtObject;
500
513
  W: TQtMainWindow;
501
 
  R: TRect;
502
 
  Pt: TQtPoint;
 
514
  LCLEvent: QLCLMessageEventH;
 
515
  ASequence: QKeySequenceH;
 
516
  AKey: WideString;
 
517
  AParent: QWidgetH;
 
518
 
 
519
  function IsAnyWindowActive: Boolean;
 
520
  begin
 
521
    Result := (QApplication_activeWindow() <> nil) or
 
522
      (QApplication_activeModalWidget() <> nil) or
 
523
      (QApplication_activePopupWidget() <> nil);
 
524
  end;
 
525
 
503
526
begin
504
527
  Result := False;
505
528
  case QEvent_type(Event) of
 
529
 
 
530
    QEventShortcutOverride: // issue #22827
 
531
    begin
 
532
      QKeyEvent_text(QKeyEventH(Event), @AKey);
 
533
      if (QKeyEvent_modifiers(QKeyEventH(Event)) = QtAltModifier) and
 
534
       (AKey <> '') then
 
535
      begin
 
536
        ASequence := QKeySequence_create(QKeyEvent_modifiers(QKeyEventH(Event))
 
537
          or QKeyEvent_Key(QKeyEventH(Event)));
 
538
        try
 
539
          AParent := QWidget_parentWidget(QWidgetH(Sender));
 
540
          if AParent <> nil then
 
541
            Result := QApplication_notify(App, AParent, Event);
 
542
        finally
 
543
          QKeySequence_destroy(ASequence);
 
544
        end;
 
545
      end;
 
546
    end;
 
547
 
506
548
    QEventApplicationFontChange: SetDefaultAppFontName;
 
549
    QEventStyleChange:
 
550
      begin
 
551
        if (Sender = QCoreApplication_instance()) then
 
552
          FCachedMenuBarHeight := -1;
 
553
      end;
507
554
    QEventApplicationActivate:
508
 
      if Assigned(Application) and not FEatNextDeactivate then
 
555
    begin
 
556
      LCLEvent := QLCLMessageEvent_create(LCLQt_ApplicationActivate);
 
557
       // activate it imediatelly (high priority)
 
558
      QCoreApplication_postEvent(Sender, LCLEvent, 1 {high priority});
 
559
    end;
 
560
    LCLQt_ApplicationActivate:
 
561
      if Assigned(Application) and not FAppActive then
509
562
      begin
 
563
        FAppActive := True;
 
564
        {$IF DEFINED(QTDEBUGAPPACTIVATE) OR DEFINED(VerboseQtEvents)}
 
565
        DebugLn('TQtWidgetSet.EventFilter: Application is activated - time ',dbgs(GetTickCount));
 
566
        {$ENDIF}
510
567
        // check if activated form is StayOnTop, if it's so, we must
511
568
        // eat next appdeactivate & appactivate since we are changing form
512
569
        // flags !
513
570
        if (StayOnTopList <> nil) then
514
 
        begin
515
 
          W := TQtMainWindow(HWNDFromWidgetH(QApplication_activeWindow()));
516
 
          FEatNextDeactivate := StayOnTopList.HasId(W);
517
 
        end;
 
571
          W := TQtMainWindow(HWNDFromWidgetH(QApplication_activeWindow()))
 
572
        else
 
573
          W := nil;
518
574
        Application.IntfAppActivate;
519
575
        QtRestoreStayOnTop;
520
 
        if (FEatNextDeactivate) and (W <> nil) then
 
576
        if (W <> nil) and Assigned(StayOnTopList) and StayOnTopList.HasId(W) then
521
577
          W.Activate;
522
 
      end else
523
 
        FEatNextDeactivate := False;
 
578
        Result := True;
 
579
      end;
524
580
 
525
581
    QEventApplicationDeactivate:
526
 
      if Assigned(Application) and not FEatNextDeactivate then
527
 
      begin
 
582
    begin
 
583
      // we must check if we are ready for deactivation (low priority)
 
584
      // this is 2way check. LCLQt_ApplicationDeActivate sends
 
585
      // LCLQt_ApplicationDeActivate_Check to be 100% sure if needed.
 
586
      LCLEvent := QLCLMessageEvent_create(LCLQt_ApplicationDeActivate);
 
587
      QCoreApplication_postEvent(Sender, LCLEvent, -$FF);
 
588
    end;
 
589
 
 
590
    LCLQt_ApplicationDeactivate:
 
591
      begin
 
592
        if Assigned(Application) and FAppActive then
 
593
        begin
 
594
          if not IsAnyWindowActive then
 
595
          begin
 
596
            QCoreApplication_sendPostedEvents(nil, QEventWindowActivate);
 
597
            QCoreApplication_processEvents(QEventLoopAllEvents, 10 {msec});
 
598
          end;
 
599
 
 
600
          // if there's active window after posting from queue, just exit ...
 
601
          // app is not deactivated.
 
602
          if IsAnyWindowActive then
 
603
            exit(True);
 
604
 
 
605
          // to be 100% sure that we are really deactivated, send check
 
606
          // event with pretty low priority. We need
 
607
          // LCLQt_ApplicationDeActivate_Check to avoid infinite loop inside
 
608
          // this event with same code.
 
609
          LCLEvent := QLCLMessageEvent_create(LCLQt_ApplicationDeActivate_Check);
 
610
          QCoreApplication_postEvent(Sender, LCLEvent, -$FFFF);
 
611
          Result := True;
 
612
        end;
 
613
      end;
 
614
 
 
615
    LCLQt_ApplicationDeactivate_Check:
 
616
      if Assigned(Application) and FAppActive then
 
617
      begin
 
618
        // 1st send posted events, and process few events from queue
 
619
        if not IsAnyWindowActive then
 
620
        begin
 
621
          QCoreApplication_sendPostedEvents(nil, QEventWindowActivate);
 
622
          QCoreApplication_processEvents(QEventLoopAllEvents, 10 {msec});
 
623
        end;
 
624
 
 
625
        // if there's active window after posting from queue, just exit ...
 
626
        // app is not deactivated.
 
627
        if IsAnyWindowActive then
 
628
        begin
 
629
          {$IF DEFINED(QTDEBUGAPPACTIVATE) OR DEFINED(VerboseQtEvents)}
 
630
          DebugLn('NOTICE: TQtWidgetSet.EventFilter: App deactivation called with active windows ... ignoring.');
 
631
          {$ENDIF}
 
632
          QEvent_ignore(Event);
 
633
          exit(True);
 
634
        end;
 
635
        {$IF DEFINED(QTDEBUGAPPACTIVATE) OR DEFINED(VerboseQtEvents)}
 
636
        DebugLn('TQtWidgetSet.EventFilter: Application is deactivated - time ',dbgs(GetTickCount));
 
637
        {$ENDIF}
 
638
        FAppActive := False;
528
639
        Application.IntfAppDeactivate;
529
640
        QtRemoveStayOnTop;
 
641
        Result := True;
530
642
      end;
531
643
 
532
644
    QEventApplicationPaletteChange:
540
652
    QEventShow,
541
653
    QEventHide:
542
654
      begin
543
 
        // invalidate widgetAt cache if needed
 
655
        // invalidate widgetAt cache.
544
656
        if QObject_isWidgetType(Sender) and IsValidWidgetAtCachePointer then
545
 
        begin
546
 
          QWidget_geometry(QWidgetH(Sender), @R);
547
 
          Pt.x := 0;
548
 
          Pt.y := 0;
549
 
          QWidget_mapToGlobal(QWidgetH(Sender), @Pt, @Pt);
550
 
          R := Rect(Pt.X, Pt.Y, Pt.X + (R.Right - R.Left), Pt.Y + (R.Bottom - R.Top));
551
 
          if PtInRect(R, GetWidgetAtCachePoint) then
552
 
            InvalidateWidgetAtCache;
553
 
        end;
 
657
          InvalidateWidgetAtCache;
554
658
      end;
555
659
    LCLQt_Destroy:
556
660
      begin
568
672
  end;
569
673
end;
570
674
 
571
 
procedure TQtWidgetSet.FocusChanged(old: QWidgetH; now: QWidgetH); cdecl;
 
675
procedure TQtWidgetSet.FocusChanged(aold: QWidgetH; anew: QWidgetH); cdecl;
572
676
var
573
677
  OldWidget, NewWidget: TQtWidget;
574
678
  Msg: TLMessage;
 
679
  FocusedQtWidget: QWidgetH;
 
680
  FocusedTQtWidget: TQtWidget;
 
681
 
 
682
  {qt is tricky about focus, we don't want to inform LCL when qt internally
 
683
  kills focus on an inactive form. eg. TTreeView->Editor enabled}
 
684
  function CheckIfActiveForm(AWidget: TQtWidget): Boolean;
 
685
  var
 
686
    AForm: TCustomForm;
 
687
    AMainWin: TQtMainWindow;
 
688
    QtEdit: IQtEdit;
 
689
  begin
 
690
    Result := True;
 
691
    if Assigned(AWidget) and Assigned(AWidget.LCLObject) then
 
692
    begin
 
693
      AMainWin := nil;
 
694
      if (csDesigning in AWidget.LCLObject.ComponentState) then
 
695
        exit;
 
696
      if TQtWidget(AWidget.LCLObject.Handle) is TQtMainWindow then
 
697
        AMainWin := TQtMainWindow(AWidget);
 
698
 
 
699
      if AMainWin = nil then
 
700
      begin
 
701
        AForm := GetParentForm(AWidget.LCLObject);
 
702
        if Assigned(AForm) and (AForm.HandleAllocated) then
 
703
          AMainWin := TQtMainWindow(AForm.Handle);
 
704
      end;
 
705
      Result := AMainWin <> nil;
 
706
      if not Result then
 
707
      begin
 
708
        {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
709
        WriteLn('TQtWidgetSet.FocusChanged: CheckIfActiveForm *** NO FORM ?!? ***');
 
710
        {$ENDIF}
 
711
        exit;
 
712
      end;
 
713
 
 
714
      if AMainWin.IsMdiChild then
 
715
      begin
 
716
        Result :=
 
717
          QMdiArea_activeSubWindow(QMdiSubWindow_mdiArea(QMdiSubWindowH(AMainWin.Widget))) =
 
718
            QMdiSubWindowH(AMainWin.Widget);
 
719
      end else
 
720
      begin
 
721
        Result := QWidget_isActiveWindow(AMainWin.Widget);
 
722
      end;
 
723
      if (AMainWin <> AWidget) and not Supports(AWidget, IQtEdit, QtEdit) then
 
724
        Result := True;
 
725
    end;
 
726
  end;
 
727
 
 
728
  {checks when qtmdi is doing weird thing (trying to loop itself)}
 
729
  function MDIFocusFixNeeded: Boolean;
 
730
  var
 
731
    OldWin, NewWin: TCustomForm;
 
732
    // H: HWND;
 
733
  begin
 
734
    Result := False;
 
735
 
 
736
    if Assigned(OldWidget.LCLObject) then
 
737
      OldWin := GetParentForm(OldWidget.LCLObject)
 
738
    else
 
739
      OldWin := nil;
 
740
 
 
741
    if (NewWidget <> nil) and Assigned(NewWidget.LCLObject) then
 
742
      NewWin := GetParentForm(NewWidget.LCLObject)
 
743
    else
 
744
      NewWin := nil;
 
745
 
 
746
    Result := (OldWin <> nil) and OldWin.HandleAllocated and
 
747
      ((OldWin = NewWin) or (NewWin = nil));
 
748
 
 
749
    if not Result then
 
750
      exit;
 
751
 
 
752
    // that's real window of our => form
 
753
    Result := TQtMainWindow(OldWin.Handle).MDIChildArea <> nil;
 
754
    // Result := Result and ((NewWin = nil) or (TQtMainWindow(NewWin.Handle).MDIChildArea <> nil));
 
755
    if Result then
 
756
      Result := (OldWin = OldWidget.LCLObject) or
 
757
        ((NewWin = nil) or (NewWin = NewWidget.LCLObject));
 
758
  end;
 
759
 
575
760
begin
576
 
  // WriteLn('old: ', PtrUInt(old), ' new: ', PtrUInt(now));
577
 
  OldWidget := GetFirstQtObjectFromWidgetH(old);
578
 
  NewWidget := GetFirstQtObjectFromWidgetH(now);
 
761
  {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
762
  WriteLn('TQtWidgetSet.FocusChanged: old: ', dbgHex(PtrUInt(aold)), ' new: ', dbgHex(PtrUInt(anew)));
 
763
  {$ENDIF}
 
764
  OldWidget := GetFirstQtObjectFromWidgetH(aold);
 
765
  NewWidget := GetFirstQtObjectFromWidgetH(anew);
579
766
 
580
767
  if OldWidget = NewWidget then
 
768
  begin
 
769
    {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
770
    WriteLn('TQtWidgetSet.FocusChanged: OldWidget = NewWidget ... exiting ...');
 
771
    {$ENDIF}
581
772
    Exit;
 
773
  end;
582
774
 
583
775
  {Applies to all TQtWidgets which have "subwidgets" created
584
776
   by CreateFrom() eg. comboBox.}
585
777
  if (OldWidget <> nil) and
586
778
     (NewWidget <> nil) and
587
779
     (OldWidget.LCLObject = NewWidget.LCLObject) then
 
780
  begin
 
781
    {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
782
    WriteLn('TQtWidgetSet.FocusChanged: exiting ... '+
 
783
    'OldWidget.LCLObject=NewWidget.LCLObject OBJ=',dbgsName(OldWidget.LCLObject));
 
784
    {$ENDIF}
588
785
    exit;
589
 
 
590
 
  FillChar(Msg, SizeOf(Msg), 0);
591
 
  if OldWidget <> nil then
592
 
  begin
593
 
    //WriteLn('KILL: ', OldWidget.LCLObject.ClassName);
 
786
  end;
 
787
 
 
788
  Msg.Msg := 0; // shutup compiler
 
789
  FillChar(Msg, SizeOf(Msg), 0);
 
790
 
 
791
  if IsValidHandle(HWND(NewWidget)) then
 
792
  begin
 
793
    {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
794
    WriteLn('TQtWidgetSet.FocusChanged: SET ', dbgsName(NewWidget.LCLObject));
 
795
    {$ENDIF}
 
796
    Msg.msg := LM_SETFOCUS;
 
797
    Msg.wParam := PtrInt(OldWidget);
 
798
    if (NewWidget is TQtMainWindow) and (TQtMainWindow(NewWidget).IsMdiChild) and
 
799
      Assigned(TQtMainWindow(NewWidget).LCLObject) and
 
800
      not (csDesigning in TQtMainWindow(NewWidget).LCLObject.ComponentState) then
 
801
    begin
 
802
      // DO NOT TRIGGER ANYTHING, THIS IS SPURIOUS EVENT FROM MDIAREA
 
803
      FocusedQtWidget := QWidget_focusWidget(NewWidget.Widget);
 
804
      {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
805
      Writeln('TQtWidgetSet.FocusChanged: *** DO NOT SET FOCUS ***',dbgHex(PtrUInt(FocusedQtWidget)));
 
806
      {$ENDIF}
 
807
      if FocusedQtWidget <> nil then
 
808
      begin
 
809
        FocusedTQtWidget := TQtWidget(HwndFromWidgetH(FocusedQtWidget));
 
810
        if FocusedTQtWidget <> nil then
 
811
        begin
 
812
          if FocusedTQtWidget = NewWidget then
 
813
          begin
 
814
            {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
815
            writeln('TQtWidgetSet.FocusChanged: WE CANNOT FOCUS (segfault) ',dbgsName(FocusedTQtWidget.LCLObject),
 
816
            ' Active ? ',TCustomForm(NewWidget.LCLObject).Active);
 
817
            {$ENDIF}
 
818
            if Assigned(TCustomForm(NewWidget.LCLObject).ActiveControl) then
 
819
            begin
 
820
              {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
821
              writeln('TQtWidgetSet.FocusChanged: THIS ONE SHOULD BE FOCUSED (1) : ',dbgsName(TCustomForm(NewWidget.LCLObject).ActiveControl));
 
822
              {$ENDIF}
 
823
              if TCustomForm(NewWidget.LCLObject).ActiveControl.HandleAllocated then
 
824
              begin
 
825
                // setFocus(TCustomForm(NewWidget.LCLObject).ActiveControl.Handle);
 
826
                FocusedTQtWidget := TQtWidget(TCustomForm(NewWidget.LCLObject).ActiveControl.Handle);
 
827
                if FocusedTQtWidget <> nil then
 
828
                begin
 
829
                  // first check if we are active subwin, if not then we'll trigger qt do
 
830
                  // do correct thing
 
831
                  if TQtMainWindow(NewWidget).MDIChildArea.ActiveSubWindow <> NewWidget.Widget then
 
832
                    TQtMainWindow(NewWidget).MDIChildArea.ActivateSubWindow(QMDISubWindowH(NewWidget.Widget))
 
833
                  else
 
834
                  begin
 
835
                    // if we are already active then just inform lcl
 
836
                    Msg.msg := LM_SETFOCUS;
 
837
                    if OldWidget = FocusedTQtWidget then
 
838
                      OldWidget := nil;
 
839
                    Msg.wParam := PtrInt(OldWidget);
 
840
                    FocusedTQtWidget.DeliverMessage(Msg);
 
841
                  end;
 
842
                end;
 
843
              end else
 
844
                {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
845
                writeln('TQtWidgetSet.FocusChanged: BUT NO HANDLE ... CRAP: ',dbgsName(TCustomForm(NewWidget.LCLObject).ActiveControl))
 
846
                {$ENDIF}
 
847
                ;
 
848
 
 
849
            end else
 
850
              // if this happens then qt's mdi focus is real crap
 
851
              {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
852
              writeln('TQtWidgetSet.FocusChanged: WE ARE COMPLETELY OUT OF MIND WHAT TO DO (1) .....')
 
853
              {$ENDIF}
 
854
              ;
 
855
 
 
856
          end else
 
857
          begin
 
858
            // should never happen
 
859
            {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
860
            if Assigned(TCustomForm(NewWidget.LCLObject).ActiveControl) then
 
861
              writeln('TQtWidgetSet.FocusChanged: THIS ONE SHOULD BE FOCUSED (2) : ',dbgsName(TCustomForm(NewWidget.LCLObject).ActiveControl))
 
862
            else
 
863
              writeln('TQtWidgetSet.FocusChanged: WE ARE COMPLETELY OUT OF MIND WHAT TO DO (2) .....');
 
864
            {$ENDIF}
 
865
          end;
 
866
 
 
867
        end;
 
868
      end;
 
869
 
 
870
    end else
 
871
      NewWidget.DeliverMessage(Msg);
 
872
  end;
 
873
 
 
874
  FillChar(Msg, SizeOf(Msg), 0);
 
875
  if IsValidHandle(HWND(OldWidget)) then
 
876
  begin
 
877
    {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
878
    WriteLn('TQtWidgetSet.FocusChanged: KILL ', dbgsName(OldWidget.LCLObject),' W.Visible ',OldWidget.getVisible,
 
879
    ' destroying ? ',csDestroying in OldWidget.LCLObject.ComponentState,
 
880
    ' handle ?!? ',OldWidget.LCLObject.HandleAllocated);
 
881
    {$ENDIF}
594
882
    Msg.msg := LM_KILLFOCUS;
595
883
    Msg.wParam := PtrInt(NewWidget);
596
 
    OldWidget.DeliverMessage(Msg);
597
 
  end;
598
 
  if NewWidget <> nil then
599
 
  begin
600
 
    //WriteLn('SET: ', NewWidget.LCLObject.ClassName);
601
 
    Msg.msg := LM_SETFOCUS;
602
 
    Msg.wParam := PtrInt(OldWidget);
603
 
    NewWidget.DeliverMessage(Msg);
 
884
    if ((OldWidget is TQtMainWindow) and (TQtMainWindow(OldWidget).IsMdiChild) and
 
885
      Assigned(TQtMainWindow(OldWidget).LCLObject) and
 
886
      not (csDesigning in TQtMainWindow(OldWidget).LCLObject.ComponentState))
 
887
      or MDIFocusFixNeeded then
 
888
      // DO NOT TRIGGER ANYTHING, THIS IS SPURIOUS EVENT FROM MDIAREA
 
889
      {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
890
      Writeln('TQtWidgetSet.FocusChanged: *** DO NOT KILL FOCUS ***')
 
891
      {$ENDIF}
 
892
    else
 
893
      if CheckIfActiveForm(OldWidget) then
 
894
        OldWidget.DeliverMessage(Msg)
 
895
      {$IF DEFINED(VerboseFocus) OR DEFINED(DebugQtFocus)}
 
896
      else
 
897
        Writeln('TQtWidgetSet.FocusChanged: Cannot kill focus of ',dbgsName(OldWidget.LCLObject))
 
898
      {$ENDIF}
 
899
      ;
604
900
  end;
605
901
end;
606
902
 
620
916
function TQtWidgetSet.GetLCLCapability(ACapability: TLCLCapability): PtrUInt;
621
917
begin
622
918
  case ACapability of
 
919
    lcEmulatedMDI,
623
920
    lcCanDrawOutsideOnPaint: Result := LCL_CAPABILITY_NO;
624
921
    lcDragDockStartOnTitleClick: Result :=
625
922
     {$ifdef MSWINDOWS} LCL_CAPABILITY_YES {$else} LCL_CAPABILITY_NO {$endif};
626
923
     lcNeedMininimizeAppWithMainForm: Result :=
627
924
     {$ifdef HASX11} LCL_CAPABILITY_YES {$else} LCL_CAPABILITY_NO {$endif};
 
925
     {when issue #20475 is fixed, then set this to LCL_CAPABILITY_YES}
 
926
     lcReceivesLMClearCutCopyPasteReliably: Result := LCL_CAPABILITY_NO;
628
927
  else
629
928
    Result := inherited GetLCLCapability(ACapability);
630
929
  end;
640
939
  
641
940
  if (TQtDeviceContext(CanvasHandle).vImage <> nil) then
642
941
  begin
643
 
// This code results in ARGB values, but TColor uses ABGR
644
 
//    Result := TColor(QImage_pixel(TQtDeviceContext(CanvasHandle).vImage.Handle, X, Y));
645
 
 
646
942
    Color := QColor_create(QImage_pixel(TQtDeviceContext(CanvasHandle).vImage.Handle, X, Y));
647
 
 
648
943
    Result := RGBToColor(QColor_red(Color), QColor_green(Color), QColor_blue(Color));
649
 
 
650
944
    QColor_destroy(Color);
651
945
  end;
652
946
end;
660
954
var
661
955
  ASavedColor: TQColor;
662
956
  Color: TQColor;
 
957
  ColorRef: TColorRef;
663
958
  Pen: QPenH;
664
959
  Painter: QPainterH;
665
960
begin
666
961
  if IsValidDC(CanvasHandle) then
667
962
  begin
668
 
    //WriteLn('TQtWidgetSet.DCSetPixel X=',X,' Y=',Y, ' AColor=',dbghex(AColor));
 
963
    // WriteLn('TQtWidgetSet.DCSetPixel X=',X,' Y=',Y, ' AColor=',dbghex(AColor),' rgb ? ',dbgHex(ColorToRGB(AColor)));
669
964
    Painter := TQtDeviceContext(CanvasHandle).Widget;
670
965
    Pen := QPainter_pen(Painter);
671
966
    QPen_color(Pen, @ASavedColor);
672
 
    QColor_fromRgb(@Color, ColorToRGB(AColor));
 
967
    ColorRef := TColorRef(ColorToRGB(AColor));
 
968
    QColor_fromRgb(@Color, Red(ColorRef), Green(ColorRef), Blue(ColorRef));
673
969
    QPainter_setPen(Painter, @Color);
674
970
    QPainter_drawPoint(Painter, X,Y);
675
971
    QPainter_setPen(Painter, @ASavedColor);
683
979
 
684
980
procedure TQtWidgetSet.DCSetAntialiasing(CanvasHandle: HDC; AEnabled: Boolean);
685
981
var
686
 
  DC: TQtDeviceContext absolute CanvasHandle;
 
982
  DC: TQtDeviceContext;
687
983
begin
688
984
  if IsValidDC(CanvasHandle) then
 
985
  begin
 
986
    if CanvasHandle = 1 then
 
987
      DC := QtDefaultContext
 
988
    else
 
989
      DC := TQtDeviceContext(CanvasHandle);
689
990
    DC.setRenderHint(QPainterAntialiasing, AEnabled);
 
991
  end;
690
992
end;
691
993
 
692
994
procedure TQtWidgetSet.SetDesigning(AComponent: TComponent);
717
1019
  aObject: TObject;
718
1020
begin
719
1021
  Result := False;
720
 
  
721
 
  if GDIObject = 0 then Exit;
 
1022
 
 
1023
  if not QtGDIObjects.IsValidGDIObject(GDIObject) then
 
1024
    exit;
722
1025
  
723
1026
  aObject := TObject(GDIObject);
724
1027
  try
729
1032
        (aObject is TQtBrush) or
730
1033
        (aObject is TQtImage) or
731
1034
        (aObject is TQtPen) or
732
 
        (aObject is TQTRegion);
 
1035
        (aObject is TQtRegion);
733
1036
    end;
734
1037
  except
735
 
    DebugLn(['Gdi object: ', GDIObject, ' is not an object!']);
736
 
    raise;
 
1038
    // DebugLn(['TQtWidgetSet.IsValidGDIObject: Gdi object ', GDIObject, ' is not an object!']);
 
1039
    raise Exception.CreateFmt('TQtWidgetSet.IsValidGDIObject: %u is not an object ',[PtrUInt(GDIObject)]);
737
1040
  end;
738
1041
end;
739
1042
 
895
1198
begin
896
1199
  if FDragImageList = nil then
897
1200
  begin
898
 
    FDragImageList := QWidget_create(nil, QtSubWindow or QtFramelessWindowHint or QtWindowStaysOnTopHint);
 
1201
    FDragImageList := QWidget_create(nil,
 
1202
      QtSubWindow or QtFramelessWindowHint or
 
1203
      QtWindowStaysOnTopHint {$IFDEF HASX11}or QtX11BypassWindowManagerHint{$ENDIF});
 
1204
 
 
1205
    // do not set focus and do not activate this widget
 
1206
    QWidget_setFocusPolicy(FDragImageList, QtNoFocus);
 
1207
    QWidget_setAttribute(FDragImageList, QtWA_ShowWithoutActivating, True);
 
1208
 
899
1209
    QImage_size(AImage, @ASize);
900
1210
    QWidget_setFixedSize(FDragImageList, @ASize);
901
1211
    APixmap := QPixmap_create();
956
1266
begin
957
1267
  QtFont := TQtFont.Create(True);
958
1268
  QtFont.FShared := True;
959
 
  QApplication_font(QtFont.Widget);
 
1269
  QApplication_font(QtFont.FHandle);
960
1270
  Result := HFONT(QtFont);
961
1271
end;
962
1272
 
1011
1321
 
1012
1322
  procedure InvalidateHandleOnly(AIndex: Integer; h: HGDIOBJ);
1013
1323
  begin
1014
 
    if (h <> 0) and (TQtBrush(h).Widget <> nil) then
 
1324
    if (h <> 0) and (TQtBrush(h).FHandle <> nil) then
1015
1325
    begin
1016
 
      QBrush_destroy(TQtBrush(h).Widget);
1017
 
      TQtBrush(h).Widget := nil;
 
1326
      QBrush_destroy(TQtBrush(h).FHandle);
 
1327
      TQtBrush(h).FHandle := nil;
1018
1328
      getSysColorBrush(AIndex);
1019
1329
    end;
1020
1330
  end;
1089
1399
  FStockDefaultDC := 0; // app must be initialized
1090
1400
end;
1091
1401
 
 
1402
function TQtWidgetSet.GetMenuHeight: Integer;
 
1403
var
 
1404
  AMenuBar: QMenuBarH;
 
1405
  DummyWindow: QMainWindowH;
 
1406
  DummyStr: WideString;
 
1407
  Size: TSize;
 
1408
begin
 
1409
  {$IFDEF DARWIN}
 
1410
  FCachedMenuBarHeight := 1;
 
1411
  {$ENDIF}
 
1412
  if FCachedMenuBarHeight = -1 then
 
1413
  begin
 
1414
    DummyWindow := QMainWindow_create(QApplication_desktop());
 
1415
    QWidget_setVisible(DummyWindow, False);
 
1416
    AMenuBar := QMenuBar_create();
 
1417
    DummyStr := 'DUMMY BAR';
 
1418
    QMenuBar_addMenu(AMenuBar, @DummyStr);
 
1419
    QMainWindow_setMenuBar(DummyWindow, AMenuBar);
 
1420
    QMenuBar_sizeHint(AMenuBar, @Size);
 
1421
    QMainWindow_destroy(DummyWindow);
 
1422
    FCachedMenuBarHeight := Size.cy;
 
1423
 
 
1424
    if QStyle_styleHint(QApplication_style(),
 
1425
      QStyleSH_MainWindow_SpaceBelowMenuBar) > 0 then
 
1426
      inc(FCachedMenuBarHeight, 4);
 
1427
    if QStyle_styleHint(QApplication_style(),
 
1428
      QStyleSH_ScrollView_FrameOnlyAroundContents) > 0 then
 
1429
      inc(FCachedMenuBarHeight, 4);
 
1430
  end;
 
1431
  if (FCachedMenuBarHeight <= 0) then
 
1432
  begin
 
1433
    FCachedMenuBarHeight := 22;
 
1434
    if QStyle_styleHint(QApplication_style(), QStyleSH_MainWindow_SpaceBelowMenuBar) > 0 then
 
1435
      inc(FCachedMenuBarHeight, 4);
 
1436
  end;
 
1437
  Result := FCachedMenuBarHeight;
 
1438
end;
 
1439
 
1092
1440
procedure TQtWidgetSet.ClearCachedColors;
1093
1441
var
1094
1442
  i: Integer;
1101
1449
  end;
1102
1450
end;
1103
1451
 
 
1452
function TQtWidgetSet.GetStyleName: String;
 
1453
var
 
1454
  WStr: WideString;
 
1455
begin
 
1456
  QObject_objectName(QApplication_style, @WStr);
 
1457
  Result := UTF8ToUTF16(WStr);
 
1458
end;
 
1459
 
1104
1460
//------------------------------------------------------------------------