'お気に入りフォントリスト / ver. 0.50 / by Kabuneko 2000/05/25

proc main
    dim i, n, sel, file$, key$, line$, item$[55], list$[50]
    'リストファイルの指定
    file$ = @@QxDirectory$ + "\" + "l_font.lst"
    'ショートカットキー用文字
    key$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
    '履歴ファイルを読込む
    if dir$(file$) <> "" then
        n = 1
        open file$ for input as #1
        do until eof(1)
            lineinput #1, line$
            list$[n++] = line$
            if n > 20 then exit do
        loop
        close #1
    end if
    'メニューアイテムの設定
    i = 1
    line$ = @FontName$ + chr$(&h09) + str$(@Fontsize)
    item$[i++] = "[ESC] 終了"
    item$[i++] = "-"
    if mid$(key$,1,1) <> "" then item$[i] = "&" + mid$(key$,1,1) + ". "
    item$[i] = item$[i++] + "リストにないものを選択"
    item$[i++] = "-"
    for n = 1 to 50
        if list$[n] = "" then exit for  'リストが終わるまで追加
        'ショートカットキー不足対策
        if not i-3 > len(key$) then item$[i] = "&" + mid$(key$,i-3,1) + ". "
        '現在の設定と同じものがあればチェックマーク
        if list$[n] = line$ then item$[i] = chr$(2) + item$[i]
        item$[i] = item$[i++] + list$[n]
    next
    item$[i] = "&" + mid$(key$,i-3,1) + " :  " + "【 リストファイル編集 】"
    'ポップアップメニューを表示・選択させる
    sel = popupmenu(item$)
    if sel < 3 then exit proc
    'リストにないフォルダを選択する場合
    if sel = 3 then
        @Font
        line$ = @FontName$ + chr$(&h09) + str$(@Fontsize)
        'すでにリストにある場合は追加しないで終了
        i = 1
        do while list$[i] <> ""
            if line$ = list$[i++] then exit proc
        loop
        open file$ for append as #1
            print #1, line$
        close #1
        exit proc
    end if
    if instr(item$[sel], "リストファイル編集") then
        call @@OpenFile(file$)
        exit proc
    end if
    n = instr(list$[sel-4], chr$(&h09))
    @FontName$ = mid$(list$[sel-4], 1, n-1)
    @FontSize = val(mid$(list$[sel-4], n+1))
end proc