- 日時: 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
|