adtrmmap.pas

测试用例

        Exit; {the word was either '' or ""}
    end;
  end;
  {we now know where each word can be found; the only special words
   are words 1, 2, and 4 which must be single characters, or ASCII
   values of the form \xnn}
  for i := 1 to 4 do
    if (i <> 3) then begin
      WordLen := succ(WordEnd[i] - WordStart[i]);
      if (WordLen = 1) then
        Chars[i] := aLine[WordStart[i]]
      else if (WordLen = 4) then begin
        CharInx := WordStart[i];
        if (aLine[CharInx] <> '\') or
           (aLine[CharInx+1] <> 'x') then
          Exit;
        TestSt := Copy(aLine, CharInx+1, 3);
        TestSt[1]:= '$';
        Val(TestSt, AsciiCh, ec);
        if (ec <> 0) then
          Exit;
        Chars[i] := chr(AsciiCh);
      end
      else
        Exit; {unknown format}
    end;
  {return values}
  aFromCh := Chars[1];
  aToCh := Chars[2];
  aGlyph := Chars[4];
  aCharSet := Copy(aLine, WordStart[0], succ(WordEnd[0] - WordStart[0]));
  aFontName := Copy(aLine, WordStart[3], succ(WordEnd[3] - WordStart[3]));
  Result := true;
end;
{====================================================================}


{===TAdKeyboardMapping==================================================}
constructor TAdKeyboardMapping.Create;
begin
  inherited Create;
  FTable := TList.Create;
  FTable.Count := KBHashTableSize;
end;
{--------}
destructor TAdKeyboardMapping.Destroy;
begin
  if (FTable <> nil) then begin
    Clear;
    FTable.Destroy;
  end;
  inherited Destroy;
end;
{--------}
function TAdKeyboardMapping.Add(const aKey   : TAdKeyString;
                             const aValue : TAdKeyString) : boolean;
var
  Inx  : integer;
  Node : PKBHashNode;
begin
  if kbmFindPrim(aKey, Inx, pointer(Node)) then
    Result := false
  else begin
    Result := true;
    New(Node);
    Node^.kbnNext := FTable[Inx];
    Node^.kbnKey := AllocKeyString(aKey);
    Node^.kbnValue := AllocKeyString(aValue);
    FTable[Inx] := Node;
    inc(FCount);
  end;
end;
{--------}
procedure TAdKeyboardMapping.Clear;
var
  i    : integer;
  Node : PKBHashNode;
  Temp : PKBHashNode;
begin
  for i := 0 to pred(KBHashTableSize) do begin
    Node := FTable[i];
    while (Node <> nil) do begin
      Temp := Node;
      Node := Node^.kbnNext;
      FreeKeyString(Temp^.kbnKey);
      FreeKeyString(Temp^.kbnValue);
      Dispose(Temp);
    end;
    FTable[i] := nil;
  end;
  FCount := 0;
end;
{--------}
{$IFDEF CompileDebugCode}
procedure TAdKeyboardMapping.DebugPrint(const aFileName : string);
var
  F    : text;
  i    : integer;
  Node : PKBHashNode;
begin
  System.Assign(F, aFileName);
  System.Rewrite(F);

  for i := 0 to pred(KBHashTableSize) do begin
    writeln(F, '---', i, '---');
    Node := FTable[i];
    while (Node <> nil) do begin
      writeln(F, Node^.kbnKey^:20, Node^.kbnValue^:20);
      Node := Node^.kbnNext;
    end;
  end;

  writeln(F);
  writeln(F, 'Count: ', Count, ' (mean: ', Count/CSHashTableSize:5:3, ')');

  System.Close(F);
end;
{$ENDIF}
{--------}
function TAdKeyboardMapping.Get(const aKey : TAdKeyString) : TAdKeyString;
var
  Inx  : integer;
  Node : PKBHashNode;
begin
  if kbmFindPrim(aKey, Inx, pointer(Node)) then
    Result := Node^.kbnValue^
  else
    Result := '';
end;
{--------}
function TAdKeyboardMapping.kbmFindPrim(const aKey  : TAdKeyString;
                                          var aInx  : integer;
                                          var aNode : pointer) : boolean;
var
  Node : PKBHashNode;
begin
  {assume we won't find aKey}
  Result := false;
  aNode := nil;
  {calculate the index, ie hash, of the key}
  aInx := HashELF(aKey) mod KBHashTableSize;
  {traverse the linked list at this entry, looking for the key in each
   node we encounter--a case-sensitive comparison}
  Node := FTable[aInx];
  while (Node <> nil) do begin
    if (aKey = Node^.kbnKey^) then begin
      Result := true;
      aNode := Node;
      Exit;
    end;
    Node := Node^.kbnNext;
  end;
end;
{--------}
procedure TAdKeyboardMapping.LoadFromFile(const aFileName : string);
var
  Lines     : TStringList;
  ActualLen : integer;
  i         : integer;
  LineInx   : integer;
  Word1Start: integer;
  Word1End  : integer;
  Word2Start: integer;
  Word2End  : integer;
  LookingForStart : boolean;
  Line      : string[255];
begin
  {clear the hash table, ready for loading}
  Clear;
  {create the stringlist to hold the keymap script}
  Lines := TStringList.Create;
  try
    {load the keymap script}
    Lines.LoadFromFile(aFileName);
    for LineInx := 0 to pred(Lines.Count) do begin
      {get this line}
      Line := Lines[LineInx];
      {remove trailing spaces}
      ActualLen := length(Line);
      for i := ActualLen downto 1 do
        if (Line[i] = ' ') then
          dec(ActualLen)
        else
          Break;
      Line[0] := chr(ActualLen);
      {only process detail lines}
      if (Line <> '') and (Line[1] <> '*') then begin
        {identify the first 'word'}
        Word1Start := 0;
        Word1End := 0;
        LookingForStart := true;
        for i := 1 to ActualLen do begin
          if LookingForStart then begin
            if (Line[i] <> ' ') then begin
              Word1Start := i;
              LookingForStart := false;
            end;
          end
          else {looking for end} begin
            if (Line[i] = ' ') then begin
              Word1End := i - 1;
              Break;
            end;
          end;
        end;
        {if we've set Word1End then there are at least two words in
         the line, otherwise there was only one word (which we shall
         ignore)}
        if (Word1End <> 0) then begin
          {identify the second 'word'}
          Word2Start := 0;
          Word2End := 0;
          LookingForStart := true;
          for i := succ(Word1End) to ActualLen do begin
            if LookingForStart then begin
              if (Line[i] <> ' ') then begin
                Word2Start := i;
                LookingForStart := false;
              end;
            end
            else {looking for end} begin
              if (Line[i] = ' ') then begin
                Word2End := i - 1;
                Break;
              end;
            end;
          end;
          if (Word2End = 0) then
            Word2End := ActualLen;
          {add the key and value to the hash table}
          Add(System.Copy(Line, Word1Start, succ(Word1End-Word1Start)),
              System.Copy(Line, Word2Start, succ(Word2End-Word2Start)));
        end;
      end;
    end;
  finally
    Lines.Free;
  end;
end;
{--------}
procedure TAdKeyboardMapping.LoadFromRes(aInstance : THandle;
                                const aResName  : string);
var
  MS        : TMemoryStream;
  ResInfo   : THandle;
  ResHandle : THandle;
  ResNameZ  : PAnsiChar;
  Res       : PByteArray;
  i         : integer;
  Sig       : longint;
  ResCount  : longint;
  BytesRead : longint;
  Key       : TAdKeyString;
  Value     : TAdKeyString;
begin
  {Note: this code has been written to work with all versions of
   Delphi, both 16-bit and 32-bit. Hence it does not make use of any
   of the features available in later compilers, ie, typecasting a
   string to a PAnsiChar, or TResourceStream)

  {clear the hash table, ready for loading}
  Clear;
  {get the resource info handle}
  GetMem(ResNameZ, succ(length(aResName)));
  try
    StrPCopy(ResNameZ, aResName);
    ResInfo := FindResource(aInstance, ResNameZ, RT_RCDATA);
  finally
    FreeMem(ResNameZ, succ(length(aResName)));
  end;
  if (ResInfo = 0) then
    Exit;
  {load and lock the resource}
  ResHandle := LoadResource(aInstance, ResInfo);
  if (ResHandle = 0) then
    Exit;
  Res := LockResource(ResHandle);
  if (Res = nil) then begin
    FreeResource(ResHandle);
    Exit;
  end;
  try
    {create a memory stream}
    MS := TMemoryStream.Create;
    try
      {copy the resource to our memory stream}
      MS.Write(Res^, SizeOfResource(aInstance, ResInfo));
      MS.Position := 0;
      {read the header signature, get out if it's not ours}
      BytesRead := MS.Read(Sig, sizeof(Sig));
      if (BytesRead <> sizeof(Sig)) or (Sig <> OurSignature) then
        Exit;
      {read the count of key/value string pairs in the resource}
      MS.Read(ResCount, sizeof(ResCount));
      {read that number of key/value string pairs and add them to the
       hash table}
      for i := 0 to pred(ResCount) do begin
        MS.Read(Key[0], 1);
        MS.Read(Key[1], ord(Key[0]));
        MS.Read(Value[0], 1);
        MS.Read(Value[1], ord(Value[0]));
        Add(Key, Value);
      end;
      {read the footer signature, clear and get out if it's not ours}
      BytesRead := MS.Read(Sig, sizeof(Sig));
      if (BytesRead <> sizeof(Sig)) or (Sig <> OurSignature) then begin
        Clear;
        Exit;
      end;
    finally
      MS.Free;
    end;
  finally
    UnlockResource(ResHandle);
    FreeResource(ResHandle);
  end;
end;
{--------}
procedure TAdKeyboardMapping.StoreToBinFile(const aFileName : string);
var
  aFS  : TFileStream;
  i    : integer;
  Node : PKBHashNode;
begin
  {create a file stream}
  aFS := TFileStream.Create(aFileName, fmCreate);
  try
    {write our signature as header}
    aFS.Write(OurSignature, sizeof(OurSignature));
    {write the number of key/value string pairs}
    aFS.Write(FCount, sizeof(FCount));
    {write all the key/value string pairs}
    for i := 0 to pred(KBHashTableSize) do begin
      Node := FTable[i];
      while (Node <> nil) do begin
        aFS.Write(Node^.kbnKey^, succ(length(Node^.kbnKey^)));
        aFS.Write(Node^.kbnValue^, succ(length(Node^.kbnValue^)));
        Node := Node^.kbnNext;
      end;
    end;
    {write our signature as footer as a check}
    aFS.Write(OurSignature, sizeof(OurSignature));
  finally
    aFS.Free;
  end;
end;
{====================================================================}


{===TAdCharSetMapping================================================}
constructor TAdCharSetMapping.Create;
begin
  inherited Create;
  FTable := TList.Create;
  FTable.Count := CSHashTableSize;
  FCharQueue := pointer(TCharQueue.Create);
end;
{--------}
destructor TAdCharSetMapping.Destroy;
var
  Temp, Walker : PScriptNode;
begin
  {free the hash table}
  if (FTable <> nil) then begin
    Clear;
    FTable.Destroy;
  end;
  {free the character queue}
  TCharQueue(FCharQueue).Free;
  {free the script node freelist}
  Walker := FScriptFreeList;
  while (Walker <> nil) do begin
    Temp := Walker;
    Walker := Walker^.snNext;
    Dispose(Temp);
  end;
  inherited Destroy;
end;
{--------}
function TAdCharSetMapping.Add(const aCharSet : TAdKeyString;
                                     aFromCh  : AnsiChar;
                                     aToCh    : AnsiChar;
                               const aFont    : TAdKeyString;
                                     aGlyph   : AnsiChar) : boolean;
var
  Inx  : integer;
  Node : PCSHashNode;
  Ch   : AnsiChar;
  Glyph: AnsiChar;
begin
  {we must do this in two stages: first, determine that we can add
   *all* the character mappings; second, do so}

  {stage one: check no mapping currently exists}
  Result := false;
  for Ch := aFromCh to aToCh do begin
    if csmFindPrim(aCharSet, Ch, Inx, pointer(Node)) then
      Exit;
  end;
  {stage two: add all charset/char mappings}
  Result := true;
  Glyph := aGlyph;
  for Ch := aFromCh to aToCh do begin
    Inx := HashELFPlusChar(aCharSet, Ch) mod CSHashTableSize;
    New(Node);