首页  编辑  

字体的相似性

Tags: /超级猛料/Font.字体/   Date Created:

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', [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)