windows系统字体问题

1、列出系统所有字体,直接从全局变量Screen中读取:Screen.Fonts

2、磅和字号的关系:  

磅    字号

5     八号

5.5   七号

6.5   小六号

7.5   六号

9     小五号

10.5  五号

12    小四号

14    四号

15    小三号

16    三号

18    小二号

22    二号

24    小一号

26    一号

36    小初号

42    初号

3、列出字体的字号:

Try this:(it's from LMD TFontsizeCombobox) 

var
 Form1: TForm1;
  VRES:Integer;

const
 MaxStdSizes=16;

function EnumFontFamiliesProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
 FontType: Integer; Data:Pointer): Integer; {$IFDEF WIN32} stdcall; {$ELSE} export; {$ENDIF}

 procedure AddToList(const aValue:String);
 var
   j:Integer;
   c:Boolean;
 begin
   j:=0;
   c:=False;
   with TListBox(Data) do
     begin
       while (j<Items.Count) and not c do
         if StrToInt(aValue)>=StrToInt(Items[j]) then Inc(j) else c:=True;
       Items.Insert(j, aValue);
     end;
 end;

var
 i:Integer;
 c:String;
const
 csizes:array[0..MaxStdSizes-1] of Integer=(8,9,10,11,12,14,16,18,20,22,24,26,28,36,48,72);

begin
 result:=0;
 with TListBox(Data) do
   begin
     if (FontType and TRUETYPE_FONTTYPE=TRUETYPE_FONTTYPE) or (FontType in [0,2]) then
       begin
         For i:=0 to (MaxStdSizes-1) do Items.Add(IntToStr(Csizes[i]));
         result:=0
       end;

     if (FontType and RASTER_FONTTYPE=RASTER_FONTTYPE)
     {or (FontType and DEVICE_FONTTYPE=DEVICE_FONTTYPE)} then
       with TextMetric do
         begin
           c:=IntToStr(Round((tmHeight-tmInternalLeading)*72 / VRES));
           if Items.IndexOf(c)=-1 then AddToList(c);
           result:=1;
         end;
   end
end;

procedure TForm1.DoList(FFontName:String);
var
   buffer:array[0..255] of Char;
  DC:HDC;
 begin
  ListBox1.Items.Clear;

   DC:=GetDC(0);
   StrPCopy(Buffer, FFontName);
   vres:=GetDeviceCaps(DC, LOGPIXELSY);
   EnumFontFamilies(DC, Buffer, @EnumFontFamiliesProc,
                    LongInt(ListBox1));
    ReleaseDC(0, DC);
 end; 

原文地址:https://www.cnblogs.com/railgunman/p/1844675.html