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.