tagCANDY CGI VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板 - Visual Basic 6.0 VB2005 VB2010
VB2005用トップページへVBレスキュー(花ちゃん)のトップページVB6.0用のトップページ
VBレスキュー(花ちゃん)の投稿サンプル用掲示板
     サンプル投稿用掲示板  VB2005 〜 用トップページ  VB6.0 用 トップページ
OptionButton Captionを1行で、最後を"..."で表示(VB6.0) ( No.0 )  [親スレッドへ]
日時: 2009/12/27 15:19
名前: 花ちゃん

***********************************************************************************
* カテゴリー:[文字列処理][コントロール共通][基本コード]                          *
* キーワード:長い文字を短く表示,省略文字,...,,ボタン,                            *
***********************************************************************************

元質問:OptionButton Caption表示について - あやめ 2003/01/30-13:23 No.2468
Styleを"1-グラフィックス"で設定したボタン状のOptionButtonに
Width値よりも長い文字列をCaptionへ設定すると、複数行で表示されます。
このCaptionを1行で下記のように表示する方法はありますか?
    ┌────┐    ┌────┐
    │AAAAAAAA│    │        │
    │AAAAAAAA│ → │AAAAA...│
    │AAAAAAAA│    │        │
    └────┘    └────┘

------------------------------------------------------------------------------------
Re^6: OptionButton Caption表示について - 花ちゃん 2003/01/31-00:45 No.2488
------------------------------------------------------------------------------------
こちらのサンプルと差換えて下さい。
WinXP と Win9x 系ではフォントが違いますので注意が必要です。
Margin のサイズを大きく取る等して調整して下さい。

Option Explicit

Private Sub Form_Resize()
    Dim Opt1Width As Long
    Dim Com1Width As Long
    Opt1Width = Form1.Width - 4000
    Com1Width = Form1.Width - 4000
    
    If Opt1Width < 1000 Then
        Opt1Width = 1000
        Com1Width = 1000
    End If
    If Opt1Width > 3000 Then
        Opt1Width = 3000
        Com1Width = 3000
    End If
    Option1.Width = Opt1Width
    Command1.Width = Com1Width
    
    'fGetTextWidth 関数の使用例
    Option1.Caption = fSetCaption(Option1, "OptionボタンのCaption名", 300)
    Command1.Caption = fSetCaption(Command1, "CommandボタンのCaption名", 300)
End Sub

Private Function fSetCaption(MyControl As Control, _
                ByVal myString As String, ByVal Margin As Long) As String

    Dim meFontSize As Single, BakString  As String
    Dim meFontName As String, ScaleMode1 As Long
    Dim meFontBold As Boolean, LoopCount As Long
    Dim WidTwips   As Long
    BakString = "・・・"
    With Me
        '元のフォントの設定を取得
        ScaleMode1 = .ScaleMode
        meFontSize = .FontSize
        meFontName = .FontName
        meFontBold = .FontBold
        '現在使用のフォントを設定
        .ScaleMode = vbTwips
        .FontSize = MyControl.FontSize
        .FontName = MyControl.FontName
        .FontBold = MyControl.FontBold
        DoEvents
        '文字列長を取得
        For LoopCount = 1& To Len(myString)
            '元の長さ以上の場合
            If LoopCount = Len(myString) Then
                fSetCaption = myString
                Exit For
            End If
            WidTwips = Me.TextWidth(Left$(myString, LoopCount) & BakString)
            'ちょうど良いサイズが見つかった場合
            If WidTwips > (MyControl.Width - Margin) Then
                fSetCaption = Left$(myString, LoopCount) & BakString
                Exit For
            End If
        Next LoopCount
        'フォントの設定を元に戻す
        .ScaleMode = ScaleMode1
        .FontSize = meFontSize
        .FontName = meFontName
        .FontBold = meFontBold
    End With
End Function




 [スレッド一覧へ] [親スレッドへ]