みんなの掲示板

Private Sub Command1_Click()



    Dim mat As MAT2

    Dim uicharacter As Long

    Dim dsize As Long

    Dim pBMP() As Byte

    Dim gm As GLYPHMETRICS

    Dim Align As Integer

    Dim x, y As Integer

    Dim color As Integer

        

    With mat

    

        .eM11.Value = 1     '-1にすると左右反転

        .eM12.Value = 0

        .eM21.Value = 0

        .eM22.Value = 1     '-1にすると上下反転

    

    End With

    

    'GetGlyphOutlineは1文字ずつしか扱えません

    uicharacter = Asc("あ")

    

    'データ格納に必要なサイズを計算

    'フォントの種類、サイズ等はForm1のフォント設定に依存します

    dsize = GetGlyphOutline(Form1.hdc, uicharacter, GGO_GRAY4_BITMAP, gm, 0, Null, mat)

    

    '必要なサイズのメモリを確保

    ReDim pBMP(dsize)

    

    'アンチエイリアス付きの文字DIBデータを取得(1ピクセル=1バイト)

	'GGO_GRAY4_BITMAPだと、17階調(0〜16)のアンチエイリアスになります

    GetGlyphOutline Form1.hdc, uicharacter, GGO_GRAY4_BITMAP, gm, dsize, pBMP(0), mat

    

    '1行のバイト数を算出(4バイト境界になります)

    Align = CInt(((gm.gmBlackBoxX + 3) \ 4) * 4)

    

    '取得した文字DIBのアルファ値を利用してアンチエイリアス文字を1ピクセルずつ描画

    'ちゃんとした描画位置を計算するには、以下のサイト等の計算式を使用してください

    'http://home.att.ne.jp/yellow/hide_n/programming/tips08.html

    For y = 0 To gm.gmBlackBoxY - 1

    

        For x = 0 To gm.gmBlackBoxX - 1

        

            '色は白地に黒になります

            color = 255 - pBMP(y * Align + x) * (255 / 17)

            

            'Form1のScaleModeはピクセルにして下さい

            Form1.PSet (x, y), RGB(color, color, color)

            

        Next x

        

    Next y



End Sub