フォント選択ダイアログ

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89

/*---------------------------------------------------------------------------
  フォント選択ダイアログ
											by hiroki
  getfont p1,p2								   HSP3.0
 
  p1 : フォント名を格納する文字列変数
  p2 : 文字情報を格納する配列型変数
 
      p2.0 = フォントサイズ
      p2.1 = フォントスタイル設定値の和
      p2.2 = 文字色 ($bbggrr)
 
	注:HSP3.0で使用できるもののみしか設定しておりません。
	   アンチエイリアス設定は、無意味のため除外しました。
----------------------------------------------------------------------------*/
 
#module "fontdialog"
#deffunc getfont var _fontname , array _font_info
    #uselib "comdlg32"
    #func ChooseFontA "ChooseFontA" sptr
 
    #define CF_EFFECTS            $00000100    ;色や修飾を有効
    #define CF_SCREENFONTS        $00000001    ;スクリーンフォント
 
    dim logfont,15                ;LOGFONT構造体
 
    dim chfont,15                ;CHOOSEFONT構造体
    chfont.0 = 60                ;構造体サイズ
    chfont.1 = hwnd                ;ウィンドウハンドル
    chfont.2 = 0                ;プリンタのHDC
    chfont.3 = varptr(logfont)    ;LOGFONT構造体ポインタ
    chfont.4 = 0                ;フォントサイズ (1/10)
    chfont.5 = CF_SCREENFONTS | CF_EFFECTS    ;初期化
    chfont.6 = 0                ;文字色
    chfont.7 = 0                ;フック関数値
    chfont.8 = 0                ;フック関数ポインタ
    chfont.9 = 0                ;ダイアログテンプレート
    chfont.10 = 0                ;ダイアログテンプレートオブジェクト
    chfont.11 = 0                ;スタイル文字列
    chfont.12 = 0                ;フォントタイプ
    chfont.13 = 0                ;フォントサイズ最小値
    chfont.14 = 0                ;フォントサイズ最大値
 
    ChooseFontA varptr(chfont)
    if stat=0 : return            ;キャンセルの場合statは0
 
    sdim _fontname_,33
    memcpy _fontname_,logfont.7,32
 
    _fontname = _fontname_        ;フォント名
    _font_info.0 = chfont.4/10    ;フォントサイズ (1/10 point〜)
    _font_info.1 = font_normal    ;フォントスタイル初期化
    _font_info.2 = chfont.6        ;フォントカラー ($bbggrr)
 
    if logfont.4>400 : _font_info.1 += font_bold            ;太字
    if peek(logfont.5,0)=1 : _font_info.1 += font_italic    ;斜線
    if peek(logfont.5,1)=1 : _font_info.1 += font_underline    ;下線
    if peek(logfont.5,2)=1 : _font_info.1 += font_strikeout    ;取消線
 
    return
#global
 
; S A M P L E
 
    dim font_info,3
 
    getfont fontname,font_info
    if stat=0 : stop            ;キャンセルの場合statは0
 
    //----------------------------------------------------------------------------------
    ; font_info.1 += font_antialias		;アンチエイリアス設定は、ユーザー側でよろしく
    ;									;Windows9xは対応してないし、WindowsXPは常に有効
    //----------------------------------------------------------------------------------
 
    font fontname , font_info.0 , font_info.1
 
    r=peek(font_info.2 , 0)
    g=peek(font_info.2 , 1)
    b=peek(font_info.2 , 2)
    color r,g,b
    mes "文字色　: "+r+","+g+","+b
    mes "フォント名: "+fontname
    mes "Font Size : "+font_info.0
    mes "太　さ　: "+(font_info.1 & 1)
    mes "斜　線  : "+(font_info.1 & 2)
    mes "下　線　: "+(font_info.1 & 4)
    mes "取消線　: "+(font_info.1 & 8)
    stop