| 投稿日 | ： 2003/01/31(Fri) 00:45 |
| 投稿者 | ： 花ちゃん |
| Ｅメール | ： |
| ＵＲＬ | ： |
| タイトル | ： Re^6: OptionButton Caption表示について |
こちらのサンプルと差換えて下さい。
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