コンボボックスのドロップダウンリスト項目数を変更する(VB6.0)

　下記プログラムコードに関する補足・注意事項　
動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6)
Option　：[Option Explicit]
参照設定：
使用 API：SendMessage
その他　：このサンプルは、 Win32 APIを使用しておりますので、ある程度Win32 API が理解できる方がお使い下さい。
　　　　：

Win32 API とは
　Win32 Application Programming Interfaces の略で、32bit プロセッサで動作する Windows
95 等、以降用に対応するアプリケーションの開発者のために、公開されている関数を指します。
尚、Visual Basic 2010 等の .NET 系のバージョンや VBA からも使用する事ができます。
　ここでは、略して Win32 API　とか　Win32 API 関数とか表示スペースの関係から　API　と表記する場合があります。

１．コンボボックスのドロップダウンリスト項目数を変更する

Option Explicit　　 'SampleNo=149　WindowsXP VB6.0(SP5) 2002.06.16

'指定のウィンドウにメッセージを送る(P750)
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

'項目の高さを取得する(P784)
Private Const CB_GETITEMHEIGHT = &H154

'ウィンドウの位置・サイズを変更する(P96)
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 Sub Form_Load()
　　Dim i As Long
　　For i = 1 To 30
　　　　Combo1.AddItem Format$(i, "@@　 ") & "VBレスキュー-(花ちゃん)"
　　　　Combo2.AddItem Format$(i, "@@　 ") & "VBレスキュー-(花ちゃん)"
　　Next i
End Sub

Private Sub Combo1_DropDown()
　　'ドロップダウンリストの表示項目数を12に設定
　　Call sCBDropDownListItem(Combo1, 12)
End Sub

Private Sub sCBDropDownListItem(CBControl As Control, Item As Long)
　　Dim CBHeight　As Long
　　Dim Result　　As Long
　　Dim DefaultSM As Long
　　DefaultSM = Me.ScaleMode　　'現在のスケールモードを保存
　　Me.ScaleMode = vbPixels　　 'スケールモードをピクセルに
　　With CBControl
　　　　'項目の高さを取得
　　　　CBHeight = SendMessage(.hwnd, CB_GETITEMHEIGHT, 0&, ByVal 0&)
　　　　'12項目表示する場合の高さを求める
　　　　CBHeight = .Height + CBHeight * Item + 2
　　　　'コンボボックスの高さを変更
　　　　Result = MoveWindow(.hwnd, .Left, .Top, .Width, CBHeight, 1&)
　　End With
　　Me.ScaleMode = DefaultSM　　'スケールモードを元に戻す
End Sub

'=====　コンテナー上のコンボボックスの場合　=====
Private Sub Combo2_DropDown()
　　'ドロップダウンリストの表示項目数を12に設定
　　Call sCBDropDownListItem1(Combo2, 12)
End Sub

Private Sub sCBDropDownListItem1(CBControl As Control, Item As Long)
　　Dim CBHeight　As Long
　　Dim Result　　As Long
　　Dim Ratio　　 As Long
　　'ピクセルあたりのtwip 数を取得
　　Ratio = Screen.TwipsPerPixelX
　　With CBControl
　　　　'項目の高さを取得
　　　　CBHeight = SendMessage(.hwnd, CB_GETITEMHEIGHT, 0&, ByVal 0&)
　　　　'12項目表示する場合の高さを求める
　　　　CBHeight = (.Height \ Ratio) + CBHeight * Item + 2
　　　　'コンボボックスの高さを変更
　　　　Result = MoveWindow(.hwnd, .Left \ Ratio, .Top \ Ratio, .Width \ Ratio, CBHeight, 1&)
　　End With
End Sub

　　上記実行結果(画像は合成しています。)
　

検索キーワード及びサンプルコードの別名(機能名)

ComboBox のドロップダウンリスト項目数を変更する

VBレスキュー(花ちゃん)

Visual Basic 6.0