mirror of
https://github.com/keymanapp/keyman.git
synced 2026-08-10 02:45:32 +00:00
381 lines
10 KiB
ObjectPascal
381 lines
10 KiB
ObjectPascal
(*
|
|
Name: UfrmSelectSystemKeyboard
|
|
Copyright: Copyright (C) SIL International.
|
|
Documentation:
|
|
Description:
|
|
Create Date: 1 Aug 2006
|
|
|
|
Modified Date: 1 Dec 2012
|
|
Authors: mcdurdin
|
|
Related Files:
|
|
Dependencies:
|
|
|
|
Bugs:
|
|
Todo:
|
|
Notes:
|
|
History: 14 Sep 2006 - mcdurdin - Fill a combo box list of system keyboards
|
|
19 Nov 2007 - mcdurdin - I1157 - const string parameters
|
|
03 May 2011 - mcdurdin - I2890 - Record diagnostic data when encountering registry errors
|
|
18 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support
|
|
01 Dec 2012 - mcdurdin - I3613 - V9.0 - System shadow keyboards obsolete, strip out remaining code
|
|
*)
|
|
unit UfrmSelectSystemKeyboard; // I3306
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
|
StdCtrls, Grids, ExtCtrls, UfrmTike;
|
|
|
|
type
|
|
TSystemKeyboardItem = class
|
|
LayoutText: string;
|
|
LayoutFile: string;
|
|
KeyboardID: string;
|
|
Installed: Boolean;
|
|
end;
|
|
|
|
TfrmSelectSystemKeyboard = class(TTIKEForm)
|
|
cmdOK: TButton;
|
|
gridKeyboards: TStringGrid;
|
|
Label1: TLabel;
|
|
cmdCancel: TButton;
|
|
tmrResetLookup: TTimer;
|
|
lblKeyboardNotInstalled: TLabel;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure gridKeyboardsKeyPress(Sender: TObject; var Key: Char);
|
|
procedure tmrResetLookupTimer(Sender: TObject);
|
|
procedure gridKeyboardsClick(Sender: TObject);
|
|
procedure gridKeyboardsDrawCell(Sender: TObject; ACol, ARow: Integer;
|
|
Rect: TRect; State: TGridDrawState);
|
|
procedure gridKeyboardsDblClick(Sender: TObject);
|
|
private
|
|
FLookupText: string;
|
|
function GetSystemKeyboardName: string;
|
|
procedure SetSystemKeyboardName(Value: string);
|
|
procedure InvalidateCell(ACol, ARow: Integer);
|
|
protected
|
|
function GetHelpTopic: string; override;
|
|
public
|
|
{ Public declarations }
|
|
property SystemKeyboardName: string read GetSystemKeyboardName write SetSystemKeyboardName;
|
|
end;
|
|
|
|
function SelectSystemKeyboard(FOwner: TComponent; var FKeyboardName: string): Boolean;
|
|
|
|
function LoadSystemKeyboard(var FLoadedSystemKeyboard: Boolean; FKeyboardName: string): HKL;
|
|
|
|
procedure ClearSystemKeyboardList(keyboardlist: TStrings);
|
|
procedure FillSystemKeyboardList(keyboardlist: TStrings);
|
|
function GetSystemKeyboardIndex(keyboardlist: TStrings; id: string): Integer;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Keyman.Developer.System.HelpTopics,
|
|
|
|
ErrorControlledRegistry,
|
|
RegistryKeys,
|
|
utilstr;
|
|
|
|
{$R *.DFM}
|
|
|
|
function SelectSystemKeyboard(FOwner: TComponent; var FKeyboardName: string): Boolean;
|
|
begin
|
|
Result := False;
|
|
|
|
with TfrmSelectSystemKeyboard.Create(FOwner) do
|
|
try
|
|
SystemKeyboardName := FKeyboardName;
|
|
if ShowModal = mrOk then
|
|
begin
|
|
if SystemKeyboardName = FKeyboardName then Exit;
|
|
|
|
FKeyboardName := SystemKeyboardName;
|
|
|
|
Result := True;
|
|
end;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TfrmSelectSystemKeyboard.FormCreate(Sender: TObject);
|
|
var
|
|
str: TStringList;
|
|
i: Integer;
|
|
syspath, s: string;
|
|
buf: array[0..260] of Char;
|
|
begin
|
|
inherited;
|
|
gridKeyboards.DefaultRowHeight := 16 * PixelsPerInch div 96;
|
|
GetSystemDirectory(buf, 260);
|
|
syspath := IncludeTrailingPathDelimiter(buf);
|
|
str := TStringList.Create;
|
|
with TRegistryErrorControlled.Create do // I2890
|
|
try
|
|
RootKey := HKEY_LOCAL_MACHINE;
|
|
if OpenKeyReadOnly(SRegKey_KeyboardLayouts_LM) then
|
|
begin
|
|
GetKeyNames(str);
|
|
|
|
for i := str.Count - 1 downto 0 do
|
|
if OpenKeyReadOnly('\'+SRegKey_KeyboardLayouts_LM + '\' + str[i]) then
|
|
if not ValueExists('Layout Text') then // I3613
|
|
str.Delete(i)
|
|
else
|
|
begin
|
|
s := ReadString('Layout File');
|
|
if not FileExists(syspath+s)
|
|
then str[i] := ReadString('Layout Text') + '|' + s + '|' + str[i] + '|0'
|
|
else str[i] := ReadString('Layout Text') + '|' + s + '|' + str[i] + '|1';
|
|
end;
|
|
|
|
str.Sort;
|
|
gridKeyboards.RowCount := str.Count + 1;
|
|
for i := 0 to str.Count - 1 do
|
|
begin
|
|
s := str[i];
|
|
gridKeyboards.Cells[0, i+1] := StrToken(s, '|');
|
|
gridKeyboards.Cells[1, i+1] := StrToken(s, '|');
|
|
gridKeyboards.Cells[2, i+1] := StrToken(s, '|');
|
|
gridKeyboards.Cells[3, i+1] := StrToken(s, '|');
|
|
end;
|
|
end;
|
|
|
|
gridKeyboards.Cells[0, 0] := 'Name';
|
|
gridKeyboards.Cells[1, 0] := 'Layout';
|
|
gridKeyboards.Cells[2, 0] := 'ID';
|
|
gridKeyboards.ColWidths[3] := 0;
|
|
gridKeyboards.ColWidths[1] := 100 * PixelsPerInch div 96;
|
|
gridKeyboards.ColWidths[2] := 80 * PixelsPerInch div 96;
|
|
gridKeyboards.ColWidths[0] := gridKeyboards.ClientWidth - (100 * PixelsPerInch div 96) -
|
|
(80 * PixelsPerInch div 96) - 2;
|
|
finally
|
|
str.Free;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
function TfrmSelectSystemKeyboard.GetHelpTopic: string;
|
|
begin
|
|
Result := SHelpTopic_Context_SelectSystemKeyboard;
|
|
end;
|
|
|
|
function TfrmSelectSystemKeyboard.GetSystemKeyboardName: string;
|
|
begin
|
|
Result := gridKeyboards.Cells[2, gridKeyboards.Row];
|
|
end;
|
|
|
|
procedure TfrmSelectSystemKeyboard.SetSystemKeyboardName(Value: string);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 1 to gridKeyboards.RowCount - 1 do
|
|
if gridKeyboards.Cells[2, i] = Value then
|
|
begin
|
|
gridKeyboards.Row := i;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSelectSystemKeyboard.gridKeyboardsKeyPress(Sender: TObject; var Key: Char);
|
|
var
|
|
i, n: Integer;
|
|
begin
|
|
tmrResetLookup.Enabled := False;
|
|
if Key = #8 then
|
|
begin
|
|
if FLookupText <> '' then Delete(FLookupText, 1, 1);
|
|
n := Length(FLookupText);
|
|
for i := 1 to gridKeyboards.RowCount - 1 do
|
|
if Copy(gridKeyboards.Cells[0, i], 1, n) = FLookupText then
|
|
begin
|
|
gridKeyboards.Row := i;
|
|
tmrResetLookup.Enabled := True;
|
|
Exit;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
n := Length(FLookupText) + 1;
|
|
for i := 1 to gridKeyboards.RowCount - 1 do
|
|
if UpperCase(Copy(gridKeyboards.Cells[0, i], 1, n)) = FLookupText + UpCase(Key) then
|
|
begin
|
|
FLookupText := FLookupText + UpCase(Key);
|
|
gridKeyboards.Row := i;
|
|
InvalidateCell(0, gridKeyboards.Row);
|
|
gridKeyboards.Update;
|
|
tmrResetLookup.Enabled := True;
|
|
Exit;
|
|
end;
|
|
end;
|
|
tmrResetLookup.Enabled := True;
|
|
end;
|
|
|
|
procedure TfrmSelectSystemKeyboard.tmrResetLookupTimer(Sender: TObject);
|
|
begin
|
|
FLookupText := '';
|
|
tmrResetLookup.Enabled := False;
|
|
InvalidateCell(0, gridKeyboards.Row);
|
|
gridKeyboards.Update;
|
|
end;
|
|
|
|
procedure TfrmSelectSystemKeyboard.gridKeyboardsClick(Sender: TObject);
|
|
begin
|
|
cmdOK.Enabled := gridKeyboards.Cells[3, gridKeyboards.Row] = '1';
|
|
lblKeyboardNotInstalled.Visible := not cmdOK.Enabled;
|
|
end;
|
|
|
|
procedure TfrmSelectSystemKeyboard.gridKeyboardsDrawCell(Sender: TObject;
|
|
ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
|
|
var
|
|
w: Integer;
|
|
begin
|
|
with gridKeyboards.Canvas do
|
|
begin
|
|
Font := gridKeyboards.Font;
|
|
if gdFixed in State then
|
|
begin
|
|
Brush.Color := clBtnFace;
|
|
Font.Color := clBtnText;
|
|
end
|
|
else if gdSelected in State then
|
|
begin
|
|
Brush.Color := clHighlight;
|
|
Font.Color := clHighlightText;
|
|
end
|
|
else
|
|
begin
|
|
Brush.Color := clWindow;
|
|
Font.Color := clWindowText;
|
|
end;
|
|
|
|
if gridKeyboards.Cells[3, ARow] = '0' then Font.Color := clGrayText;
|
|
|
|
Brush.Style := bsSolid;
|
|
FillRect(Rect);
|
|
TextRect(Rect, Rect.Left+2, Rect.Top+2, gridKeyboards.Cells[ACol, ARow]);
|
|
if (FLookupText <> '') and (gdSelected in State) and (ACol = 0) then
|
|
begin
|
|
w := TextWidth(Copy(gridKeyboards.Cells[ACol, ARow], 1, Length(FLookupText)));
|
|
Pen.Color := clBlack;
|
|
Pen.Width := 2;
|
|
MoveTo(w+2, Rect.Top);
|
|
LineTo(w+2, Rect.Bottom-1);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmSelectSystemKeyboard.InvalidateCell(ACol, ARow: Integer);
|
|
var
|
|
r: TRect;
|
|
begin
|
|
r := gridKeyboards.CellRect(ACol, ARow);
|
|
InvalidateRect(gridKeyboards.Handle, @r, False);
|
|
end;
|
|
|
|
procedure TfrmSelectSystemKeyboard.gridKeyboardsDblClick(Sender: TObject);
|
|
begin
|
|
if cmdOK.Enabled then ModalResult := mrOk;
|
|
end;
|
|
|
|
procedure ClearSystemKeyboardList(keyboardlist: TStrings);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to keyboardlist.Count - 1 do
|
|
keyboardlist.Objects[i].Free;
|
|
keyboardlist.Clear;
|
|
end;
|
|
|
|
procedure FillSystemKeyboardList(keyboardlist: TStrings);
|
|
var
|
|
buf: array[0..260] of char;
|
|
syspath: string;
|
|
str: TStringList;
|
|
i: Integer;
|
|
k: TSystemKeyboardItem;
|
|
begin
|
|
keyboardlist.BeginUpdate;
|
|
ClearSystemKeyboardList(keyboardlist);
|
|
|
|
GetSystemDirectory(buf, 260);
|
|
syspath := IncludeTrailingPathDelimiter(buf);
|
|
|
|
str := TStringList.Create;
|
|
with TRegistryErrorControlled.Create do // I2890
|
|
try
|
|
RootKey := HKEY_LOCAL_MACHINE;
|
|
if OpenKeyReadOnly(SRegKey_KeyboardLayouts_LM) then
|
|
begin
|
|
GetKeyNames(str);
|
|
|
|
for i := str.Count - 1 downto 0 do
|
|
if OpenKeyReadOnly('\'+SRegKey_KeyboardLayouts_LM + '\' + str[i]) then
|
|
if not ValueExists('Layout Text') then // I3613
|
|
str.Delete(i)
|
|
else
|
|
begin
|
|
k := TSystemKeyboardItem.Create;
|
|
k.LayoutText := ReadString('Layout Text');
|
|
k.LayoutFile := ReadString('Layout File');
|
|
k.Installed := FileExists(syspath+k.LayoutFile);
|
|
k.KeyboardID := str[i];
|
|
keyboardlist.AddObject(k.LayoutText + ' ('+k.LayoutFile+')', k);
|
|
end;
|
|
|
|
str.Assign(keyboardlist);
|
|
str.Sort;
|
|
keyboardlist.Assign(str);
|
|
end;
|
|
|
|
finally
|
|
str.Free;
|
|
Free;
|
|
end;
|
|
keyboardlist.EndUpdate;
|
|
end;
|
|
|
|
function LoadSystemKeyboard(var FLoadedSystemKeyboard: Boolean; FKeyboardName: string): HKL;
|
|
type
|
|
PHKL = ^HKL;
|
|
var
|
|
h: HKL;
|
|
hq, hp: PHKL;
|
|
i, n: Integer;
|
|
begin
|
|
{ Load the layout (if not already loaded) and determine if it should be unloaded again }
|
|
n := GetKeyboardLayoutList(0, hp);
|
|
hp := PHKL(AllocMem(n * sizeof(HKL)));
|
|
try
|
|
GetKeyboardLayoutList(n, hp^);
|
|
h := LoadKeyboardLayout(PChar(FKeyboardName), 0);
|
|
hq := hp;
|
|
FLoadedSystemKeyboard := True;
|
|
for i := 0 to n - 1 do
|
|
if hq^ = h
|
|
then begin FLoadedSystemKeyboard := False; Break; end
|
|
else Inc(hq);
|
|
finally
|
|
FreeMem(hp);
|
|
end;
|
|
Result := h;
|
|
end;
|
|
|
|
function GetSystemKeyboardIndex(keyboardlist: TStrings; id: string): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to keyboardlist.Count - 1 do
|
|
if (keyboardlist.Objects[i] is TSystemKeyboardItem) and (TSystemKeyboardItem(keyboardlist.Objects[i]).KeyboardID = id) then
|
|
begin
|
|
Result := i;
|
|
Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
end.
|
|
|