文字列の均等割付 <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