● ドロップダウン時の表示行数を変える ●

ちょっとおめかしをしてあげましょう。隠し味。

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

'ウインドウにメッセージを送る
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'ウインドウの大きさを取得する
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

'ウインドウの位置とサイズを変更する
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const CB_GETITEMHEIGHT = &H154
Private Const SWP_NOMOVE = &H2

'---------------------------------------------------------------------
' 関数名: SetTongueNum
' 機能  : コンボボックスのリストボックスの表示項目数を増やす
' 引数  : (in) hWnd … コンボボックスのウインドウハンドル
'          (in) CmbRows … コンボボックスの表示項目数 (9〜255)
' 返り値: 1…正常終了   0…異常終了
'---------------------------------------------------------------------
Public Function SetTongueNum(ByVal hWnd As Long, ByVal CmbRows As Long) As Long

    Dim ItemHeight As Long   'コンボボックスのリストボックスの1アイテムの高さ
    Dim CBHeight As Long  '設定するコンボボックスのリストボックスの高さ
    Dim udtRECT As RECT   'RECT構造体

    '8以下、256以上であればエラー
    If CmbRows < 9 Or CmbRows > 255 Then Exit Function

    'コンボボックスのサイズ(Pixcel)を取得する
    Call GetClientRect(hWnd, udtRECT)

    'コンボボックスのリスト項目の高さを取得する
    ItemHeight = SendMessage(hWnd, CB_GETITEMHEIGHT, 0&, ByVal 0&)

    'リストボックスを含んだ全体のコンボボックスの高さを求める
    CBHeight = ItemHeight * CmbRows + udtRECT.Bottom + 2

    'コンボボックスの高さを変更する
    SetTongueNum = SetWindowPos(hWnd, 0&, 0&, 0&, udtRECT.Right, _
                             CBHeight, SWP_NOMOVE)

End Function

ほい、呼び出し側コード↓。

Private Sub Form_Load()

    '表示行数を11行にする
    Call SetTongueNum(Combo1.hWnd, 11)

    With Combo1
        .AddItem "ABCDEFGHIJK"
        .AddItem "ABDCEFGHI"
        .AddItem "ABDCEFGH"
        .AddItem "ABDCEFGHI"
        .AddItem "ABDCEFGHIZJKLMN"
        .AddItem "ABDCEFG"
        .AddItem "ABDCEFGHI"
        .AddItem "ABDCEFGH"
        .AddItem "ABDCEFGHIZJKLMNOPQR"
        .AddItem "ABDCEFG"
        .AddItem "ABDCEFGHIZJ"
        .AddItem "ABDCEFGHIZ"
        .AddItem "ABDCEFG"
        .AddItem "ABDCEFGHIZJKL"
    End With

End Sub


もう1つ↓

'ウインドウにメッセージを送る
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'ウインドウのサイズを変更する
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Private Const CB_SHOWDROPDOWN = &H14F

'---------------------------------------------------------------------
' 関数名: SetTongueNum
' 機能  : コンボボックスのリストボックスの表示項目数を増やす
' 引数  : (in) ctlCombo … コンボボックス
' 戻り値: 正常 : 1  エラー: 0
' 備考  : フォームの ScaleModeがVBPixels になっている必要がある
'---------------------------------------------------------------------
Public Function SetTongueNum(ByVal ObjCombo As ComboBox, _
                             ByVal CmbRows As Long) As Long

    Dim ItemHeight As Long

    With ObjCombo
        ItemHeight = SendMessage(.hWnd, CB_GETITEMHEIGHT, 0&, ByVal 0&)
        Call SendMessage(.hWnd, CB_SHOWDROPDOWN, 0&, ByVal 0&)
        SetTongueNum = MoveWindow(.hWnd, .Left, .Top, .Width, _
                                  .Height + ItemHeight * 12 + 2, False)
    End With

End Function

戻る