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

113 lines
2.7 KiB
ObjectPascal

unit VisualKeyboardSaverBinary;
interface
uses
System.Classes,
Vcl.Graphics,
Winapi.Windows,
VisualKeyboard;
type
TVisualKeyboardSaverBinary = class(TVisualKeyboardSaver)
private
procedure SaveHeader(Header: TVisualKeyboardHeader; Stream: TStream);
procedure SaveKey(Key: TVisualKeyboardKey; Stream: TStream);
procedure SaveKeys(Keys: TVisualKeyboardKeyList; Stream: TStream);
procedure WriteBitmap(FFile: TStream; FBitmap: Vcl.Graphics.TBitmap);
procedure WriteFont(FFile: TStream; FFont: TFont);
procedure WriteString(FFile: TStream; str: WideString);
public
procedure SaveToStream(Stream: TStream); override;
end;
implementation
procedure TVisualKeyboardSaverBinary.WriteString(FFile: TStream; str: WideString);
var
w: Word;
begin
w := Length(str)+1;
FFile.Write(w, sizeof(w));
FFile.Write(PWideChar(str)^, w*2);
end;
procedure TVisualKeyboardSaverBinary.WriteFont(FFile: TStream; FFont: TFont);
var
n: Integer;
begin
WriteString(FFile, FFont.Name);
n := FFont.Size;
FFile.Write(n, sizeof(n));
n := Integer(FFont.Color);
FFile.Write(n, sizeof(n));
end;
procedure TVisualKeyboardSaverBinary.WriteBitmap(FFile: TStream; FBitmap: Vcl.Graphics.TBitmap);
var
n: DWord;
mem: TMemoryStream;
begin
if not Assigned(FBitmap) then
begin
n := 0;
FFile.Write(n, Sizeof(n));
end
else
begin
mem := TMemoryStream.Create;
try
FBitmap.SaveToStream(mem);
n := mem.Size;
FFile.Write(n, Sizeof(n));
FFile.CopyFrom(mem, 0);
finally
mem.Free;
end;
end;
end;
procedure TVisualKeyboardSaverBinary.SaveToStream(Stream: TStream);
begin
SaveHeader(FKbd.Header, Stream);
SaveKeys(FKbd.Keys, Stream);
end;
procedure TVisualKeyboardSaverBinary.SaveHeader(Header: TVisualKeyboardHeader; Stream: TStream);
var
ch: array[0..4] of ansichar; // I3310
version: Integer;
begin
ch := 'KVKF';
Stream.Write(ch, 4);
version := $0600;
Stream.Write(version, 4);
Stream.Write(Header.Flags, sizeof(Header.Flags));
WriteString(Stream, Header.AssociatedKeyboard);
WriteFont(Stream, Header.ANSIFont);
WriteFont(Stream, Header.UnicodeFont);
end;
procedure TVisualKeyboardSaverBinary.SaveKeys(Keys: TVisualKeyboardKeyList; Stream: TStream);
var
i: Integer;
begin
Stream.Write(Keys.Count, Sizeof(Keys.Count));
for i := 0 to Keys.Count - 1 do
SaveKey(Keys[i], Stream);
end;
procedure TVisualKeyboardSaverBinary.SaveKey(Key: TVisualKeyboardKey; Stream: TStream);
begin
Stream.Write(Key.Flags, sizeof(Key.Flags));
Stream.Write(Key.Shift, sizeof(Key.Shift));
Stream.Write(Key.VKey, sizeof(Key.VKey));
WriteString(Stream, Key.Text);
WriteBitmap(Stream, Key.Bitmap);
end;
end.