dengan menggunakan icon drag interaktif. listbox didesain sebagai suatu pilihan dalam beberapa pilihan.
tapi kali ini kita akan membuat pengaturan list yang diurutkan sesuai pilihan...
langsung saja ya. desain form sesuai dengan gambar disamping.
listing code dan penjelasannya:
'-----------------------------------------------------------------------------
Option Explicit
'pendeklarasian fungsi yang akan dipanggil dalam program ini
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 mintDragIndex As Integer
'-----------------------------------------------------------------------------
Private Sub Form_Load()
'-----------------------------------------------------------------------------
'digunakan dalam perulangan item di lis1
Dim intX As Integer
For intX = 1 To 100
List1.AddItem "Item" & intX
Next
'untuk berikutmya
End Sub
'-----------------------------------------------------------------------------
'dibawah ini untuk listing penggunaan mouse
Private Sub List1_MouseDown(Button As Integer, _
Shift As Integer, _
X As Single, _
Y As Single)
'-----------------------------------------------------------------------------
'dibawah ini proses mengurutkan dari index terbawah terlebih dahulu
mintDragIndex = ListRowCalc(List1, Y)
List1.Drag
End Sub
'-----------------------------------------------------------------------------
'code dalam drag agar tetap pada listbox
Private Sub List1_DragOver(Source As Control, _
X As Single, _
Y As Single, _
State As Integer)
'-----------------------------------------------------------------------------
List1.ListIndex = ListRowCalc(List1, Y)
End Sub
'-----------------------------------------------------------------------------
Private Sub List1_DragDrop(Source As Control, _
X As Single, _
Y As Single)
'-----------------------------------------------------------------------------
ListRowMove Source, mintDragIndex, ListRowCalc(Source, Y)
End Sub
'-----------------------------------------------------------------------------
Public Function ListRowCalc(pobjLB As ListBox, ByVal Y As Single) As Integer
'-----------------------------------------------------------------------------
Const LB_GETITEMHEIGHT = &H1A1
Dim intItemHeight As Integer
Dim intRow As Integer
intItemHeight = SendMessage(pobjLB.hwnd, LB_GETITEMHEIGHT, 0, 0)
intRow = ((Y / Screen.TwipsPerPixelY) \ intItemHeight) + pobjLB.TopIndex
If intRow < pobjLB.ListCount - 1 Then
ListRowCalc = intRow
Else
ListRowCalc = pobjLB.ListCount - 1
End If
End Function
'-----------------------------------------------------------------------------
Public Sub ListRowMove(pobjLB As ListBox, _
ByVal pintOldRow As Integer, _
ByVal pintNewRow As Integer)
'-----------------------------------------------------------------------------
Dim strSavedItem As String
Dim intX As Integer
If pintOldRow = pintNewRow Then Exit Sub
strSavedItem = pobjLB.List(pintOldRow)
If pintOldRow > pintNewRow Then
For intX = pintOldRow To pintNewRow + 1 Step -1
pobjLB.List(intX) = pobjLB.List(intX - 1)
Next intX
Else
For intX = pintOldRow To pintNewRow - 1
pobjLB.List(intX) = pobjLB.List(intX + 1)
Next intX
End If
pobjLB.List(pintNewRow) = strSavedItem
End Sub
