文字列の均等割付          <TOP>


CreateFontIndirect 論理フォントを作成
SelectObject 指定されたデバイスコンテキストのオブジェクトを選択
TextOut 文字を描画
SetTextJustification システムがテキスト文字列内のブレーク文字に追加する間隔の量を指定
GetTextExtentPoint32 文字列全体の幅と高さを取得
GetClientRect ウィンドウのクライアント領域の座標を取得
lstrlen 指定された文字列のバイトまたは文字の長さを返す
GetDC デバイスコンテキストのハンドルを取得
ReleaseDC デバイスコンテキストを解放
 

 

'================================================================
'= 文字列の均等割付
'=    (SetTextJustification.bas)
'================================================================
#include "Windows.bi"

Type SIZE
    cx As Long                     '幅を指定
    cy As Long                     '高さを指定
End Type

Type RECT
    Left   As Long
    Top    As Long
    Right  As Long
    Bottom As Long
End Type

#define LF_FACESIZE 32

Type LOGFONT
    lfHeight            As Long    '文字セルまたは文字の高さ
    lfWidth             As Long    '平均文字幅
    lfEscapement        As Long    '文字送りの方向とX軸との角度
    lfOrientation       As Long    'ベースラインとX軸との角度
    lfWeight            As Long    'フォントの太さ
    lfItalic            As byte    'イタリック体指定
    lfUnderline         As byte    '下線付き指定
    lfStrikeOut         As byte    '打ち消し線付き指定
    lfCharSet           As byte    'キャラクタセット
    lfOutPrecision      As byte    '出力精度
    lfClipPrecision     As byte    'クリッピングの精度
    lfQuality           As byte    '出力品質
    lfPitchAndFamily    As byte    'ピッチとファミリ
    lfFaceName          As String * LF_FACESIZE 'フォント名
End Type

Type TEXTMETRIC
    tmHeight           As Long     'フォントの高さ
    tmAscent           As Long     'ベースラインから一番上までの高さ
    tmDescent          As Long     'ベースラインから一番下までの高さ
    tmInternalLeading  As Long     'tmHeightメンバが示す高さに含まれる、上部スペースの高さが格納
    tmExternalLeading  As Long     'フォントを描画する際の、行同士の幅
    tmAveCharWidth     As Long     'フォントの平均の幅
    tmMaxCharWidth     As Long     'フォントを描画する際もっとも広い幅
    tmWeight           As Long     'フォントの太さ
    tmOverhang         As Long     '太字やイタリック体などのフォントに付加される幅
    tmDigitizedAspectX As Long     'デバイス コンテキストの水平アスペクト値
    tmDigitizedAspectY As Long     'デバイス コンテキストの垂直アスペクト値
    tmFirstChar        As Byte     'フォントに含まれる文字中の、先頭の文字コード
    tmLastChar         As Byte     'フォントに含まれる文字中の、最後の文字コード
    tmDefaultChar      As Byte     'フォントに含まれない文字を描画するための文字コード
    tmBreakChar        As Byte     '単語と単語の間を示す文字コード
    tmItalic           As Byte     'フォントがイタリック体のときは 0 以外の値が、そうでないときは 0
    tmUnderlined       As Byte     '下線付きフォントのときは 0 以外の値が、そうでないときは 0
    tmStruckOut        As Byte     '打ち消しフォントのときは 0 以外の値が、そうでないときは 0
    tmPitchAndFamily   As Byte     '下位 4 ビットにフォントのピッチおよび属性
    tmCharSet          As Byte     'フォントの文字セット
End Type

' 論理フォントを作成
Declare Function Api_CreateFontIndirect& Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' 文字を描画
Declare Function Api_TextOut& Lib "gdi32" Alias "TextOutA" (ByVal hDC&, ByVal nXStart&, ByVal nYStart&, ByVal lpString$, ByVal cbString&)

' システムがテキスト文字列内のブレーク文字に追加する間隔の量を指定
Declare Function Api_SetTextJustification& Lib "gdi32" Alias "SetTextJustification" (ByVal hDC&, ByVal nBreakExtra&, ByVal nBreakCount&)

' 文字列全体の幅と高さを取得
Declare Function Api_GetTextExtentPoint32& Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hDC&, ByVal lpsz$, ByVal cbString&, lpSize As SIZE)

' ウィンドウのクライアント領域の座標を取得
Declare Function Api_GetClientRect& Lib "user32" Alias "GetClientRect" (ByVal hWnd&, lpRect As RECT)

' 指定された文字列のバイトまたは文字の長さを返す
Declare Function Api_lstrlen& Lib "Kernel32" Alias "lstrlenA" (ByVal lpString$)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

Var Shared Edit(1) As Object
Var Shared Radio(2) As Object
Var Shared Picture1 As Object
Var Shared Button1 As Object

Picture1.Attach GetDlgItem("Picture1")
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
For i = 0 To 2
    If i < 2 Then
        Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1)))
        Edit(i).SetFontSize 14
    End If
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i + 1)))
    Radio(i).SetFontSize 14
Next

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hDC As Long
    Var sz As SIZE
    Var rc As RECT
    Var lf As LOGFONT
    Var rFont As Long
    Var bCount As Long
    Var txt As String
    Var txt2 As String
    Var temp As String
    Var bc As String
    Var i As Integer
    Var Ret As Long

    Picture1.Cls

    lf.lfCharSet = 128                               '日本語(SHIFTJIS_CHARSET)
    lf.lfHeight = 16                                 '文字高さ設定
    lf.lfFaceName = Edit(1).GetWindowText & Chr$(0)  'デフォルト指定フォント名
    If Radio(1).GetCheck Then lf.lfWeight = 700      '太字
    lf.lfItalic = Radio(2).GetCheck                  '斜体

    txt = Edit(0).GetWindowText                      '均等割り付けする文字列

    '空白の有無によりブレーク文字の数を取得
    If InStr(txt, " ") = 0 Then
        For i = 1 To KLen(txt) - 1
            temp = KMid$(txt, i, 1)
            txt2 = txt2 & temp
            txt2 = txt2 & " "
            bCount = bCount + 1
        Next
        txt2 = txt2 & KRight$(txt, 1)
        txt = txt2
    Else
        For i = 1 To Len(txt)
            Temp = KMid$(txt, i, 1)
            If temp = " " then bCount = bCount + 1
        Next
    End If

    'デバイスコンテキストのハンドルを取得
    hDC = Api_GetDC(Picture1.GethWnd)

    '論理フォントの作成
    rFont = Api_CreateFontIndirect(lf)

    '指定されたデバイスコンテキストのオブジェクトを選択
    Ret = Api_SelectObject(hDC, rFont)

    'クライアント領域の座標を取得
    Ret = Api_GetClientRect(Picture1.GethWnd, rc)

    '文字列の論理単位を取得
    Ret = Api_GetTextExtentPoint32(hDC, txt, Api_lstrlen(txt), sz)

    'ブレーク文字に追加する間隔の量を取得
	Ret = Api_SetTextJustification(hDC, rc.Right - sz.cx, bCount)

    If Ret <> 0 Then
        'デバイスコンテキストに文字列を描画
        Ret = Api_TextOut(hDC, 0, 3, txt, Api_lstrlen(txt))
    End If

    'デバイスコンテキストの解放
    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End