如何取得系统字体大小的列表，我想做一个选字体大小的下拉框？

Question

如何取得系统字体大小的列表，我想做一个选字体大小的下拉框？

Answer 1

如果不想自已编码，可以找第三方组件，昆腾/RAIZE都可以，
WWW。51DELPHI。COM里有下载

Answer 2

如果自己做，用下面的程序：
放置1个button1 和 listbox1,
procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
  str:string;
begin
listbox1.Items.Clear;
for i:=0 to screen.fonts.Count-1 do
    begin
    str:=screen.fonts.strings[i];
    if str[1]<>'@' then
       begin
       if ord(str[1])>=128 then
          begin
          Listbox1.Items.Add(str);
          continue;
          end;
       end
       else
       begin
       if ord(str[2])>=128 then
          begin
          Listbox1.Items.Add(str);
          continue;
          end;
       end;    end;
end;

Answer 3

得到字体大小，楼主自己研究一下吧：以下的函数GetFontSizeList用来取得字体名为FontName的字体的所有可用尺寸，而EnumFontsSize是其中要用到的字体枚举回调函数：function EnumFontsSize(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings( Data ).Add(IntToStr( LogFont.lfHeight) );
  Result := 1;
end;procedure GetFontSizeList( FontName : String; List : TStrings );
//FontName,是字体名；
//这种字体的所有可用尺寸将被填在List中。
var
  DC: HDC;
begin
  List.Clear;
  DC := GetDC(0);
 EnumFonts(DC, PChar(FontName), @EnumFontsSize, Pointer(List));
  ReleaseDC(0, DC);
end;///////////////////////////////////////////////////////////////////
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;

Answer 4

我也想过这个问题呢！不过，不是太精确的话，自己学Windows的其他软件加入那些大小好象也行呢！