adtrmmap.pas

测试用例

    Node^.csnNext := FTable[Inx];
    Node^.csnCharSet := AllocKeyString(aCharSet);
    Node^.csnFont := AllocKeyString(aFont);
    Node^.csnChar := Ch;
    Node^.csnGlyph := Glyph;
    FTable[Inx] := Node;
    inc(FCount);
    inc(Glyph);
  end;
end;
{--------}
procedure TAdCharSetMapping.Clear;
var
  i    : integer;
  Node : PCSHashNode;
  Temp : PCSHashNode;
begin
  {free the script: in a moment there's going to be no mapping}
  csmFreeScript;
  {clear out the hash table}
  for i := 0 to pred(CSHashTableSize) do begin
    Node := FTable[i];
    while (Node <> nil) do begin
      Temp := Node;
      Node := Node^.csnNext;
      FreeKeyString(Temp^.csnCharSet);
      FreeKeyString(Temp^.csnFont);
      Dispose(Temp);
    end;
    FTable[i] := nil;
  end;
  FCount := 0;
end;
{--------}
procedure TAdCharSetMapping.csmAddScriptNode(aFont : PadKeyString);
var
  Node : PScriptNode;
begin
  {allocate and set up the new node}
  if (FScriptFreeList = nil) then
    New(Node)
  else begin
    Node := FScriptFreeList;
    FScriptFreeList := Node^.snNext;
  end;
  Node^.snNext := nil;
  Node^.snFont := aFont;
  Node^.snText := TCharQueue(FCharQueue).DupText;
  {add the node to the script}
  if (FScript <> nil) then
    PScriptNode(FScriptEnd)^.snNext := Node
  else
    FScript := Node;
  {update the tail pointer}
  FScriptEnd := Node;
end;
{--------}
function TAdCharSetMapping.csmFindPrim(const aCharSet : TAdKeyString;
                                             aChar    : AnsiChar;
                                         var aInx     : integer;
                                         var aNode    : pointer) : boolean;
var
  Node : PCSHashNode;
begin
  {assume we won't find aCharSet/aChar}
  Result := false;
  aNode := nil;
  {calculate the index, ie hash, of the charset/char}
  aInx := HashELFPlusChar(aCharSet, aChar) mod CSHashTableSize;
  {traverse the linked list at this entry, looking for the character
   in each node we encounter--a case-sensitive comparison--if we get a
   match, compare the character set name as well, again case-
   insensitive}
  Node := FTable[aInx];
  while (Node <> nil) do begin
    if (aChar = Node^.csnChar) then begin
      if (aCharSet = Node^.csnCharSet^) then begin
        Result := true;
        aNode := Node;
        Exit;
      end;
    end;
    Node := Node^.csnNext;
  end;
end;
{--------}
procedure TAdCharSetMapping.csmFreeScript;
var
  Walker, Temp : PScriptNode;
begin
  Walker := FScript;
  FScript := nil;
  while (Walker <> nil) do begin
    Temp := Walker;
    Walker := Walker^.snNext;
    FreeMem(Temp^.snText, StrLen(Temp^.snText));
    {NOTE: we do NOT free the font name: it's a copy of an allocated
     string in the mapping hash table}
    Temp^.snNext := FScriptFreeList;
    FScriptFreeList := Temp;
  end;
end;
{--------}
{$IFDEF CompileDebugCode}
procedure TAdCharSetMapping.DebugPrint(const aFileName : string);
var
  F    : text;
  i    : integer;
  Node : PCSHashNode;
begin
  System.Assign(F, aFileName);
  System.Rewrite(F);

  for i := 0 to pred(CSHashTableSize) do begin
    writeln(F, '---', i, '---');
    Node := FTable[i];
    while (Node <> nil) do begin
      writeln(F, Node^.csnCharSet^:20,
                 ord(Node^.csnChar):4,
                 Node^.csnFont^:20,
                 ord(Node^.csnGlyph):4);
      Node := Node^.csnNext;
    end;
  end;

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

  System.Close(F);
end;
{$ENDIF}
{--------}
procedure TAdCharSetMapping.GenerateDrawScript(const aCharSet : TAdKeyString;
                                                     aText    : PAnsiChar);
var
  i    : integer;
  Inx  : integer;
  TextLen  : integer;
  Node     : PCSHashNode;
  Ch       : AnsiChar;
  CurFont  : PadKeyString;
  ThisFont : PadKeyString;
  ThisChar : AnsiChar;
begin
  {nothing to do if the string is empty}
  TextLen := StrLen(aText);
  if (TextLen = 0) then
    Exit;
  {destroy any current script}
  csmFreeScript;
  TCharQueue(FCharQueue).Clear;
  {we don't yet have a font name}
  CurFont := nil;
  {read the text, char by char}
  for i := 0 to pred(TextLen) do begin
    {look up this charset/char in the hash table}
    Ch := aText[i];
    if csmFindPrim(aCharSet, Ch, Inx, pointer(Node)) then begin
      {found it, use the named font and glyph}
      ThisFont := Node^.csnFont;
      ThisChar := Node^.csnGlyph;
    end
    else begin
      {if not found, use the default font and glyph}
      ThisFont := @DefaultFontName;
      ThisChar := Ch;
    end;
    {if the font has changed, create a script node for the previous
     font}
    if (CurFont = nil) then
      CurFont := ThisFont;
    if (CurFont^ <> ThisFont^) then begin
      csmAddScriptNode(CurFont);
      CurFont := ThisFont;
      TCharQueue(FCharQueue).Clear;
    end;
    {add this character to the current string}
    TCharQueue(FCharQueue).Add(ThisChar);
  end;
  {add the final script node to finish off the string}
  csmAddScriptNode(CurFont);
  TCharQueue(FCharQueue).Clear;
end;
{--------}
procedure TAdCharSetMapping.GetFontNames(aList : TStrings);
var
  i    : integer;
  Node : PCSHashNode;
  PrevFont : string;
begin
  aList.Clear;
  PrevFont := '';
  for i := 0 to pred(CSHashTableSize) do begin
    Node := FTable[i];
    while (Node <> nil) do begin
      if (CompareText(Node^.csnFont^, PrevFont) <> 0) then begin
        PrevFont := Node^.csnFont^;
        if (aList.IndexOf(PrevFont) = -1) then
          aList.Add(PrevFont);
      end;
      Node := Node^.csnNext;
    end;
  end;
end;
{--------}
function TAdCharSetMapping.GetNextDrawCommand(var aFont : TAdKeyString;
                                                  aText : PAnsiChar) : boolean;
var
  Temp : PScriptNode;
begin
  {start off with the obvious case: there's no script}
  if (FScript = nil) then begin
    Result := false;
    Exit;
  end;
  {we'll definitely return something}
  Result := true;
  {return the data from the top node}
  aFont := PScriptNode(FScript)^.snFont^;
  StrCopy(aText, PScriptNode(FScript)^.snText);
  {unlink the top node}
  Temp := PScriptNode(FScript);
  FScript := Temp^.snNext;
  {free the unlinked top node}
  FreeMem(Temp^.snText, StrLen(Temp^.snText));
  {NOTE: we do NOT free the font name: it's a copy of an allocated
   string in the mapping hash table}
  Temp^.snNext := FScriptFreeList;
  FScriptFreeList := Temp;
end;
{--------}
procedure TAdCharSetMapping.LoadFromFile(const aFileName : string);
var
  Lines     : TStringList;
  ActualLen : integer;
  i         : integer;
  LineInx   : integer;
  Line      : string[255];
  CharSet   : TAdKeyString;
  FontName  : TAdKeyString;
  FromCh    : AnsiChar;
  ToCh      : AnsiChar;
  Glyph     : AnsiChar;
begin
  {clear the hash table, ready for loading}
  Clear;
  {create the stringlist to hold the mapping script}
  Lines := TStringList.Create;
  try
    {load the mapping 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
        if ProcessCharSetLine(Line, CharSet, FromCh, ToCh, FontName, Glyph) then
          Add(CharSet, FromCh, ToCh, FontName, Glyph);
      end;
    end;
  finally
    Lines.Free;
  end;
end;
{--------}
procedure TAdCharSetMapping.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;
  CharSet   : TAdKeyString;
  Font      : TAdKeyString;
  Ch        : AnsiChar;
  Glyph     : AnsiChar;
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 PChar, 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 mappings in the resource}
      MS.Read(ResCount, sizeof(ResCount));
      {read that number of mappings and add them to the hash table}
      for i := 0 to pred(ResCount) do begin
        MS.Read(CharSet[0], 1);
        MS.Read(CharSet[1], ord(CharSet[0]));
        MS.Read(Font[0], 1);
        MS.Read(Font[1], ord(Font[0]));
        MS.Read(Ch, 1);
        MS.Read(Glyph, 1);
        Add(CharSet, Ch, Ch, Font, Glyph);
      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 TAdCharSetMapping.StoreToBinFile(const aFileName : string);
var
  aFS  : TFileStream;
  i    : integer;
  Node : PCSHashNode;
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 mappings}
    aFS.Write(FCount, sizeof(FCount));
    {write all the mappings}
    for i := 0 to pred(CSHashTableSize) do begin
      Node := FTable[i];
      while (Node <> nil) do begin
        aFS.Write(Node^.csnCharSet^, succ(length(Node^.csnCharSet^)));
        aFS.Write(Node^.csnFont^, succ(length(Node^.csnFont^)));
        aFS.Write(Node^.csnChar, sizeof(AnsiChar));
        aFS.Write(Node^.csnGlyph, sizeof(AnsiChar));
        Node := Node^.csnNext;
      end;
    end;
    {write our signature as footer as a further check on reading}
    aFS.Write(OurSignature, sizeof(OurSignature));
  finally
    aFS.Free;
  end;
end;
{====================================================================}


{===Initialization/finalization======================================}
procedure ADTrmMapDone; far;
begin
  { }
end;
{--------}
initialization
  {$IFDEF Windows}
  AddExitProc(ADTrmMapDone);
  {$ENDIF}
{--------}
{$IFDEF Win32}
finalization
  ADTrmMapDone;
{$ENDIF}
{--------}
end.