spiegel-keyman/common/windows/delphi/visualkeyboard/VisualKeyboardLoaderXML.pas

unit VisualKeyboardLoaderXML;

interface

uses
  System.SysUtils,
  System.Classes,
  Xml.XMLIntf,

  VisualKeyboard;

//
// This originated with the TVisualKeyboardImportXML code but has now diverged for
// UI-clean single-file round-trippable consistency.
//

type
  EVisualKeyboardLoaderXML = class(EVisualKeyboardLoader);

  TVisualKeyboardLoaderXML = class(TVisualKeyboardLoader)
  private
    function ShiftStateStringToVKShift(s: string): Integer;
    procedure LoadEncoding(node: IXMLNode);
    procedure LoadLayer(unicode: Boolean; layer: IXMLNode);
  public
    procedure LoadFromStream(Stream: TStream); override;
  end;

implementation


uses
  System.NetEncoding,
  System.Variants,
  Vcl.Graphics,
  Xml.XMLDoc,

  KeymanVersion,
  Unicode,
  utilstr,
  utilsystem,
  VKeys;

{ TVisualKeyboardLoaderXML }

procedure TVisualKeyboardLoaderXML.LoadEncoding(node: IXMLNode);
var
  i: Integer;
  FUnicode: Boolean;
begin
  if node.HasAttribute('name') then
  begin
    if node.Attributes['name'] = 'unicode' then FUnicode := True
    else if node.Attributes['name'] = 'ansi'  then FUnicode := False
    else raise EVisualKeyboardLoaderXML.Create('Invalid encoding name '+node.Attributes['name']);
  end
  else
    FUnicode := True;

  { fonts }

  if node.HasAttribute('fontname') then
    if FUnicode
      then FKbd.Header.UnicodeFont.Name := node.Attributes['fontname']
      else FKbd.Header.ANSIFont.Name := node.Attributes['fontname'];

  try
    if node.HasAttribute('fontsize') then
      if FUnicode
        then FKbd.Header.UnicodeFont.Size := StrToInt(node.Attributes['fontsize'])
        else FKbd.Header.ANSIFont.Size := StrToInt(node.Attributes['fontsize']);
  except
    on E:EConvertError do
      raise EVisualKeyboardLoaderXML.Create('Invalid font size '+node.Attributes['fontsize']);
  end;

  for i := 0 to node.ChildNodes.Count - 1 do
  begin
    if node.ChildNodes[i].NodeName = 'layer' then
      LoadLayer(FUnicode, node.ChildNodes[i]);
  end;
end;

procedure TVisualKeyboardLoaderXML.LoadLayer(unicode: Boolean; layer: IXMLNode);
var
  shift: Integer;
  k: TVisualKeyboardKey;
  n: Word;
  b: TBitmap;
  ssBitmapIn: TStringStream;
  msBitmapOut: TMemoryStream;
  node, bitmap: IXMLNode;
begin
  if layer.HasAttribute('shift')
    then shift := ShiftStateStringToVKShift(VarToStr(layer.Attributes['shift']))
    else shift := KVKS_NORMAL;

  node := layer.ChildNodes.FindNode('key');
  while Assigned(node) do
  begin
    n := FindVKeyName(node.Attributes['vkey']);
    if n = $FFFF then
      raise EVisualKeyboardLoaderXML.Create('Invalid virtual key code: ' +
        node.Attributes['vkey']);

    k := TVisualKeyboardKey.Create;
    k.VKey := n;
    k.Shift := shift;
    if unicode then k.Flags := k.Flags + [kvkkUnicode];

    bitmap := node.ChildNodes.FindNode('bitmap');
    if Assigned(bitmap) then
    begin
      b := TBitmap.Create;
      ssBitmapIn := TStringStream.Create(VarToStr(bitmap.NodeValue));
      msBitmapOut := TMemoryStream.Create;
      try
        TNetEncoding.Base64.Decode(ssBitmapIn, msBitmapOut);
        msBitmapOut.Position := 0;
        b.LoadFromStream(msBitmapOut);
      finally
        ssBitmapIn.Free;
        msBitmapOut.Free;
      end;
      k.Bitmap := b;
      k.Flags := k.Flags + [kvkkBitmap];
    end
    else
      k.Text := VarToStr(node.NodeValue);

    FKbd.Keys.Add(k);

    node := node.NextSibling;
    while Assigned(node) and (node.NodeName <> 'key') do
      node := node.NextSibling;
  end;
end;

procedure TVisualKeyboardLoaderXML.LoadFromStream(Stream: TStream);    // I4619
var
  doc: IXMLDocument;
  header, node: IXMLNode;
  i: Integer;
  root: IXMLNode;

      function FindNode(NodeName: string; parent: IXMLNode = nil): IXMLNode;
      begin
        if parent = nil then parent := doc.DocumentElement;
        Result := parent.ChildNodes.FindNode(NodeName);
      end;
begin
  FKbd.Clear;

  doc := TXMLDocument.Create(nil);
  doc.LoadFromStream(Stream, xetUTF_8);

  header := FindNode('header');
  if not Assigned(header) then
    raise EVisualKeyboardLoaderXML.Create('Invalid kvk xml: header is missing');

  { version }
  node := FindNode('version', header);
  if not Assigned(node) or (node.NodeValue <> SKeymanVersion100) then
    raise EVisualKeyboardLoaderXML.Create('Invalid kvk xml: version value invalid (must be '+SKeymanVersion100+')');

  { kbdname }
  node := FindNode('kbdname', header);
  if Assigned(node) then
    FKbd.Header.AssociatedKeyboard := VarToStr(node.NodeValue);

  { flags }
  FKbd.Header.Flags := [];
  node := FindNode('flags', header);
  if Assigned(node) then
  begin
    if Assigned(FindNode('key102', node))            then FKbd.Header.Flags := FKbd.Header.Flags + [kvkh102];
    if Assigned(FindNode('displayunderlying', node)) then FKbd.Header.Flags := FKbd.Header.Flags + [kvkhDisplayUnderlying];
    if Assigned(FindNode('useunderlying', node))     then FKbd.Header.Flags := FKbd.Header.Flags + [kvkhUseUnderlying];
    if Assigned(FindNode('usealtgr', node))          then FKbd.Header.Flags := FKbd.Header.Flags + [kvkhAltGr];
  end;

  { layout }
  node := FindNode('layout', header);
  if Assigned(node) then
    FKbd.Header.UnderlyingLayout := VarToStr(node.NodeValue);

  { keys }

  root := doc.DocumentElement;
  for i := 0 to root.ChildNodes.Count - 1 do
    if root.ChildNodes[i].NodeName = 'encoding' then
      LoadEncoding(root.ChildNodes[i]);
end;

function TVisualKeyboardLoaderXML.ShiftStateStringToVKShift(s: string): Integer;
var
  i: Integer;
begin
  Result := 0;

  for i := 0 to High(VKLegalShiftStates) do  // I3099
    if SameText(VKLegalShiftStates[i].Name, s) then
    begin
      Result := VKLegalShiftStates[i].Shift;
      Exit;
    end;
end;

end.