RxFPC:fix active window lost focus on TRxPopupNotifier show message. New function in RxAppUtil - RxGetKeyboardLayoutName

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6348 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2018-04-24 13:27:14 +00:00
parent 75e57b190f
commit 0f98655a07
7 changed files with 338 additions and 5 deletions
--- a/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/project1.ico
+++ b/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/project1.ico
--- a/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/project1.lpi
+++ b/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/project1.lpi
@ -0,0 +1,81 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <General>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="project1"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+      <Modes Count="0"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="rxnew"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="project1.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="unit1.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Unit1"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="project1"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>
--- a/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/project1.lpr
+++ b/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/project1.lpr
@ -0,0 +1,22 @@
+program project1;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, rxnew, Unit1
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+
--- a/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/unit1.lfm
+++ b/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/unit1.lfm
@ -0,0 +1,73 @@
+object Form1: TForm1
+  Left = 708
+  Height = 240
+  Top = 316
+  Width = 320
+  Caption = 'Form1'
+  ClientHeight = 240
+  ClientWidth = 320
+  OnCreate = FormCreate
+  Position = poScreenCenter
+  LCLVersion = '1.9.0.0'
+  object Label2: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideLeft.Side = asrCenter
+    AnchorSideTop.Control = Label3
+    AnchorSideTop.Side = asrBottom
+    Left = 127
+    Height = 24
+    Top = 19
+    Width = 67
+    BorderSpacing.Around = 6
+    Caption = 'Label2'
+    Font.Height = -20
+    Font.Style = [fsBold]
+    ParentColor = False
+    ParentFont = False
+  end
+  object Label3: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideLeft.Side = asrCenter
+    AnchorSideTop.Control = Owner
+    Left = 119
+    Height = 13
+    Top = 0
+    Width = 82
+    Caption = 'Keyboard Layout'
+    ParentColor = False
+  end
+  object Label1: TLabel
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Owner
+    AnchorSideTop.Side = asrCenter
+    Left = 6
+    Height = 13
+    Top = 114
+    Width = 88
+    BorderSpacing.Around = 6
+    Caption = 'Enter text for test'
+    ParentColor = False
+  end
+  object Memo1: TMemo
+    AnchorSideLeft.Control = Owner
+    AnchorSideTop.Control = Label1
+    AnchorSideTop.Side = asrBottom
+    AnchorSideRight.Control = Owner
+    AnchorSideRight.Side = asrBottom
+    AnchorSideBottom.Control = Owner
+    AnchorSideBottom.Side = asrBottom
+    Left = 6
+    Height = 101
+    Top = 133
+    Width = 308
+    Anchors = [akTop, akLeft, akRight, akBottom]
+    BorderSpacing.Around = 6
+    TabOrder = 0
+  end
+  object Timer1: TTimer
+    Interval = 500
+    OnTimer = Timer1Timer
+    Left = 144
+    Top = 72
+  end
+end
--- a/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/unit1.pas
+++ b/components/rx/trunk/demos/RxAppUtils/KeyboardLayout/unit1.pas
@ -0,0 +1,49 @@
+unit Unit1;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls;
+
+type
+
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    Label1: TLabel;
+    Label2: TLabel;
+    Label3: TLabel;
+    Memo1: TMemo;
+    Timer1: TTimer;
+    procedure FormCreate(Sender: TObject);
+    procedure Timer1Timer(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+uses LazUTF8, rxAppUtils;
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.Timer1Timer(Sender: TObject);
+begin
+  Label2.Caption:='  '+UTF8UpperCase(UTF8Copy(RxGetKeyboardLayoutName, 1, 2)) + '  ';
+end;
+
+procedure TForm1.FormCreate(Sender: TObject);
+begin
+  Timer1Timer(nil);
+end;
+
+end.
+
--- a/components/rx/trunk/rxcontrols/rxapputils.pas
+++ b/components/rx/trunk/rxcontrols/rxapputils.pas
@ -92,10 +92,15 @@ procedure RxDefaultWriteLog( ALogType:TEventType; const ALogMessage:string);
 function RxDefaultLogFileName:string;
 procedure InitRxLogs;

+function RxGetKeyboardLayoutName:string;
+
 implementation
 uses
  {$IFDEF WINDOWS}
-  windirs,
+  Windows, windirs,
+  {$ENDIF}
+  {$IFDEF LINUX}
+  X, XKB, xkblib, xlib,
  {$ENDIF}
  Registry, Forms, FileUtil, LazUTF8, LazFileUtils, Dialogs;

@ -195,6 +200,88 @@ begin
  OnRxLoggerEvent:=@RxDefaultWriteLog;
 end;

+{$IFDEF LINUX}
+function getKeyboardLang(dpy:PDisplay; AGroup:Integer):string;
+var
+  baseEventCode, baseErrorCode, opcode:integer;
+  groupCount:integer;
+  major:integer;
+  minor:integer;
+  kbdDescPtr: PXkbDescPtr;
+  tmpGroupSource: TAtom;
+begin
+  major:=0;
+  minor:=0;
+  XkbQueryExtension(dpy, @opcode, @baseEventCode, @baseErrorCode, @major, @minor);
+
+  kbdDescPtr := XkbAllocKeyboard();
+
+  if not Assigned(kbdDescPtr) then
+  begin
+    Result:='Failed to get keyboard description.';
+    exit;
+  end;
+
+  kbdDescPtr^.dpy := dpy;
+  kbdDescPtr^.device_spec := XkbUseCoreKbd;
+
+  XkbGetControls(dpy, XkbAllControlsMask, kbdDescPtr);
+  XkbGetNames(dpy, XkbSymbolsNameMask, kbdDescPtr);
+  XkbGetNames(dpy, XkbGroupNamesMask, kbdDescPtr);
+
+  if (not Assigned(kbdDescPtr^.names)) then
+  begin
+    Result:='Failed to get keyboard description.';
+    exit;
+  end;
+
+  if AGroup in [0 .. XkbNumKbdGroups -1] then
+  begin
+    tmpGroupSource := kbdDescPtr^.names^.groups[AGroup];
+    Result:=XGetAtomName(dpy, tmpGroupSource);
+  end
+  else
+    Result:='';
+end;
+
+{$ENDIF}
+
+function RxGetKeyboardLayoutName: string;
+{$IFDEF WINDOWS}
+var
+  LayoutName:array [0..KL_NAMELENGTH + 1] of char;
+  LangName: array [0 .. 1024] of Char;
+{$ENDIF}
+{$IFDEF LINUX}
+var
+  Disp: PDisplay;
+  RtrnState: TXkbStateRec;
+{$ENDIF}
+begin
+  {$IFDEF WINDOWS}
+  GetKeyboardLayoutName(@LayoutName);
+  if GetLocaleInfo(StrToInt('$' + StrPas(LayoutName)), LOCALE_SABBREVLANGNAME, @LangName, SizeOf(LangName) - 1) <> 0  then
+    Result := StrPas(LangName);
+//  end;
+//  Result := AnsiUpperCase(Copy(Result, 1, 2));
+  {$ELSE}
+  {$IFDEF LINUX}
+  Disp := XOpenDisplay(nil);
+  if Assigned(Disp) then
+  begin
+    XkbGetState(Disp, XkbUseCoreKbd, @RtrnState);
+    Result:=getKeyboardLang(Disp, RtrnState.group);
+    XCloseDisplay(Disp);
+  end
+  else
+    Result:='';
+  {$ELSE}
+    //Other system - maybe in future?
+    Result:='';
+  {$ENDIF LINUX}
+  {$ENDIF WINDOWS}
+end;
+

 function GetDefaultSection(Component: TComponent): string;
 var
--- a/components/rx/trunk/rxcontrols/rxpopupnotifier.pas
+++ b/components/rx/trunk/rxcontrols/rxpopupnotifier.pas
@ -48,7 +48,7 @@ type

  { TRxNotifierForm }

-  TRxNotifierForm = class(TForm)
+  TRxNotifierForm = class(THintWindow)
  private
    FCloseButton:TButton;
    FCaptionLabel:TLabel;
@ -60,6 +60,8 @@ type
    procedure CreateMessage(AMessage:string);
    procedure CreateTimerLabel;
    procedure ButtonCloseClick(Sender: TObject);
+  protected
+    procedure DoShowWindow; override;
  public
    constructor CreateNotifierForm(AOwnerItem:TRxPopupNotifierItem);
  end;
@ -152,14 +154,14 @@ type
  end;

 implementation
-uses rxconst;
+uses rxconst, LCLType;

 { TRxNotifierForm }

 procedure TRxNotifierForm.CreateCloseButton;
 begin
  begin
-    FCloseButton:=TButton.Create(Self);
+{    FCloseButton:=TButton.Create(Self);
    FCloseButton.Parent:=Self;
    FCloseButton.Caption:=sClose;
    FCloseButton.AutoSize:=true;
@ -170,7 +172,7 @@ begin
    FCloseButton.AnchorSideRight.Side:=asrRight;
    FCloseButton.AnchorSideTop.Control:=Self;

-    FCloseButton.OnClick:=@ButtonCloseClick;
+    FCloseButton.OnClick:=@ButtonCloseClick; }
  end;
 end;

@ -213,11 +215,24 @@ begin
  Close;
 end;

+procedure TRxNotifierForm.DoShowWindow;
+begin
+  if (ActiveControl = nil) and (not (csDesigning in ComponentState)) and (Parent=nil) then
+  begin
+    // automatically choose a control to focus
+    {$IFDEF VerboseFocus}
+    DebugLn('THintWindow.WMShowWindow ',DbgSName(Self),' Set ActiveControl := ',DbgSName(FindDefaultForActiveControl));
+    {$ENDIF}
+    ActiveControl := FindNextControl(nil, True, True, False); //FindDefaultForActiveControl;
+  end;
+end;
+
 constructor TRxNotifierForm.CreateNotifierForm(AOwnerItem: TRxPopupNotifierItem
  );
 begin
  inherited CreateNew(Application);
  FOwnerItem:=AOwnerItem;
+  fCompStyle := csHintWindow;
 end;

 { TNotifierCollection }
@ -308,8 +323,11 @@ begin
 end;

 procedure TRxPopupNotifierItem.CreateNotifierForm;
+var
+  FSaveActiveForm: TForm;
 begin
  if Assigned(FNotifyForm) then exit;
+  FSaveActiveForm:=Screen.ActiveForm;
  FNotifyForm:=TRxNotifierForm.CreateNotifierForm(Self);
  FNotifyForm.Width:=TRxPopupNotifier(Collection.Owner).NotifierFormWidth;
  FNotifyForm.Height:=1;
@ -355,6 +373,9 @@ begin

  FNotifyForm.OnClose:=@OnNotifyFormClose;
  FNotifyForm.Show;
+
+  if Assigned(FSaveActiveForm) then
+    FSaveActiveForm.BringToFront;
 end;

 procedure TRxPopupNotifierItem.UpdateFormSizes(var ATop: integer);