mirror of
https://github.com/keymanapp/keyman.git
synced 2026-08-07 01:15:33 +00:00
493 lines
12 KiB
ObjectPascal
493 lines
12 KiB
ObjectPascal
(*
|
|
Name: ttinfo
|
|
Copyright: Copyright (C) SIL International.
|
|
Documentation:
|
|
Description:
|
|
Create Date: 6 Oct 2006
|
|
|
|
Modified Date: 4 May 2012
|
|
Authors: mcdurdin
|
|
Related Files:
|
|
Dependencies:
|
|
|
|
Bugs:
|
|
Todo:
|
|
Notes:
|
|
History: 06 Oct 2006 - mcdurdin - Rework for cleaner CMap reading
|
|
22 Jan 2007 - mcdurdin - Add support for .ttc files
|
|
27 Mar 2008 - mcdurdin - I1301 - Fixup supplementary plane font view in Charmap
|
|
18 Mar 2011 - mcdurdin - I2794 - Handle leaks
|
|
04 Nov 2011 - mcdurdin - I3124 - Add support for reading true type font by font name
|
|
04 May 2012 - mcdurdin - I3310 - V9.0 - Unicode in Delphi fixes
|
|
*)
|
|
unit TTInfo;
|
|
|
|
interface
|
|
|
|
uses Windows, Classes, SysUtils, Graphics;
|
|
|
|
type
|
|
TTTHeader = record
|
|
iTTVersion: Integer;
|
|
iHeaderOffset, iHeaderLength: Integer;
|
|
iNameOffset, iNameLength: Integer;
|
|
iCMapOffset, iCMapLength: Integer;
|
|
iMetricsLength: Integer;
|
|
iNumTables: Integer;
|
|
iNumStrings: Integer;
|
|
iStringsOffset: Integer;
|
|
iTag: Integer;
|
|
iStringOffset: array[0..7] of Integer;
|
|
iStringLength: array[0..7] of Integer;
|
|
iPlatformID, iEncodingID, iLanguageID: Integer;
|
|
iNameID: Integer;
|
|
end;
|
|
|
|
TTTInfoFlags = set of (tfNames, tfCMap, tfNameIsFontName); // I3124
|
|
|
|
TTTCMapTableItem = record
|
|
StartCode, EndCode: Integer;
|
|
end;
|
|
|
|
TTTCMapTable = class
|
|
private
|
|
Ranges: array of TTTCMapTableItem;
|
|
function GetCount: Integer;
|
|
function GetItem(Index: Integer): TTTCMapTableItem;
|
|
public
|
|
constructor Create;
|
|
procedure Assign(Source: TTTCMapTable);
|
|
property Count: Integer read GetCount;
|
|
property Item[Index: Integer]: TTTCMapTableItem read GetItem;
|
|
end;
|
|
|
|
TTTInfo = class
|
|
private
|
|
procedure ReadCMap12;
|
|
procedure ReadCMap4;
|
|
function LoadFontToStream(AFontName: string): TMemoryStream; // I3124
|
|
protected
|
|
fs: TStream;
|
|
hdr: TTTHeader;
|
|
FIsGlyphIndex: Boolean;
|
|
|
|
procedure ReadNames;
|
|
protected
|
|
sFileName: string; // I3310
|
|
iTTVersion: Integer;
|
|
iDirectionality: Integer;
|
|
sCopyright, sFamilyName, sStyle, sUniqueID, sFullName,
|
|
sFontVersion, sPostscriptName, sTrademark: WideString;
|
|
|
|
function ReadBELong(fs: TStream): Integer;
|
|
function ReadBEShort(fs: TStream): Word;
|
|
procedure ReverseChars(var buf: array of WideChar);
|
|
|
|
public
|
|
CMapTable: TTTCMapTable;
|
|
constructor Create(const AFileName: string; AFlags: TTTInfoFlags);
|
|
destructor Destroy; override;
|
|
|
|
property Copyright: WideString read sCopyright;
|
|
property FamilyName: WideString read sFamilyName;
|
|
property Style: WideString read sStyle;
|
|
property UniqueID: WideString read sUniqueID;
|
|
property FullName: WideString read sFullName;
|
|
property FontVersion: WideString read sFontVersion;
|
|
property PostscriptName: WideString read sPostscriptName;
|
|
property Trademark: WideString read sTrademark;
|
|
|
|
property Directionality: Integer read iDirectionality;
|
|
property TTVersion: Integer read iTTVersion;
|
|
property FileName: string read sFileName; // I3310
|
|
|
|
procedure ReadCMap;
|
|
end;
|
|
|
|
TTTInfoFromFont = class(TTTInfo)
|
|
public
|
|
constructor Create(const AFontName: string);
|
|
end;
|
|
|
|
implementation
|
|
|
|
{ TTTInfo }
|
|
|
|
function TTTInfo.LoadFontToStream(AFontName: string): TMemoryStream; // I3124
|
|
var
|
|
oldfont, font, dc: THandle;
|
|
FSize: Cardinal;
|
|
begin
|
|
dc := GetDC(0);
|
|
if dc = 0 then
|
|
RaiseLastOSError;
|
|
try
|
|
font := CreateFont(0, 0, 0, 0, 0, 0, 0, 0, DEFAULT_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS, DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, PChar(AFontName));
|
|
if font = 0 then
|
|
RaiseLastOSError;
|
|
oldfont := SelectObject(dc, font);
|
|
try
|
|
FSize := GetFontData(dc, 0, 0, nil, 0);
|
|
if (FSize = GDI_ERROR) or (FSize = 0) then
|
|
RaiseLastOSError;
|
|
Result := TMemoryStream.Create;
|
|
Result.SetSize(FSize);
|
|
FSize := GetFontData(dc, 0, 0, Result.Memory, FSize);
|
|
if (FSize = GDI_ERROR) or (FSize = 0) then
|
|
begin
|
|
Result.Free;
|
|
RaiseLastOSError;
|
|
end;
|
|
finally
|
|
SelectObject(dc, oldfont);
|
|
DeleteObject(font);
|
|
end;
|
|
finally
|
|
ReleaseDC(0, dc);
|
|
end;
|
|
end;
|
|
|
|
constructor TTTInfo.Create(const AFileName: string; AFlags: TTTInfoFlags);
|
|
var
|
|
i : Integer;
|
|
begin
|
|
inherited Create;
|
|
|
|
CMapTable := nil;
|
|
|
|
if tfNameIsFontName in AFlags then // I3124
|
|
begin
|
|
fs := LoadFontToStream(AFileName);
|
|
end
|
|
else
|
|
fs := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
|
|
|
|
sFileName := AFileName;
|
|
hdr.iTTVersion := ReadBELong(fs);
|
|
|
|
if hdr.iTTVersion = $74746366 then
|
|
begin
|
|
// A TTC file
|
|
ReadBELong(fs); // TTC header version
|
|
i := ReadBELong(fs); // number of fonts
|
|
if i = 0 then
|
|
raise Exception.Create('Invalid TTC file');
|
|
i := ReadBELong(fs);
|
|
fs.Seek(i, soFromBeginning);
|
|
hdr.iTTVersion := ReadBELong(fs);
|
|
end;
|
|
|
|
hdr.iNumTables := ReadBEShort(fs);
|
|
|
|
//Skip the rest of the Offset table
|
|
fs.Seek(6, soFromCurrent);
|
|
|
|
hdr.iNameLength := -1;
|
|
hdr.iHeaderLength := -1;
|
|
hdr.iMetricsLength := -1;
|
|
hdr.iNameOffset := -1;
|
|
hdr.iHeaderOffset := -1;
|
|
|
|
//Now read the Table Directory
|
|
for i := 1 to hdr.iNumTables do
|
|
begin
|
|
hdr.iTag := ReadBELong(fs);
|
|
if hdr.iTag = $6E616D65 then //name table
|
|
begin
|
|
fs.Seek(4, soFromCurrent);
|
|
hdr.iNameOffset := ReadBELong(fs);
|
|
hdr.iNameLength := ReadBELong(fs);
|
|
end
|
|
else if hdr.iTag = $68656164 then //head table
|
|
begin
|
|
fs.Seek(4, soFromCurrent);
|
|
hdr.iHeaderOffset := ReadBELong(fs);
|
|
hdr.iHeaderLength := ReadBELong(fs);
|
|
end
|
|
else if hdr.iTag = $4F532F32 then //OS/2 table
|
|
begin
|
|
fs.Seek( 4, soFromCurrent );
|
|
{iMetricsOffset :=} ReadBELong(fs);
|
|
hdr.iMetricsLength := ReadBELong(fs);
|
|
end
|
|
else if hdr.iTag = $636D6170 then //cmap table
|
|
begin
|
|
fs.Seek( 4, soFromCurrent );
|
|
hdr.iCMapOffset := ReadBELong(fs);
|
|
hdr.iCMapLength := ReadBELong(fs);
|
|
end
|
|
else
|
|
fs.Seek(12, soFromCurrent);
|
|
end;
|
|
|
|
if (hdr.iNameLength = -1) or (hdr.iHeaderLength = -1) or (hdr.iMetricsLength = -1) then
|
|
raise Exception.Create('Invalid TrueType Font File');
|
|
|
|
//Read the Directionality
|
|
fs.Seek(hdr.iHeaderOffset + 32, soFromBeginning);
|
|
iDirectionality := ReadBELong(fs);
|
|
|
|
if tfNames in AFlags then ReadNames;
|
|
if tfCMap in AFlags then ReadCMap;
|
|
end;
|
|
|
|
destructor TTTInfo.Destroy;
|
|
begin
|
|
fs.Free;
|
|
CMapTable.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTTInfo.ReverseChars(var buf: array of WideChar); // Swaps endianness of words - slowly...
|
|
var
|
|
p, q: PAnsiChar;
|
|
c: AnsiChar;
|
|
begin
|
|
p := PAnsiChar(@buf); q := p; Inc(q); // I3310
|
|
while (p^ <> #0) or (q^ <> #0) do
|
|
begin
|
|
c := p^; p^ := q^; q^ := c;
|
|
Inc(p, 2);
|
|
Inc(q, 2);
|
|
end;
|
|
end;
|
|
|
|
procedure TTTInfo.ReadNames;
|
|
var
|
|
i, iNameID: Integer;
|
|
cBuf: array[0..255] of WideChar;
|
|
begin
|
|
//Read the Naming Table
|
|
|
|
fs.Seek(hdr.iNameOffset + 2, soFromBeginning);
|
|
hdr.iNumStrings := ReadBEShort(fs);
|
|
hdr.iStringsOffset := ReadBEShort(fs);
|
|
|
|
for i := 0 to 7 do hdr.iStringLength[i] := -1;
|
|
|
|
for i := 0 to hdr.iNumStrings - 1 do
|
|
begin
|
|
hdr.iPlatformID := ReadBEShort(fs);
|
|
hdr.iEncodingID := ReadBEShort(fs);
|
|
hdr.iLanguageID := ReadBEShort(fs);
|
|
iNameID := ReadBEShort(fs);
|
|
|
|
if (iNameID >= 0) and (iNameID <= 7) and {(hdr.iLanguageID = $0409) and}
|
|
{(hdr.iEncodingID = 1) and} (hdr.iPlatformID = 3) then
|
|
begin
|
|
if (hdr.iLanguageID = $0409) or (hdr.iStringLength[iNameID] = -1) then
|
|
begin
|
|
hdr.iStringLength[iNameID] := ReadBEShort(fs);
|
|
hdr.iStringOffset[iNameID] := ReadBEShort(fs);
|
|
end
|
|
else
|
|
fs.Seek(4, soFromCurrent);
|
|
end
|
|
else
|
|
fs.Seek(4, soFromCurrent);
|
|
end;
|
|
|
|
|
|
//Here we actually read the names
|
|
for i := 0 to 7 do
|
|
begin
|
|
if hdr.iStringLength[i] <> -1 then
|
|
begin
|
|
fs.Seek(hdr.iNameOffset + hdr.iStringsOffset + hdr.iStringOffset[i], soFromBeginning);
|
|
|
|
if hdr.iStringLength[i] < 512 then
|
|
begin
|
|
fs.ReadBuffer(cBuf, hdr.iStringLength[i]);
|
|
cBuf[hdr.iStringLength[i] div 2] := #0;
|
|
end
|
|
else
|
|
begin
|
|
fs.ReadBuffer(cBuf, 512);
|
|
fs.Seek(hdr.iStringLength[i] - 512, soFromCurrent);
|
|
cBuf[High(cBuf)] := #0;
|
|
end;
|
|
|
|
ReverseChars(cBuf);
|
|
|
|
case i of
|
|
0: sCopyright := cBuf;
|
|
1: sFamilyName := cBuf;
|
|
2: sStyle := cBuf;
|
|
3: sUniqueID := cBuf;
|
|
4: sFullName := cBuf;
|
|
5: sFontVersion := cBuf;
|
|
6: sPostscriptName := cBuf;
|
|
7: sTrademark := cBuf;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TTTInfo.ReadCMap;
|
|
var
|
|
i, nTables: Integer;
|
|
iPlatformID, iPlatEncodingID, iOffset: Integer;
|
|
FCMap4, FCMap12: Integer;
|
|
begin
|
|
fs.Seek(hdr.iCMapOffset + 2, soFromBeginning);
|
|
|
|
nTables := ReadBEShort(fs);
|
|
FCMap12 := -1; FCMap4 := -1;
|
|
|
|
for i := 0 to nTables - 1 do
|
|
begin
|
|
iPlatformID := ReadBEShort(fs);
|
|
iPlatEncodingID := ReadBEShort(fs);
|
|
iOffset := ReadBELong(fs);
|
|
|
|
if (iPlatformID = 3) and (iPlatEncodingID = 1) then FCMap4 := iOffset;
|
|
if (iPlatformID = 3) and (iPlatEncodingID = 10) then FCMap12 := iOffset;
|
|
end;
|
|
|
|
if (FCMap4 = -1) and (FCMap12 = -1) then Exit;
|
|
|
|
if FCMap12 > -1
|
|
then begin fs.Seek(hdr.iCMapOffset + FCMap12, soFromBeginning); ReadCMap12; end
|
|
else begin fs.Seek(hdr.iCMapOffset + FCMap4, soFromBeginning); ReadCMap4; end;
|
|
end;
|
|
|
|
procedure TTTInfo.ReadCMap12;
|
|
var
|
|
i, nGroups: Integer;
|
|
begin
|
|
FIsGlyphIndex := True;
|
|
|
|
if ReadBEShort(fs) <> 12 then Exit; // Format 12 is required
|
|
{iReserved := } ReadBEShort(fs);
|
|
{iLength := } ReadBELong(fs);
|
|
{iLanguage := } ReadBELong(fs);
|
|
|
|
nGroups := ReadBELong(fs);
|
|
|
|
CMapTable := TTTCMapTable.Create;
|
|
SetLength(CMapTable.Ranges, nGroups);
|
|
|
|
for i := 0 to nGroups - 1 do
|
|
begin
|
|
CMapTable.Ranges[i].StartCode := ReadBELong(fs);
|
|
CMapTable.Ranges[i].EndCode := ReadBELong(fs);
|
|
{Glyph index := } ReadBELong(fs); // I1301 - Missing long when reading font
|
|
end;
|
|
end;
|
|
|
|
procedure TTTInfo.ReadCMap4;
|
|
var
|
|
i: Integer;
|
|
segcountX2, segcount: Integer;
|
|
begin
|
|
if ReadBEShort(fs) <> 4 then Exit; // Format 4 is required
|
|
{iLength := } ReadBEShort(fs);
|
|
//if ReadBEShort(fs) <> 0 then Exit; // Version 0 is the only version understood
|
|
ReadBEShort(fs);
|
|
segcountX2 := ReadBEShort(fs); segcount := segcountX2 div 2;
|
|
|
|
ReadBEShort(fs); //searchRange
|
|
ReadBEShort(fs); //entrySelector
|
|
ReadBEShort(fs); //rangeShift
|
|
|
|
CMapTable := TTTCMapTable.Create;
|
|
SetLength(CMapTable.Ranges, segcount);
|
|
|
|
for i := 0 to segcount - 1 do
|
|
CMapTable.Ranges[i].EndCode := ReadBEShort(fs);
|
|
|
|
ReadBEShort(fs); //reservedPad
|
|
|
|
for i := 0 to segcount - 1 do
|
|
CMapTable.Ranges[i].StartCode := ReadBEShort(fs);
|
|
end;
|
|
|
|
function TTTInfo.ReadBELong(fs: TStream): Integer;
|
|
type
|
|
PInteger = ^Integer;
|
|
var
|
|
buf: array[0..3] of Byte;
|
|
ch: Byte;
|
|
begin
|
|
fs.ReadBuffer(buf, 4);
|
|
ch := buf[0]; buf[0] := buf[3]; buf[3] := ch;
|
|
ch := buf[1]; buf[1] := buf[2]; buf[2] := ch;
|
|
Result := PInteger(@buf)^;
|
|
end;
|
|
|
|
function TTTInfo.ReadBEShort(fs: TStream): Word;
|
|
type
|
|
PSmallInt = ^SmallInt;
|
|
var
|
|
buf: array[0..1] of Byte;
|
|
ch: Byte;
|
|
begin
|
|
fs.ReadBuffer(buf, 2);
|
|
ch := buf[0]; buf[0] := buf[1]; buf[1] := ch;
|
|
Result := PWord(@buf)^;
|
|
end;
|
|
|
|
{ TTTInfoFromFont }
|
|
|
|
constructor TTTInfoFromFont.Create(const AFontName: string);
|
|
var
|
|
sz: DWord;
|
|
FHDC: THandle;
|
|
Canvas: TCanvas;
|
|
begin
|
|
fs := TMemoryStream.Create;
|
|
Canvas := TCanvas.Create;
|
|
try
|
|
FHDC := GetDC(GetDesktopWindow); // I2794
|
|
try
|
|
Canvas.Handle := FHDC;
|
|
try
|
|
Canvas.Font.Name := AFontName;
|
|
|
|
{ Read CMAP }
|
|
sz := GetFontData(Canvas.Handle, $70616D63, 0, nil, 0);
|
|
if sz = GDI_ERROR then Exit;
|
|
|
|
fs.Size := sz;
|
|
GetFontData(Canvas.Handle, $70616D63, 0, (fs as TMemoryStream).Memory, sz);
|
|
hdr.iCMapOffset := 0;
|
|
ReadCMap;
|
|
finally
|
|
Canvas.Handle := 0;
|
|
end;
|
|
finally
|
|
ReleaseDC(GetDesktopWindow, FHDC); // I2794
|
|
end;
|
|
finally
|
|
Canvas.Free;
|
|
end;
|
|
end;
|
|
|
|
{ TTTCMapTable }
|
|
|
|
procedure TTTCMapTable.Assign(Source: TTTCMapTable);
|
|
begin
|
|
//Ranges.SetLength(SizeOf(Source.Ranges));
|
|
Ranges := Source.Ranges;
|
|
// for I := 0 to High(Source.Ranges) do
|
|
// Ranges[I] := Source.Ranges[I];
|
|
end;
|
|
|
|
constructor TTTCMapTable.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
function TTTCMapTable.GetCount: Integer;
|
|
begin
|
|
Result := High(Ranges) + 1;
|
|
end;
|
|
|
|
function TTTCMapTable.GetItem(Index: Integer): TTTCMapTableItem;
|
|
begin
|
|
Result := Ranges[Index];
|
|
end;
|
|
|
|
end.
|
|
|