VB6.0用掲示板の過去のログ(No.2)−VBレスキュー(花ちゃん)
[記事リスト] [新規投稿] [新着記事] [ワード検索] [管理用]

投稿日： 2005/04/13(Wed) 17:49
投稿者： 花ちゃん
Ｅメール：
ＵＲＬ：
タイトル： 下記をお試しあれ

Private Function GetFontSize(ByVal myString As String, _
                             ByVal ctlWid As Long, _
                             ByVal ctlHei As Long) As Single
    Dim fh(12) As Single, fw(12) As Single, FS(12) As Single, tw(12) As Integer
    Dim n  As Integer, i1 As Long, i As Single, j As Long
    Dim Ln As Integer, meFS As Single
    n = -1
    meFS = Me.FontSize
    '上下左右の余白分を考慮
    ctlWid = ctlWid - 0: ctlHei = ctlHei - 90
    For i = 6 To 15 Step 0.75  'フォントサイズの有効範囲
        Me.FontSize = i
        n = n + 1
        fw(n) = Me.TextWidth(myString)
        fh(n) = Me.TextHeight(myString)
        tw(n) = Me.TextHeight("あ")
        FS(n) = i
    Next i
    Me.FontSize = meFS
    For j = 8 To 4 Step -1 'フォントサイズ 9〜12
        For i1 = 1 To 4     '１行から４行までの表示の場合
            '折り返し時の表示できない分を半角１文字分考慮
            If fw(j) < (ctlWid - (tw(j) / 2)) * i1 Then
                If (ctlHei \ fh(j) >= i1) Then
                    '表示行数を取得
                  '  Ln = SendMessage(Text1.hWnd, EM_GETLINECOUNT, 0&, 0&)
                    'Text1.Height の自動調整する場合は下記のように
                  '  Text1.Height = (Ln * fh(j)) + 90
                    GetFontSize = FS(j)
                    Exit Function
                End If
            End If
        Next i1
    Next j
    If GetFontSize < 9 Then
        MsgBox "指定のフォントサイズで表示できません"
        GetFontSize = 3
    End If
End Function
Private Sub Form_Load()
    Me.FontName = "ＭＳ Ｐゴシック"
    Me.FontSize = 9
    With Text1
        'テキストボックスのワードラップを抑止する
        Call SetNonWordWrap(.hWnd)
        .Width = 2000
        .Height = 1000
        .Text = ""
        .BorderStyle = 1
    End With
End Sub
Private Sub Text1_LostFocus()
    Text1.FontSize = GetFontSize(Text1.Text, 2000, 1000)
End Sub

- 関連一覧ツリー （★ をクリックするとツリー全体を一括表示します）
- 返信フォーム （この記事に返信する場合は下記フォームから投稿して下さい）

- VBレスキュー(花ちゃん) - - Web Forum -