４．リストボックス(ListBox)でマウスのドラッグ・アンド・ドロップで行の移動

１．リストボックス(ListBox)でマウスのドラッグ・アンド・ドロップで行の移動 ２．　 ３．　 ４．　 ５．　 ６．

下記プログラムコードに関する補足・注意事項　 動作確認：Windows Vista・Windows 7 (32bit) / VB6.0(SP6) Option　：[Option Explicit] 参照設定：MyWaitDll 　　　　　　　　　　　　　参照設定方法参照 使用 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　と表記する場合があります。

１．リストボックス(ListBox)でマウスのドラッグ・アンド・ドロップで行の移動

FormにListBoxを貼り付けておいて下さい。又、ドラッグ・ドロップ用のマウスアイコンをご用意下さい。 Option Explicit　　 'SampleNo=148　WindowsXP VB6.0(SP5) 2002.06.16 'リストボックス中の指定されたポイントでアイテムの指標を検索する Private Declare Function LBItemFromPt Lib "comctl32" _ 　　(ByVal hLB As Long, ByVal x As Long, ByVal y As Long, _ 　　 ByVal bAutoScroll As Long) As Long '位置座標を受け取る構造体 Private Type POINTAPI 　　x As Long 　　y As Long End Type '現在のマウスカーソルの位置座標を取得する(P387) Private Declare Function GetCursorPos Lib "user32" _ 　　(lpPoint As POINTAPI) As Long Private MouseDrg As Integer　　 'マウスのドラッグ状況 Private DrgStr　 As String　　　'移動元のデータ Private XPos　　 As Long　　　　'ドラッグ開始位置座標 Private YPos　　 As Long　　　　'ドラッグ開始位置座標 Private oldIndex As Long　　　　'元の行の位置 Private NewIndex As Long　　　　'現在の行の位置 Private TmpIndex As Long　　　　'事前の行の位置 Private Sub Form_Load() 　　List1.AddItem "1　　マウスのドラッグ&ドロップで" 　　List1.AddItem "2　　選択行の移動ができます。" 　　List1.AddItem "3　　現在の行の下側に挿入されます。" 　　List1.AddItem "4　　先頭行に移動したい場合は上側の" 　　List1.AddItem "5　　枠外にドロップして下さい。" End Sub Private Sub List1_MouseDown(Button As Integer, _ 　　　　　　　　　　　　　　 Shift As Integer, x As Single, y As Single) 'マウスの左ボタンが押された場合 　　If MouseDrg = 0 And Button = 1 Then 　　　　XPos = x　　　　'マウス座標 　　　　YPos = y　　　　'マウス座標 　　　　MouseDrg = 1　　'ドラッグの開始 　　End If End Sub Private Sub List1_MouseMove(Button As Integer, _ 　　　　　　　　　　　　　　 Shift As Integer, x As Single, y As Single) 'マウスのドラッグ中の処理 　　If MouseDrg = 2 Then 　　　　Dim MPos As POINTAPI 　　　　GetCursorPos MPos　　　 '現在のマウス座標を取得 　　　　'そのマウス座標から行位置を取得 　　　　NewIndex = LBItemFromPt(List1.hWnd, MPos.x, MPos.y, False) 　　　　If NewIndex <> -1 Then　　　　　　　　　'選択行位置が取得できたら 　　　　　　List1.Selected(NewIndex) = True　　 '正常位置の場合 　　　　　　TmpIndex = NewIndex 　　　　Else 　　　　　　List1.Selected(TmpIndex) = False　　'異常位置の場合 　　　　End If 　　End If 　　'左ボタンを押したままマウスが移動した場合 　　If MouseDrg = 1 And (YPos <> y Or XPos <> x) Then 　　　　With List1　　　'移動するデータと移動行を取得 　　　　　　'マウスアイコンを変更(各自用意して下さい) 　　　　　　Set .MouseIcon = LoadPicture("..\DRAG1PG.ICO") 　　　　　　DrgStr = .List(.ListIndex) 　　　　　　oldIndex = .ListIndex 　　　　　　If oldIndex < 0 Or oldIndex > .ListCount - 1 Then 　　　　　　　 MouseDrg = 0 　　　　　　　 Exit Sub 　　　　　　End If 　　　　End With 　　　　MouseDrg = 2　　'ドラッグ中のフラグ 　 End If End Sub Private Sub List1_MouseUp(Button As Integer, _ 　　　　　　　　　　　　　 Shift As Integer, x As Single, y As Single) 'ドロップされた場合の処理 　　If MouseDrg = 2 Then 　　　　If NewIndex = -1 And TmpIndex = 0 Then 　　　　　　NewIndex = 0　　　　　　　　'上の枠外にドロップされた場合 　　　　ElseIf NewIndex = -1 And TmpIndex > 0 Then 　　　　　　NewIndex = TmpIndex + 1　　 '下の枠外にドロップされた場合 　　　　Else 　　　　　　NewIndex = NewIndex + 1　　 '通常位置にドロップの場合 　　　　End If 　　　　'マウスアイコンを変更(各自用意して下さい) 　　　　Set List1.MouseIcon = LoadPicture("..\Drop1pg.ico")　　'アイコンを変更 　　　　List1.AddItem DrgStr, NewIndex　　　　　　　　　'移動先に書込み 　　　　If NewIndex - 1 < oldIndex Then 　　　　　　oldIndex = oldIndex + 1　　 '先頭側に移動した場合の位置の補正 　　　　End If 　　　　List1.RemoveItem (oldIndex)　　 '移動元のデータを削除 　　　　'アイコンを表示しないなら必要はありません。 　　　　Wait 300　　　　　　　　　　　　'ドロップアイコンを少しの間表示 　　　　MouseDrg = 0 　　　　Set List1.MouseIcon = LoadPicture() 　　Else 　　　　MouseDrg = 0 　　　　Set List1.MouseIcon = LoadPicture() 　　　　DoEvents 　　End If End Sub 通常は同一リストボックス内でのドラッグ・アンド・ドロップは出来ません。 出来ないとなると何とかしてみたいと思うのは、プログラマ（実はアマグラマ）の習性でしょうか？そこで、チョコット工夫をして実現して見ました。工夫したと言っても、マウス位置のアイテムNoを取得して、それを移動先に追加書き込みし、元のアイテムを削除しているだけですが。 例によって十分なエラーチェックをしておりませんので、ご使用環境・状況によっては満足な動作をしない場合があるかも知れません。

２．

３．

４．

５．

６．

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

リストボックスに関するサンプル集　ListBoxに関するサンプル集