[BlueLeaf1336]> PROGRAM> Natural Born Junk>

スクリーンフォント名称一覧取得

historyTOP

2002/10/29:作成

memoTOP

インストールされているフォントで、TFont.Nameに指定できる名称の一覧を取得する。

codeTOP

(*
    =================================================
    スクリーンフォント名称一覧を表示する。
    =================================================
*)
procedure GetScreenFonts(pResult: TStrings);
var
    i: integer;
begin
    //Screen変数から取り出す。
    pResult.Assign(Screen.Fonts);
    //縦書き用(?)フォントが気持ち悪いのでどける。
    for i := pResult.Count - 1 downto 0 do
    begin
        if Copy(pResult[i], 1, 1) = '@' then
        begin
            pResult.Delete(i);
        end;
    end;
end;

(*
    +++++++++++++++++++++++++++++++++++++++++++++++++++++++
    テスト
    +++++++++++++++++++++++++++++++++++++++++++++++++++++++
*)
procedure TForm1.Button10Click(Sender: TObject);
begin
    GetScreenFonts(Memo1.Lines);
end;

EOFTOP