リストボックスでよく使用する設定集
 　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　玄関へお回り下さい。
指定の行を選択状態にする　　指定の行のデータを取得する         (143)
　　　　　　 Private Sub Command1_Click()
　　'指定の行を選択状態にする
　　List1.Selected(CInt(Text1.Text) - 1) = True
　　'指定行のデータを取得する
　　Label1.Caption = List1.List(CInt(Text1.Text) - 1)

　　'こちらの方が簡単かも
　　'Label1.Caption = List1.Text
End Sub
選択されているデータを取得する　　　　      (143)
　　　　 Private Sub Command2_Click()
　　'選択されているデータを取得する
　　Label2.Caption = List1.List(List1.ListIndex)

　　'こちらの方が簡単かも
　　'Label2.Caption = List1.Text
End Sub
指定行に項目を追加する        (143)
　　 Private Sub Command3_Click()
　　'指定行に項目を追加する
　　List1.AddItem "★10行目に新たに追加★", 10 - 1
End Sub
指定行の項目を書き変えます          (143)
　　 Private Sub Command4_Click()
　　'指定行の項目を書き変えます
　　List1.List(10 - 1) = "☆10行目を書換えました★"
End Sub
指定行の項目を削除します　　　　　      (143)
　　 Private Sub Command5_Click()
　　'指定行の項目を削除します
　　List1.RemoveItem 10 - 1
End Sub
指定行をトップ位置に設定します　　　　　      (143)
　　 Private Sub Command6_Click()
　　'指定行をトップ位置に設定します
　　List1.TopIndex = 10 - 1
End Sub
複数の項目を選択した場合の取得　　　　      (143)
　　 Private Sub Command7_Click()
'複数の項目を選択した場合の取得
　　Dim ICount As Integer
　　For ICount = 0 To List1.ListCount - 1
　　　　If List1.Selected(ICount) Then
　　　　　　Debug.Print List1.List(ICount), ICount + 1
　　　　End If
　　Next ICount
End Sub
選択した項目をクリップボードにコピー　　　　      (143)
　　 Private Sub Command10_Click()
　　'選択した項目をクリップボードにコピー
　　Dim intCount As Integer
　　Dim ListDate As String
　　With List1
　　　　Me.MousePointer = vbHourglass
　　　　DoEvents
　　　　.Visible = False
　　　　For intCount = 0 To .ListCount - 1
　　　　　　If (.Selected(intCount)) Then
　　　　　　　　ListDate = ListDate & .List(intCount) & vbCrLf
　　　　　　End If
　　　　Next intCount
　　　　.Visible = True
　　End With
　　'クリップボードを初期化
　　Clipboard.Clear
　　'クリップボードにコピー
　　Clipboard.SetText ListDate
　　Me.MousePointer = vbDefault
End Sub
複数の項目を指定位置に揃えて表示    (143)
   　　
Private Sub Command13_Click()
'複数の項目を指定位置に揃えて表示
　　With List2
　　　　.Visible = False
　　　　.FontName = "ＭＳ ゴシック"
　　　　.FontSize = 9
　　　　.AddItem StrCut("〒527-0011", 12) & StrCut("八日市市 12-12", 18) _
　　　　　　　　　　　　　　　　　　　　　& StrCut("蚊取 新語", 14)
　　　　.AddItem StrCut("〒547-0011", 12) & StrCut("大津市 12-1", 18) _
　　　　　　　　　　　　　　　　　　　　　& StrCut("木邑 多来也", 14)
　　　　.AddItem StrCut("〒555-0011", 12) & StrCut("彦根市 城町 1-15", 18) _
　　　　　　　　　　　　　　　　　　　　　& StrCut("草柳　強", 14)
　　　　.Visible = True
　　End With
End Sub


 StrCut 関数については、逆引きヘルプの　文字列を指定の幅にカット(漢字分断回避)
 （081） 参照して下さい。
エクスプローラーよりドラッグ・アンド・ドロップでファイル名を追加　　　(143)
　　 Private Sub Command14_Click()
'エクスプローラーよりドラッグ・アンド・ドロップ
　　If List1.OLEDropMode = vbOLEDropNone Then
　　　　'OLE ドロップ イベントを発生させます
　　　　List1.OLEDropMode = vbOLEDropManual
　　Else
　　　　'OLE ドロップを受け付けず
　　　　List1.OLEDropMode = vbOLEDropNone
　　End If
End Sub


Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, _
　　　　　　Button As Integer, Shift As Integer, x As Single, y As Single)
'ドロップされたファイル名を追加
　　Dim i As Integer
　　For i = 1 To Data.Files.Count
　　　　List1.AddItem Data.Files.Item(i), 0
　　Next
End Sub
以下の設定はAPI関数を使用しますので宣言セクションに下記のコードを
記入して下さい

Option Explicit　　 'SampleNo=143　WindowsXP VB6.0(SP5) 2002.05.25

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

'指定の項目の高さを取得する(P819)
Private Const LB_GETITEMHEIGHT = &H1A1

'指定の項目の高さを設定する(P827)
Private Const LB_SETITEMHEIGHT = &H1A0

’複数選択リストボックスの指定の項目を選択(P828)
Private Const LB_SETSEL = &H185
すべての項目を選択状態にする    選択状態を解除する　　　　　      (143)
　　 Private Sub Command11_Click()
　　Dim Ret As Long
　　'すべての項目を選択状態にする
　　Ret = SendMessage(List1.hWnd, LB_SETSEL, 1&, ByVal -1&)

　　'選択状態を解除する
　　Ret = SendMessage(List1.hWnd, LB_SETSEL, 0&, ByVal -1&)
End Sub
現在の行の高さを求める　　行の高さを設定する　　　　      (143)
　　 Private Sub Command9_Click()
　　Dim Ret As Long
　　'現在の行の高さを求める
　　Ret = SendMessage(List1.hWnd, LB_GETITEMHEIGHT, 0&, ByVal 0&)
　　'行の高さを現在より１０％高くする
　　Ret = SendMessage(List1.hWnd, LB_SETITEMHEIGHT, 0&, ByVal CLng(Ret * 1.1))
　　List1.Refresh
End Sub
リストボックスでよく使用する設定だが、忘れていたり、人に聞けないようなものを集めて見ました。
別途データの入力部分は作っておいて下さい。又複数選択する場合はプロパティの設定を下記の
　'List1.MultiSelect = 2　別途設定しておいて下さい　ように設定しておいて下さい。


　　




2002/05/25