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:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:

{
  unit zum Installiern/Deinstallieren von Schriftarten
  ====================================================
  Name:        Kroko
  Version:     1.0
  Datum:       05.01.2007
  DV:          Turbo-Delphi
}
unit tdFont;

interface

{ registert Font-Datei }
function AddFont (const AFontFileName: String): Boolean;
{ löscht Font-Datei-Registrierung }
function DeleteFont (const AFontFileName: string): Boolean;

type
TFontResBuffer = record
    Buffer: PChar;
    Fraktur: THandle;
    Size: Integer;
  end;

{ registriert Font aus Resource }
function AddFontFromRes (const ResName: PChar; var Buffer: TFontResBuffer): Boolean;
{ löscht Font aus Resource-Registrierung }
function DeleteFontFromRes (const Buffer: TFontResBuffer): Boolean;

implementation

uses
  Classes, Windows, Messages;

{----------------------}
{ registert Font-Datei }
{----------------------}
function AddFont (const AFontFileName: String): Boolean;
begin
  Result := AddFontResource(PChar(AFontFileName))<>0;
  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
end;
{---------------------------------}
{ löscht Font-Datei-Registrierung }
{---------------------------------}
function DeleteFont (const AFontFileName: String): Boolean;
begin
  Result := RemoveFontResource(PChar(AFontFileName));
  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
end;
{ registriert Font aus Resource }
function AddFontFromRes (const ResName: PChar; var Buffer: TFontResBuffer): Boolean;
var
  Res : TResourceStream;
  ResFontCount: DWord;
begin
  Res := TResourceStream.Create(hInstance, ResName, 'RT_FONT');
  try
    Buffer.Size := Res.Size + 1;
    Buffer.Buffer  := AllocMem(Buffer.Size);
    Res.Read(Buffer.Buffer^, Buffer.Size);
  finally
    Res.Free;
  end;
  ResFontCount := 1;
  Buffer.Fraktur := AddFontMemResourceEx(Buffer.Buffer, Buffer.Size, nil, @ResFontCount);
  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
  Result := Buffer.Fraktur<>0;
end;
{----------------------------------------}
{ löscht Font aus Resource-Registrierung }
{----------------------------------------}
function DeleteFontFromRes (const Buffer: TFontResBuffer): Boolean;
begin
  FreeMem(Buffer.Buffer, Buffer.Size);
  Result := RemoveFontMemResourceEx(Buffer.Fraktur);
  SendMessage(HWND_BROADCAST,WM_FONTCHANGE,0,0);
end;

end.