Previewing a font without installing it

[DelphiNCI]

Hello All ...

I want to preview a font without installing it into the system ... and i've
tried that stupid function AddFontResource for a couple of days and it did
not work , and even it did -as i understand from the help files- it will
indeed install a copy of the font into the system and i should remove it
useing RemoveFontResource. can any one help me with this ?

Thanks all
DelphiNCI

[Finn Tolderlund]

"DelphiNCI" <Delp...@msn.com> skrev i en meddelelse
news:3f5f05d4$1...@newsgroups.borland.com...

AddFontResource and RemoveFontResource works fine.
Here is a function from a test project of mine.
Supply the complete path/filename of the font and True to add the font.
Then you can use the font like any other fonts by setting Font.Name to the
font's name.And it has to be the font name, not the filename.
Call the efunction again with False to remove the font when done.

function LoadFont(sFontFileName: string; bLoadIt: boolean): boolean;
var
sFontRes: string;
begin
Result := True;
if bLoadIt then
begin
{Load the font.}
if FileExists(sFontFileName) then
begin
sFontRes := sFontFileName + #0;
if AddFontResource(@sFontRes[1]) = 0 then
Result := False
else
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
end
else
begin
{Unload the font.}
sFontRes := sFontFileName + #0;
Result := RemoveFontResource(@sFontRes[1]);
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
end;

--
Finn Tolderlund

[DelphiNCI]

Thank you Finn , that works great :)

[Nils Haeck]

Hi DelphiNCI,

Here's some code that I wrote for this problem.

I use it to "preview" any TTF file. The problem I had in this case is not
that AddFontResource does not work, but that I did not know the typeface
name up front. I devised this "hack" to get the typeface name from the
actual TTF file.

Note: AResource is the name of a temporary file, you can use any filename as
long as the file can be created in that location.

// Make a resource from TTF
Resb := CreateScalableFontResource(
0, // Hidden
pchar(AResource), // FON file
pchar(Filename), // TTF file
nil); // Path - not required
if Resb <> True then
raise Exception.Create('CreateScalableFontResource failed.');

// Now add the resource
Res := AddFontResource(pchar(AResource));
if Res = 0 then
raise Exception.Create('AddFontResource failed.');
try
// Parse the resource, get the typeface name
// How do we get to it?? Some hacking...
ATypeFace := '';
S := TFileStream.Create(AResource, fmOpenRead or fmShareDenyWrite);
try
// Copy resource to string
SetLength(AInfo, S.Size);
S.Read(AInfo[1], S.Size);
// Find FONTRES:
APos := Pos('FONTRES:', AInfo);
// This is followed by the font typeface name (null terminated)
if APos > 0 then
ATypeFace := PChar(@AInfo[APos + 8]);
finally
S.Free;
end;

// Here I make a very simple thumbnail preview (TBitmap) of the font

// Set bitmap size
PixelFormat := pf24bit;
Width := cTruetypeWidth;
Height := cTruetypeHeight;
with Canvas do begin

// Clear
Brush.Color := clWhite;
Brush.Style := bsSolid;
FillRect(Rect(0, 0, Width, Height));

// Draw
Font.Name := cAnnotateFont;
Font.Size := 12;
YPos := 1;
TextOut(1, YPos, ATypeFace);
inc(YPos, TextHeight(ATypeFace));
// Draw samples
Font.Name := ATypeFace;
Font.Size := cSampleFontSize;
for i := 0 to cSampleLineCount - 1 do begin
TextOut(1, YPos, cSampleLines[i]);
inc(YPos, TextHeight(cSampleLines[i]));
end;

end;

finally
// Delete resource
Resb := RemoveFontResource(pchar(AResource));
if Resb <> True then
raise Exception.Create('RemoveFontResource failed.');
end;

Hope that helps,

Nils Haeck
www.abc-view.com

"DelphiNCI" wrote in message news:3f5f05d4$1...@newsgroups.borland.com...