erabo/spiegel-keyman
1
0
Fork 0
mirror of https://github.com/keymanapp/keyman.git synced 2026-08-05 08:25:32 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions 8
spiegel-keyman/common/windows/delphi/visualkeyboard/VisualKeyboard.pas

582 lines
17 KiB
ObjectPascal
Raw Permalink Blame History

(*
Name: VisualKeyboard
Copyright: Copyright (C) SIL International.
Documentation:
Description:
Create Date: 23 Aug 2006
Modified Date: 8 Jun 2012
Authors: mcdurdin
Related Files:
Dependencies:
Bugs:
Todo:
Notes:
History: 23 Aug 2006 - mcdurdin - Add ExtShiftStateToVkShiftState function
19 Mar 2007 - mcdurdin - I699 - Fix crash when exporting on screen keyboard with some shift states
19 Nov 2007 - mcdurdin - I1157 - const string parameters
16 Jan 2009 - mcdurdin - Widestring filenames
06 Apr 2010 - mcdurdin - I2200 - Mnemonic layout and OSK
18 May 2012 - mcdurdin - I3306 - V9.0 - Remove TntControls + Win9x support
08 Jun 2012 - mcdurdin - I3310 - V9.0 - Unicode in Delphi fixes
*)
unit VisualKeyboard; // I3306
interface
uses
Windows,
Contnrs,
Graphics,
SysUtils,
Classes,
ExtShiftState;
const
KVKS_NORMAL = 0;
KVKS_SHIFT = 1;
KVKS_CTRL = 2;
KVKS_ALT = 4;
KVKS_LCTRL = 8;
KVKS_RCTRL = 16;
KVKS_LALT = 32;
KVKS_RALT = 64;
function ExtShiftStateToVkShiftState(ShiftState: TExtShiftState): WORD;
function VkShiftStateToKmxShiftState(ShiftState: WORD): WORD;
type
TVisualKeyboardKeyFlags = set of (kvkkBitmap, kvkkUnicode); // if not set, is kvkkText, kvkkANSI resp.
TVisualKeyboardHeaderFlags = set of (kvkh102, kvkhDisplayUnderlying, kvkhUseUnderlying, kvkhAltGr);
TVisualKeyboardSaverFormat = (kvksfBinary, kvksfXML);
TVisualKeyboardKey = class
private
FBitmap: TBitmap;
FFlags: TVisualKeyboardKeyFlags;
FShift: Word;
FText: WideString;
FVKey: Word;
procedure SetBitmap(const Value: TBitmap);
function GetVKeyCap: WideChar;
public
destructor Destroy; override;
function HasShift(s: Word): Boolean;
property Flags: TVisualKeyboardKeyFlags read FFlags write FFlags;
property VKey: Word read FVKey write FVKey;
property VKeyCap: WideChar read GetVKeyCap;
property Shift: Word read FShift write FShift;
property Text: WideString read FText write FText;
property Bitmap: TBitmap read FBitmap write SetBitmap;
end;
TVisualKeyboardKeyList = class(TObjectList)
protected
function Get(Index: Integer): TVisualKeyboardKey;
procedure Put(Index: Integer; Item: TVisualKeyboardKey);
public
property Items[Index: Integer]: TVisualKeyboardKey read Get write Put; default;
function IndexOf(VK, Shift: Word): Integer;
function Add(Item: TVisualKeyboardKey): Integer;
procedure Sort;
end;
TVisualKeyboardHeader = class
private
FAssociatedKeyboard: string;
FANSIFont: TFont;
FUnicodeFont: TFont;
FFlags: TVisualKeyboardHeaderFlags;
FUnderlyingLayout: string;
procedure SetANSIFont(const Value: TFont);
procedure SetUnicodeFont(const Value: TFont);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
property Flags: TVisualKeyboardHeaderFlags read FFlags write FFlags;
property ANSIFont: TFont read FANSIFont write SetANSIFont;
property UnicodeFont: TFont read FUnicodeFont write SetUnicodeFont;
property AssociatedKeyboard: string read FAssociatedKeyboard write FAssociatedKeyboard;
property UnderlyingLayout: string read FUnderlyingLayout write FUnderlyingLayout;
end;
TVisualKeyboard = class
private
FHeader: TVisualKeyboardHeader;
FKeys: TVisualKeyboardKeyList;
FLoadedFileFormat: TVisualKeyboardSaverFormat;
public
constructor Create;
destructor Destroy; override;
procedure SaveToFile(FFileName: WideString; Format: TVisualKeyboardSaverFormat);
procedure LoadFromFile(FFileName: WideString);
procedure SaveToStream(Stream: TStream; Format: TVisualKeyboardSaverFormat);
procedure LoadFromStream(Stream: TStream);
class function IsBinaryFile(Stream: TStream): Boolean; static;
procedure Clear;
function HasShiftState(Shift: Integer): Boolean;
property Header: TVisualKeyboardHeader read FHeader;
property Keys: TVisualKeyboardKeyList read FKeys;
property LoadedFileFormat: TVisualKeyboardSaverFormat read FLoadedFileFormat;
end;
{ Visual keyboard load/save routines -- round trippable, single file }
TVisualKeyboardLoader = class
protected
FKbd: TVisualKeyboard;
public
procedure LoadFromStream(Stream: TStream); virtual; abstract;
procedure LoadFromFile(const Filename: string);
constructor Create(AKbd: TVisualKeyboard); virtual;
end;
TVisualKeyboardSaver = class
protected
FKbd: TVisualKeyboard;
public
procedure SaveToStream(Stream: TStream); virtual; abstract;
procedure SaveToFile(const Filename: string);
constructor Create(AKbd: TVisualKeyboard); virtual;
end;
{ Importing and Exporting abstract classes -- file dependencies, non round-trippable }
TVisualKeyboardImport = class
protected
FKbd: TVisualKeyboard;
public
procedure ImportFromFile(FileName: WideString); virtual; abstract;
constructor Create(AKbd: TVisualKeyboard); virtual;
end;
TVisualKeyboardExport = class
protected
FKbd: TVisualKeyboard;
public
procedure ExportToFile(FileName: WideString); virtual; abstract;
constructor Create(AKbd: TVisualKeyboard); virtual;
end;
TVisualKeyboardExportClass = class of TVisualKeyboardExport;
EVisualKeyboardLoader = class(Exception);
EVisualKeyboardExport = class(Exception);
type
TVKLegalShiftState = record
Desc, Name: string;
Shift: Integer;
VKeys: array[0..2] of Word;
end;
const
MaxLegalShiftStates = 24;
VKLegalShiftStates: array[0..MaxLegalShiftStates-1] of TVKLegalShiftState = (
(Desc: 'Unshifted'; Name: ''; Shift: KVKS_NORMAL; VKeys: (0,0,0)), //1
(Desc: 'Shift'; Name: 'S'; Shift: KVKS_SHIFT; VKeys: (VK_SHIFT,0,0)),
(Desc: 'Ctrl'; Name: 'C'; Shift: KVKS_CTRL; VKeys: (VK_CONTROL,0,0)),
(Desc: 'Alt'; Name: 'A'; Shift: KVKS_ALT; VKeys: (VK_MENU,0,0)),
(Desc: 'Shift+Ctrl'; Name: 'SC'; Shift: KVKS_SHIFT or KVKS_CTRL; VKeys: (VK_SHIFT,VK_CONTROL,0)),
(Desc: 'Shift+Alt'; Name: 'SA'; Shift: KVKS_SHIFT or KVKS_ALT; VKeys: (VK_SHIFT,VK_MENU,0)),
(Desc: 'Ctrl+Alt'; Name: 'CA'; Shift: KVKS_CTRL or KVKS_ALT; VKeys: (VK_CONTROL,VK_MENU,0)),
(Desc: 'Shift+Ctrl+Alt'; Name: 'SCA'; Shift: KVKS_SHIFT or KVKS_CTRL or KVKS_ALT; VKeys: (VK_SHIFT,VK_CONTROL,VK_MENU)), //7
(Desc: 'Left Ctrl'; Name: 'LC'; Shift: KVKS_LCTRL; VKeys: (0,0,0)),
(Desc: 'Right Ctrl'; Name: 'RC'; Shift: KVKS_RCTRL; VKeys: (0,0,0)),
(Desc: 'Left Alt'; Name: 'LA'; Shift: KVKS_LALT; VKeys: (0,0,0)),
(Desc: 'Right Alt'; Name: 'RA'; Shift: KVKS_RALT; VKeys: (0,0,0)),
(Desc: 'Shift+Left Ctrl'; Name: 'SLC'; Shift: KVKS_SHIFT or KVKS_LCTRL; VKeys: (0,0,0)),
(Desc: 'Shift+Right Ctrl'; Name: 'SRC'; Shift: KVKS_SHIFT or KVKS_RCTRL; VKeys: (0,0,0)),
(Desc: 'Shift+Left Alt'; Name: 'SLA'; Shift: KVKS_SHIFT or KVKS_LALT; VKeys: (0,0,0)),
(Desc: 'Shift+Right Alt'; Name: 'SRA'; Shift: KVKS_SHIFT or KVKS_RALT; VKeys: (0,0,0)),
(Desc: 'Left Ctrl+Left Alt'; Name: 'LCLA'; Shift: KVKS_LCTRL or KVKS_LALT; VKeys: (0,0,0)),
(Desc: 'Left Ctrl+Right Alt'; Name: 'LCRA'; Shift: KVKS_LCTRL or KVKS_RALT; VKeys: (0,0,0)),
(Desc: 'Right Ctrl+Left Alt'; Name: 'RCLA'; Shift: KVKS_RCTRL or KVKS_LALT; VKeys: (0,0,0)),
(Desc: 'Right Ctrl+Right Alt'; Name: 'RCRA'; Shift: KVKS_RCTRL or KVKS_RALT; VKeys: (0,0,0)),
(Desc: 'Shift+Left Ctrl+Left Alt'; Name: 'SLCLA'; Shift: KVKS_SHIFT or KVKS_LCTRL or KVKS_LALT; VKeys: (0,0,0)),
(Desc: 'Shift+Left Ctrl+Right Alt'; Name: 'SLCRA'; Shift: KVKS_SHIFT or KVKS_LCTRL or KVKS_RALT; VKeys: (0,0,0)),
(Desc: 'Shift+Right Ctrl+Left Alt'; Name: 'SRCLA'; Shift: KVKS_SHIFT or KVKS_RCTRL or KVKS_LALT; VKeys: (0,0,0)),
(Desc: 'Shift+Right Ctrl+Right Alt'; Name: 'SRCRA'; Shift: KVKS_SHIFT or KVKS_RCTRL or KVKS_RALT; VKeys: (0,0,0)) ); //16
function GetVKLegalShiftStateIndex(Shift: Integer): Integer;
implementation
uses
kmxfileconsts,
VisualKeyboardLoaderBinary,
VisualKeyboardLoaderXML,
VisualKeyboardSaverBinary,
VisualKeyboardSaverXML,
VKeyChars;
const
VKLegalShiftStateIndex: array[0..127] of Integer =
(0, 1, 2, 4, 3, 5, 6, 7, 8, 12, -1, -1, -1, -1, -1, -1, 9, 13,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 10, 14,
-1, -1, -1, -1, -1, -1, 16, 20, -1, -1, -1, -1, -1, -1, 18, 22,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 11, 15,
-1, -1, -1, -1, -1, -1, 17, 21, -1, -1, -1, -1, -1, -1, 19, 23,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1,
-1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1);
function GetVKLegalShiftStateIndex(Shift: Integer): Integer;
begin
if (Shift < 0) or (Shift > 127) then Result := -1
else Result := VKLegalShiftStateIndex[Shift];
end;
{-------------------------------------------------------------------------------
- TVisualKeyboard -
------------------------------------------------------------------------------}
procedure TVisualKeyboard.Clear;
begin
FHeader.Clear;
FKeys.Clear;
end;
constructor TVisualKeyboard.Create;
begin
inherited Create;
FHeader := TVisualKeyboardHeader.Create;
FKeys := TVisualKeyboardKeyList.Create;
end;
destructor TVisualKeyboard.Destroy;
begin
FHeader.Free;
FKeys.Free;
inherited;
end;
function TVisualKeyboard.HasShiftState(Shift: Integer): Boolean;
var
i: Integer;
begin
for i := 0 to Keys.Count - 1 do
begin
if (Keys[i].Shift = Shift) and (kvkkUnicode in Keys[i].Flags) then
begin
if (Keys[i].Text <> '') or Assigned(Keys[i].Bitmap) then
Exit(True);
end;
end;
Result := False;
end;
procedure TVisualKeyboard.LoadFromFile(FFileName: WideString);
var
fs: TFileStream;
begin
fs := TFileStream.Create(FFileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(fs);
finally
fs.Free;
end;
end;
class function TVisualKeyboard.IsBinaryFile(Stream: TStream): Boolean;
var
ch: array[0..4] of ansichar; // I3310
begin
stream.Position := 0;
stream.Read(ch, 4); ch[4] := #0;
stream.Position := 0;
Result := ch = 'KVKF';
end;
procedure TVisualKeyboard.LoadFromStream(Stream: TStream);
begin
try
Clear;
if not IsBinaryFile(Stream) then
begin
FLoadedFileFormat := kvksfXML;
// We'll attempt to load this as a v10 KVK XML
with TVisualKeyboardLoaderXML.Create(Self) do
try
LoadFromStream(stream);
finally
Free;
end;
end
else
begin
FLoadedFileFormat := kvksfBinary;
with TVisualKeyboardLoaderBinary.Create(Self) do
try
LoadFromStream(stream);
finally
Free;
end;
end;
except
on E:Exception do
raise EVisualKeyboardLoaderBinary.Create(E.Message);
end;
end;
procedure TVisualKeyboard.SaveToFile(FFileName: WideString; Format: TVisualKeyboardSaverFormat);
begin
if Format = kvksfBinary then
with TVisualKeyboardSaverBinary.Create(Self) do
try
SaveToFile(FFilename);
finally
Free;
end
else
with TVisualKeyboardSaverXML.Create(Self) do
try
SaveToFile(FFilename);
finally
Free;
end;
end;
procedure TVisualKeyboard.SaveToStream(Stream: TStream; Format: TVisualKeyboardSaverFormat);
begin
if Format = kvksfBinary then
with TVisualKeyboardSaverBinary.Create(Self) do
try
SaveToStream(Stream);
finally
Free;
end
else
with TVisualKeyboardSaverXML.Create(Self) do
try
SaveToStream(Stream);
finally
Free;
end;
end;
{-------------------------------------------------------------------------------
- TVisualKeyboardHeader -
------------------------------------------------------------------------------}
constructor TVisualKeyboardHeader.Create;
begin
inherited Create;
FANSIFont := TFont.Create;
FUnicodeFont := TFont.Create;
Clear;
end;
procedure TVisualKeyboardHeader.Clear;
begin
FANSIFont.Name := 'Arial';
FANSIFont.Size := -12;
FUnicodeFont.Assign(FANSIFont);
FFlags := [];
FAssociatedKeyboard := '';
FUnderlyingLayout := '';
end;
destructor TVisualKeyboardHeader.Destroy;
begin
FANSIFont.Free;
FUnicodeFont.Free;
inherited;
end;
procedure TVisualKeyboardHeader.SetANSIFont(const Value: TFont);
begin
FANSIFont.Assign(Value);
end;
procedure TVisualKeyboardHeader.SetUnicodeFont(const Value: TFont);
begin
FUnicodeFont.Assign(Value);
end;
{-------------------------------------------------------------------------------
- TVisualKeyboardKey -
------------------------------------------------------------------------------}
destructor TVisualKeyboardKey.Destroy;
begin
FBitmap.Free;
inherited;
end;
function TVisualKeyboardKey.GetVKeyCap: WideChar;
begin
{ Lookup USVKeyCap from VKey+Shift }
if ((FShift = 0) or (FShift = KVKS_SHIFT)) and (FVKey <= 255)
then Result := SUSVkeyChars[FShift,FVKey]
else Result := #0;
end;
function TVisualKeyboardKey.HasShift(s: Word): Boolean;
begin
Result := (FShift and s) <> 0;
end;
procedure TVisualKeyboardKey.SetBitmap(const Value: TBitmap);
begin
if not Assigned(Value) then
FreeAndNil(FBitmap)
else
begin
if not Assigned(FBitmap) then FBitmap := TBitmap.Create;
FBitmap.Assign(Value);
end;
end;
{-------------------------------------------------------------------------------
- TVisualKeyboardKeyList -
------------------------------------------------------------------------------}
function TVisualKeyboardKeyList.Add(Item: TVisualKeyboardKey): Integer;
begin
Result := inherited Add(Item);
end;
function TVisualKeyboardKeyList.Get(Index: Integer): TVisualKeyboardKey;
begin
Result := inherited Items[Index] as TVisualKeyboardKey;
end;
function TVisualKeyboardKeyList.IndexOf(VK, Shift: Word): Integer;
var
I: Integer;
begin
for I := 0 to Count - 1 do
if (Items[i].FVKey = VK) and (Items[i].FShift = Shift) then
begin
Result := I;
Exit;
end;
Result := -1;
end;
procedure TVisualKeyboardKeyList.Put(Index: Integer; Item: TVisualKeyboardKey);
begin
inherited Put(Index, Item);
end;
function SortVisualKeyboardKeyList(Item1, Item2: Pointer): Integer;
var
k1, k2: TVisualKeyboardKey;
begin
k1 := TVisualKeyboardKey(Item1);
k2 := TVisualKeyboardKey(Item2);
if k1.Shift = k2.Shift
then Result := k1.VKey - k2.VKey
else Result := k1.Shift - k2.Shift;
end;
procedure TVisualKeyboardKeyList.Sort;
begin
inherited Sort(@SortVisualKeyboardKeyList);
end;
{ TVisualKeyboardImport }
constructor TVisualKeyboardImport.Create(AKbd: TVisualKeyboard);
begin
inherited Create;
FKbd := AKbd;
end;
{ TVisualKeyboardExport }
constructor TVisualKeyboardExport.Create(AKbd: TVisualKeyboard);
begin
inherited Create;
FKbd := AKbd;
end;
function ExtShiftStateToVkShiftState(ShiftState: TExtShiftState): WORD;
const
//essShift, essCtrl, essAlt, essLCtrl, essRCtrl, essLAlt, essRAlt
FVKShiftValue: array[TExtShiftStateValue] of WORD = (
KVKS_SHIFT, KVKS_CTRL, KVKS_ALT, KVKS_LCTRL, KVKS_RCTRL, KVKS_LALT, KVKS_RALT);
var
i: TExtShiftStateValue;
begin
Result := 0;
for i := Low(TExtShiftStateValue) to High(TExtShiftStateValue) do
if i in ShiftState then
Result := Result or FVKShiftValue[i];
end;
{ TVisualKeyboardLoader }
constructor TVisualKeyboardLoader.Create(AKbd: TVisualKeyboard);
begin
inherited Create;
FKbd := AKbd;
end;
procedure TVisualKeyboardLoader.LoadFromFile(const Filename: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
LoadFromStream(Stream);
finally
Stream.Free;
end;
end;
{ TVisualKeyboardSaver }
constructor TVisualKeyboardSaver.Create(AKbd: TVisualKeyboard);
begin
inherited Create;
FKbd := AKbd;
end;
procedure TVisualKeyboardSaver.SaveToFile(const Filename: string);
var
Stream: TStream;
begin
Stream := TFileStream.Create(Filename, fmCreate);
try
SaveToStream(Stream);
finally
Stream.Free;
end;
end;
function VkShiftStateToKmxShiftState(ShiftState: WORD): WORD;
type
TVKToKMX = record
VK, KMX: Word;
end;
const
Map: array[0..6] of TVKToKMX = (
(VK: KVKS_SHIFT; KMX: KMX_SHIFTFLAG),
(VK: KVKS_CTRL; KMX: KMX_CTRLFLAG),
(VK: KVKS_ALT; KMX: KMX_ALTFLAG),
(VK: KVKS_LCTRL; KMX: KMX_LCTRLFLAG),
(VK: KVKS_RCTRL; KMX: KMX_RCTRLFLAG),
(VK: KVKS_LALT; KMX: KMX_LALTFLAG),
(VK: KVKS_RALT; KMX: KMX_RALTFLAG)
);
var
i: Integer;
begin
Result := 0;
for i := Low(Map) to High(Map) do
if (ShiftState and Map[i].VK) = Map[i].VK then
Result := Result or Map[i].KMX;
end;
end.
Reference in a new issue View git blame Copy permalink