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
This commit is contained in:
alexs75
2018-04-24 13:27:14 +00:00
parent 75e57b190f
commit 0f98655a07
7 changed files with 338 additions and 5 deletions

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -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>

View File

@ -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.

View File

@ -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

View File

@ -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.

View File

@ -92,10 +92,15 @@ procedure RxDefaultWriteLog( ALogType:TEventType; const ALogMessage:string);
function RxDefaultLogFileName:string; function RxDefaultLogFileName:string;
procedure InitRxLogs; procedure InitRxLogs;
function RxGetKeyboardLayoutName:string;
implementation implementation
uses uses
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
windirs, Windows, windirs,
{$ENDIF}
{$IFDEF LINUX}
X, XKB, xkblib, xlib,
{$ENDIF} {$ENDIF}
Registry, Forms, FileUtil, LazUTF8, LazFileUtils, Dialogs; Registry, Forms, FileUtil, LazUTF8, LazFileUtils, Dialogs;
@ -195,6 +200,88 @@ begin
OnRxLoggerEvent:=@RxDefaultWriteLog; OnRxLoggerEvent:=@RxDefaultWriteLog;
end; 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; function GetDefaultSection(Component: TComponent): string;
var var

View File

@ -48,7 +48,7 @@ type
{ TRxNotifierForm } { TRxNotifierForm }
TRxNotifierForm = class(TForm) TRxNotifierForm = class(THintWindow)
private private
FCloseButton:TButton; FCloseButton:TButton;
FCaptionLabel:TLabel; FCaptionLabel:TLabel;
@ -60,6 +60,8 @@ type
procedure CreateMessage(AMessage:string); procedure CreateMessage(AMessage:string);
procedure CreateTimerLabel; procedure CreateTimerLabel;
procedure ButtonCloseClick(Sender: TObject); procedure ButtonCloseClick(Sender: TObject);
protected
procedure DoShowWindow; override;
public public
constructor CreateNotifierForm(AOwnerItem:TRxPopupNotifierItem); constructor CreateNotifierForm(AOwnerItem:TRxPopupNotifierItem);
end; end;
@ -152,14 +154,14 @@ type
end; end;
implementation implementation
uses rxconst; uses rxconst, LCLType;
{ TRxNotifierForm } { TRxNotifierForm }
procedure TRxNotifierForm.CreateCloseButton; procedure TRxNotifierForm.CreateCloseButton;
begin begin
begin begin
FCloseButton:=TButton.Create(Self); { FCloseButton:=TButton.Create(Self);
FCloseButton.Parent:=Self; FCloseButton.Parent:=Self;
FCloseButton.Caption:=sClose; FCloseButton.Caption:=sClose;
FCloseButton.AutoSize:=true; FCloseButton.AutoSize:=true;
@ -170,7 +172,7 @@ begin
FCloseButton.AnchorSideRight.Side:=asrRight; FCloseButton.AnchorSideRight.Side:=asrRight;
FCloseButton.AnchorSideTop.Control:=Self; FCloseButton.AnchorSideTop.Control:=Self;
FCloseButton.OnClick:=@ButtonCloseClick; FCloseButton.OnClick:=@ButtonCloseClick; }
end; end;
end; end;
@ -213,11 +215,24 @@ begin
Close; Close;
end; 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 constructor TRxNotifierForm.CreateNotifierForm(AOwnerItem: TRxPopupNotifierItem
); );
begin begin
inherited CreateNew(Application); inherited CreateNew(Application);
FOwnerItem:=AOwnerItem; FOwnerItem:=AOwnerItem;
fCompStyle := csHintWindow;
end; end;
{ TNotifierCollection } { TNotifierCollection }
@ -308,8 +323,11 @@ begin
end; end;
procedure TRxPopupNotifierItem.CreateNotifierForm; procedure TRxPopupNotifierItem.CreateNotifierForm;
var
FSaveActiveForm: TForm;
begin begin
if Assigned(FNotifyForm) then exit; if Assigned(FNotifyForm) then exit;
FSaveActiveForm:=Screen.ActiveForm;
FNotifyForm:=TRxNotifierForm.CreateNotifierForm(Self); FNotifyForm:=TRxNotifierForm.CreateNotifierForm(Self);
FNotifyForm.Width:=TRxPopupNotifier(Collection.Owner).NotifierFormWidth; FNotifyForm.Width:=TRxPopupNotifier(Collection.Owner).NotifierFormWidth;
FNotifyForm.Height:=1; FNotifyForm.Height:=1;
@ -355,6 +373,9 @@ begin
FNotifyForm.OnClose:=@OnNotifyFormClose; FNotifyForm.OnClose:=@OnNotifyFormClose;
FNotifyForm.Show; FNotifyForm.Show;
if Assigned(FSaveActiveForm) then
FSaveActiveForm.BringToFront;
end; end;
procedure TRxPopupNotifierItem.UpdateFormSizes(var ATop: integer); procedure TRxPopupNotifierItem.UpdateFormSizes(var ATop: integer);