サンプル投稿用掲示板 VB2005 〜 用トップページ VB6.0 用 トップページ
- 日時： 2009/12/27 15:19
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[文字列処理][コントロール共通][基本コード] *
* キーワード：長い文字を短く表示,省略文字,...,,ボタン, *
***********************************************************************************
元質問：OptionButton Caption表示について - あやめ 2003/01/30-13:23 No.2468
Styleを"1-グラフィックス"で設定したボタン状のOptionButtonに
Width値よりも長い文字列をCaptionへ設定すると、複数行で表示されます。
このCaptionを１行で下記のように表示する方法はありますか？
┌────┐ ┌────┐
│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
 |
