字体的相似性

You need to get the font information, either a TLogfont (which given a font
handle, can ge filled using the API GetObject function) or a
TNewTextMetric, which is handed to your callback if you use
EnumFontFamiliesEx. The latter has a member tmPitchAndFamily (for a
TLogfont the equivalent is lfPitchAndFamily). Bits 4 to 7 of that encode
the font family, and that is what you want.
Case lfPitchAndFamily AND $F0 Of
FF_MODERN: family := 'modern';
FF_SWISS: family := 'swiss';
FF_ROMAN: family := 'roman';
FF_SCRIPT: family := 'script';
...
See win32.hlp topic LOGFONT for a full list.
var
lf: TLogFont;
begin
FillChar( lf, sizeof(lf), 0 );
Windows.GetObject( somefont.handle, sizeof(lf), @lf );
　
That is the easiest way to get the information if you have set up a TFont
with the font name and charset.
I have
modified an old example for the test. Just drop two listboxes on a form and add
handlers for the forms OnCreate and listbox1's onclick events.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, stdctrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
listbox1.items.assign( screen.fonts );
end;
Function EnumProc( Var elf: TEnumLogFont;
Var ntm: TNewTextmetric;
fonttype: Integer;
listbox: TListbox ): Integer; stdcall;
Var
S: String;
Begin
If fonttype = TRUETYPE_FONTTYPE Then Begin
listbox.Items.Add( Format( 'Name: %s', [elf.elfFullName] ));
listbox.Items.Add( Format( 'Style: %s', [elf.elfStyle] ));
End
Else
listbox.Items.Add( Format( 'Name: %s', [elf.elfLogfont.lfFacename] ));
listbox.Items.Add( Format( 'Size: %d', [elf.elfLogFont.lfHeight] ));
listbox.Items.Add( Format( 'Weight: %d', [elf.elfLogFont.lfWeight] ));
If elf.elfLogFont.lfItalic <> 0 Then
listbox.Items.Add('This font is italic');
Case fonttype of
DEVICE_FONTTYPE: S:= 'device font';
RASTER_FONTTYPE: S:= 'raster font';
TRUETYPE_FONTTYPE: S:= 'truetype font'
Else
S:= 'unknown font type';
End;
listbox.Items.Add( Format( 'This is a %s', ));
listbox.items.add( format('Font Family: $%s',
[inttohex(elf.elflogfont.lfPitchAndFamily, 2)]));
Result := 1;
End;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
listbox2.clear;
With listbox1 Do
If ItemIndex >= 0 Then
EnumFontFamilies(
Self.Canvas.Handle,
PChar( Items[ItemIndex] ),
@EnumProc,
Longint( listbox2 ));
end;
end.
end.
--
Peter Below (TeamB)