summaryrefslogtreecommitdiff
path: root/docview/src/docdump/readfonts.pas
blob: 68c3bd4c0776970112ff4550516d80902a896e6b (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
{
  Dumps the font data
}
unit readfonts;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, filestreamhelper;

procedure ProcessFonts(AIn: TFileStream; AOut: TFileTextStream);


implementation

uses
  readheader, IPFFileFormatUnit;

procedure ProcessFonts(AIn: TFileStream; AOut: TFileTextStream);
var
  fnt: THelpFontSpec;
  pData: pointer;
  i: integer;
begin
  AOut.WriteLn('');
  AOut.WriteLn('Font Data');
  if eHdr.NumFontEntry > 0 then
  begin
    AIn.Seek(eHdr.FontTableOffset, soBeginning);
    for i := 0 to eHdr.NumFontEntry-1 do
    begin
      AIn.Read(fnt, SizeOf(THelpFontSpec));
      AOut.WriteLn(Format('  Font Entry #%d', [i]));
      AOut.WriteLn(Format('    FontSpec.FaceName: %s', [fnt.FaceName]));
      AOut.WriteLn(Format('    FontSpec.Height:   %4.4x (%0:d)', [fnt.Height]));
      AOut.WriteLn(Format('    FontSpec.Width:    %4.4x (%0:d)', [fnt.Width]));
      AOut.WriteLn(Format('    FontSpec.CodePage: %4.4x (%0:d)', [fnt.Codepage]));
    end;
  end
  else
    AOut.WriteLn('  No font data is present');
end;

end.