Mega Code Archive
Fontinstall
<![CDATA[
INSTALLING FONTS IN WINDOWS USING DELPHI
HowTo:
You should copy the file to the Windows\Fonts directory,
then add an entry to the registry key:
"'Software\Microsoft\Windows\CurrentVersion\Fonts".
The entry will be the font name and the path (if different
than the Windows\Fonts directory). Once the registry entry
is written, you should make a call to the Windows API
function AddFontRecource(), then broadcast a system-wide
WM_FONTCHANGE message. Finally, you should make a call to
the Windows API function RemoveFontRecource(), to remove
the resource lock on the font file, and broadcast a second
system-wide WM_FONTCHANGE message.
Here is an example:
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg: TRegistry;
b : bool;
begin
CopyFile('C:\DOWNLOAD\FP000100.TTF',
'C:\WINDOWS\FONTS\FP000100.TTF', b);
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.LazyWrite := false;
reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Fonts',
false);
reg.WriteString('TESTMICR (TrueType)','FP000100.TTF');
reg.CloseKey;
reg.free;
{Add the font resource}
AddFontResource('c:\windows\fonts\FP000100.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
{Remove the resource lock}
RemoveFontResource('c:\windows\fonts\FP000100.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
******************************************************************
BUT one might also want to make sure one knows exactly 'where' the
Windows directory is as it may not be on the C:\ drive, and it MAY
not even be called 'Windows' -so
'Getting the windows directory'.
HowTo:
You can make a call to the Windows API function
GetWindowsDirectory().
If you want the system directory, simply call the Windows API function
GetSystemDirectory().
Example:
{$IFNDEF WIN32}
const MAX_PATH = 144;
{$ENDIF}
procedure TForm1.Button1Click(Sender: TObject);
var
a : Array[0..MAX_PATH] of char;
begin
GetWindowsDirectory(a, sizeof(a));
ShowMessage(StrPas(a));
GetSystemDirectory(a, sizeof(a));
ShowMessage(StrPas(a));
end;
(make sure also that there IS a fonts subdirectory under the
Windows dir..?).
*******************************************************************
AND, you might want to know if TrueType fonts are available on the
system, so
HowTo:
The following example should report if the TrueType engine is
available, enabled, and at least one TrueType font is installed:
function IsTrueTypeAvailable : bool;
var
{$IFDEF WIN32}
rs : TRasterizerStatus;
{$ELSE}
rs : TRasterizer_Status;
{$ENDIF}
begin
result := false;
if not GetRasterizerCaps(rs, sizeof(rs)) then exit;
if rs.WFlags and TT_AVAILABLE <> TT_AVAILABLE then exit;
if rs.WFlags and TT_ENABLED <> TT_ENABLED then exit;
result := true;
end;
****************************************************************
Possibly have an overall WToolkit.INI file with lines such as
DefaultFont=MS Times New Roman, 12, normal, normal
[check the correctness of attribute values]
Also margins info here...
]]>