paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-02 00:56:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

LazFreeType: Support font loading from a stream. Patch by "circular".

Browse Source 
git-svn-id: trunk@40260 -
This commit is contained in:
ask 2013-02-11 07:09:52 +00:00
parent f4df84419a
commit f088d7b509
2 changed files with 63 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/lazutils/easylazfreetype.pas
View File

@ -128,6 +128,7 @@ type
procedure BeginUpdate; virtual; abstract;
procedure AddFolder(AFolder: string); virtual; abstract;
function AddFile(AFilename: string): boolean; virtual; abstract;
function AddStream(AStream: TStream; AOwned: boolean): boolean; virtual; abstract;
procedure EndUpdate; virtual; abstract;
function FontFileEnumerator: IFreeTypeFontEnumerator; virtual; abstract;
function FamilyEnumerator: IFreeTypeFamilyEnumerator; virtual; abstract;

68
components/lazutils/lazfreetypefontcollection.pas
View File

@ -13,6 +13,8 @@ type
TFontCollectionItem = class(TCustomFontCollectionItem)
private
FFilename: string;
FSourceStream: TStream;
FSourceStreamOwned: boolean;
FInformation: array[TFreeTypeInformation] of string;
FVersionNumber: string;
FStyleList: array of string;
@ -33,8 +35,10 @@ type
function GetStyle(AIndex: integer): string; override;
function GetVersionNumber: string; override;
procedure NotifyDestroy; override;
procedure Init;
public
constructor Create(AFilename: string);
constructor Create(AStream: TStream; AOwner: Boolean);
destructor Destroy; override;
function HasStyle(AStyle: string): boolean; override;
property Information[AIndex: TFreeTypeInformation]: string read GetInformation write SetInformation;
@ -104,6 +108,7 @@ type
procedure BeginUpdate; override;
procedure AddFolder(AFolder: string); override;
function AddFile(AFilename: string): boolean; override;
function AddStream(AStream: TStream; AOwned: boolean): boolean; override;
procedure EndUpdate; override;
destructor Destroy; override;
function FontFileEnumerator: IFreeTypeFontEnumerator; override;
@ -251,11 +256,15 @@ end;
constructor TFontCollectionItem.Create(AFilename: string);
begin
Init;
FFilename:= AFilename;
FStyleList := nil;
FFaceUsage := 0;
FUsePostscriptStyle:= false;
FDestroyListeners := nil;
end;
constructor TFontCollectionItem.Create(AStream: TStream; AOwner: Boolean);
begin
Init;
FSourceStream := AStream;
FSourceStreamOwned:= AOwner;
end;
procedure TFontCollectionItem.NotifyDestroy;
@ -266,9 +275,19 @@ begin
FDestroyListeners := nil;
end;
procedure TFontCollectionItem.Init;
begin
FStyleList := nil;
FFaceUsage := 0;
FUsePostscriptStyle:= false;
FDestroyListeners := nil;
FFilename := '';
end;
destructor TFontCollectionItem.Destroy;
begin
NotifyDestroy;
if FSourceStreamOwned then FSourceStream.Free;
if FFaceUsage <> 0 then
begin
TT_Close_Face(FFace);
@ -297,7 +316,10 @@ end;
function TFontCollectionItem.CreateFont: TFreeTypeFont;
begin
result := TFreeTypeFont.Create;
result.Name := Filename;
if FSourceStream <> nil then
result.AccessFromStream(FSourceStream,False)
else
result.Name := Filename;
end;
function TFontCollectionItem.QueryFace(AListener: TFontCollectionItemDestroyListener): TT_Face;
@ -305,7 +327,10 @@ var errorNum: TT_Error;
begin
if FFaceUsage = 0 then
begin
errorNum := TT_Open_Face(Filename,FFace);
if FSourceStream <> nil then
errorNum := TT_Open_Face(FSourceStream,false,FFace)
else
errorNum := TT_Open_Face(Filename,FFace);
if errorNum <> TT_Err_Ok then
raise exception.Create('Cannot open font (TT_Error ' + intToStr(errorNum)+')');
end;
@ -806,6 +831,37 @@ begin
end;
end;
function TFreeTypeFontCollection.AddStream(AStream: TStream; AOwned: boolean): boolean;
var info: TFreeTypeInformation;
fName: string;
item: TFontCollectionItem;
f: TFamilyCollectionItem;
begin
result := false;
BeginUpdate;
try
FTempFont.AccessFromStream(AStream,False);
fName := FTempFont.Family;
if fName <> '' then
begin
f := AddFamily(fName);
item := TFontCollectionItem.Create(AStream,AOwned);
FFontList.Add(item);
with item do
begin
VersionNumber:= FTempFont.VersionNumber;
for info := low(TFreeTypeInformation) to high(TFreeTypeInformation) do
Information[info] := FTempFont.Information[info];
end;
f.AddFont(item);
result := true;
end;
finally
FTempFont.Name := '';
EndUpdate;
end;
end;
procedure TFreeTypeFontCollection.EndUpdate;
begin
if FUpdateCount > 0 then