VB6 DataGrid: Mengatur Tinggi Listitem Dropdown

Membahas hal yang kurang penting mengenai cara mengatur tinggi Listitem pada dropdown datagrid. Seperti biasa menggunakan fungsi API SendMessage yang bisa dilihat penjelasannya disini, kemudian beberapa konstanta ListBox yang bisa Anda lihat penjelasannya disini, serta konstanta ComboBox yang bisa Anda lihat penjelasannya disini.

Option Explicit 
 
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 Const LB_SETITEMHEIGHT = &H1A0 
Private Const CB_SETITEMHEIGHT = &H15 
 
Private Sub SetListItemHeight(ctrl As Control, ByVal newHeight As Long) 
    Dim uMsg As Long 
    If TypeOf ctrl Is ListBox Then 
        uMsg = LB_SETITEMHEIGHT 
    ElseIf TypeOf ctrl Is ComboBox Then 
        uMsg = CB_SETITEMHEIGHT 
    Else 
        Exit Sub 
    End If 
    SendMessage ctrl.hwnd, uMsg, 0, ByVal CLng(newHeight And &HFFFF&) 
    ctrl.Refresh 
End Sub 

Contoh penggunaan:

Private Sub Command1_Click() 
    SetListItemHeight List1, 25 
End Sub 
 
Private Sub Form_Load() 
    Dim i As Integer 
    For i = 1 To 10 
        List1.AddItem i 
    Next 
End Sub 
 

Sehingga hasilnya:

Gambar: Dropdown DataGrid dengan Tinggi Normal

Kemudian: 

Gambar: Dropdown DataGrid dengan Listitem yang Diperbesar (otomatis mengikuti row height datagrid).

READ MORE - VB6 DataGrid: Mengatur Tinggi Listitem Dropdown

VB6 DataGrid - Auto Height DropDown DataGrid

Dengan mengetahui tinggi item sebuah ListBox seperti yang telah dijelaskan pada posting sebelumnya, maka ada banyak sekali variant code yang bermanfaat yang bisa dikembangkan, salah satunya adalah mengatur tinggi dropdown datagrid secara otomatis. Hal ini sebenarnya bukan masalah apabila item yang terdapat pada ListBox jumlahnya tetap Anda dapat mengatur tinggi ListBoxnya secara manual, tetapi bagaimana jika dinamis? terkadang 1 item, 2 item, 5 item, dsb.  Jangan sampai terjadi seperti gambar di bawah ini:

Gambar - DropDown DataGrid tanpa Auto Heigh

Padahal tinggi DropDown ListBox seharusnya seperti gambar di bawah ini:

Gambar - DropDown DataGrid dengan Auto Height

Option Explicit 
 
'------------------------------------------------------------------------------------------ '
'http://khoiriyyah.blogspot.com 
'------------------------------------------------------------------------------------------  
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long 
Private Const LB_GETITEMRECT As Long = &H198 
 
Private Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
 
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long 
 
Private Const SM_CXBORDER = 5 'flat 
Private Const SM_CYBORDER = 6 'flat  
Private Const SM_CXEDGE = 45 '3D 
Private Const SM_CYEDGE = 46 '3D   
  
Private Function ListBoxItemHeight(lst As ListBox) As Integer 
    Dim rc As RECT, I As Long, dy As Long 
    If lst.ListCount = 0 Then Exit Function 
    SendMessage lst.hWnd, LB_GETITEMRECT, ByVal 0&, rc 
    dy = rc.Bottom - rc.Top 
    ListBoxItemHeight = (dy * Screen.TwipsPerPixelY) 
End Function 
 
Private Sub cmdTest_Click() 
    List1.Visible = False 
    List1.AddItem "A" 
    Dim BorderHeight As Integer 
    If List1.ListCount > 8 Then 
        List1.Visible = True 
        Exit Sub 
    End If 
    If List1.Appearance = 0 Then 'flat         
        BorderHeight = (GetSystemMetrics(SM_CXBORDER) * Screen.TwipsPerPixelX) + (GetSystemMetrics(SM_CYBORDER) * Screen.TwipsPerPixelY) 
    ElseIf List1.Appearance = 1 Then '3D         
        BorderHeight = (GetSystemMetrics(SM_CXEDGE) * Screen.TwipsPerPixelX) + (GetSystemMetrics(SM_CYEDGE) * Screen.TwipsPerPixelY) 
    End If 
    List1.Height = (ListBoxItemHeight(List1) * List1.ListCount) + BorderHeight 
    Debug.Print ListBoxItemHeight(List1) 
    Debug.Print List1.Height 
    List1.Visible = True 
End Sub 

READ MORE - VB6 DataGrid - Auto Height DropDown DataGrid

VB6 API - Menghilangkan Border TextBox, ListBox, etc.

Mengenai cara menghilangkan border object TextBox, ListBox, dan lain sebagainya.

Option Explicit 
 
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
 
Private Const WS_EX_CLIENTEDGE = &H200 
Private Const GWL_EXSTYLE = (-20) 
 
Private Sub RemoveBorder(ctl As Control) 
    Dim lStyle As Long 
    ctl.Appearance = 1 
    lStyle = GetWindowLong(ctl.hwnd, GWL_EXSTYLE) 
    lStyle = lStyle And Not WS_EX_CLIENTEDGE 
    SetWindowLong ctl.hwnd, GWL_EXSTYLE, lStyle 
    ctl.Appearance = 0 
End Sub 

Contoh penggunaan:

Private Sub Command1_Click() 
    Call RemoveBorder(Text1) 
End Sub 

READ MORE - VB6 API - Menghilangkan Border TextBox, ListBox, etc.

VB6 ListBox - Mengetahui Item Height Object ListBox

Untuk tujuan tertentu, terkadang kita memerlukan sebuah fungsi untuk mengukur Item Heigh sebuah object ListBox dan di bawah ini merupakan salah satu contohnya dengan menggunakan fungsi API.

Option Explicit   
   
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long   
Private Const LB_GETITEMRECT As Long = &H198   
   
Private Type RECT   
    Left As Long   
    Top As Long   
    Right As Long   
    Bottom As Long   
End Type   
   
Private Function ListBoxItemHeight(lst As ListBox) As Integer   
    Dim rc As RECT, i As Long, dy As Long   
    If lst.ListCount = 0 Then Exit Function   
    SendMessage lst.hwnd, LB_GETITEMRECT, ByVal 0&, rc   
    dy = rc.Bottom - rc.Top   
    ListBoxItemHeight = (dy * Screen.TwipsPerPixelY)   
End Function 

Contoh penggunaan:

Private Sub Command1_Click() 
    List1.AddItem "A" 
    MsgBox ListBoxItemHeight(List1) 
End Sub 

READ MORE - VB6 ListBox - Mengetahui Item Height Object ListBox

Menambah dan Menghilangkan Item Pada ListBox - VB6 Code

Object ListBox pada Visual Basic 6.0 dilengkapi dengan beberapa method. Salah satunya adalah method untuk menambah item dan mengurangi item. Untuk menambah item, method yang digunakan adalah AddItem , sedangkan untuk menghilangkan/mengurangi item method yang digunakan adalah RemoveItem.

Berikut merupakan contoh menambah dan mengurangi item yang disertai komentar secukupnya agar mudah dipahami.

Option Explicit 
 
Private Sub Form_Load() 
    List1.AddItem "a" 'tambah item huruf a 
    List1.AddItem "b" 'tambah item huruf b 
    List1.AddItem "c" 'tambah item huruf c 
End Sub 
 
Private Sub   Command1_Click() 
    List1.RemoveItem 0 'hilangkan item yang memiliki index 0 (paling atas) 
End Sub 

Demikian mengenai cara menambah dan mengurangi sebuah item pada object ListBox bahasa pemrograman Visual Basic 6.0.

READ MORE - Menambah dan Menghilangkan Item Pada ListBox - VB6 Code

Class ListBox - Untuk Memilih Item Pada Saat Klik Kanan

Mengenai cara memilih item pada ListBox dengan klik kanan menggunakan VB6 - Seperti yang telah kita ketahui, sebuah ListBox hanya dapat dipilih itemnya melalui klik kiri, nah bagaimana jika kita ingin memilih item ListBox tersebut melalui klik kanan? Di bawah ini adalah class VB6 yang saya buat untuk klik kanan pada ListBox, penggunaan class di sini bertujuan hanya untuk menyederhanakan kerumitan/kekomplekan dalam pemrograman saja, jadi Anda dapat membuat kodenya pada module atau langsung pada formnya dengan sedikit modifikasi tentunya.

Option Explicit

Private WithEvents lst As ListBox

Private Type POINTAPI
   X As Long
   Y As Long
End Type

Private Const LB_ITEMFROMPOINT As Long = &H1A9

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long

Public Function LoWord(dwValue As Long) As Integer
  CopyMemory LoWord, dwValue, 2
End Function

Public Function MAKELONG(wLow As Long, wHigh As Long) As Long
  MAKELONG = LoWord(wLow) Or (&H10000 * LoWord(wHigh))
End Function

Public Function MAKELPARAM(wLow As Long, wHigh As Long) As Long
  MAKELPARAM = MAKELONG(wLow, wHigh)
End Function

Public Property Let ListBox(New_List As ListBox)
    Set lst = New_List
End Property

Private Sub lst_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = vbRightButton Then
      Dim lParam As Long
      Dim curritem As Long
      Dim r As Long
      Dim pt As POINTAPI
      Call GetCursorPos(pt)
      Call ScreenToClient(lst.hWnd, pt)
      lParam = MAKELPARAM(pt.X, pt.Y)
      r = SendMessage(lst.hWnd, LB_ITEMFROMPOINT, 0&, ByVal lParam)
      If r > -1 Then
         curritem = LoWord(r)
         lst.Selected(curritem) = True
      End If
   End If
End Sub

Demikian Class ListBox untuk memilih item melalui klik kanan pada VB6, semoga bermanfaat.

READ MORE - Class ListBox - Untuk Memilih Item Pada Saat Klik Kanan

VB6 Code - Cara Menampilkan ToolTipText Pada ListBox

Mengenai cara menampilkan ToolTipText pada saat pointer mouse bergerak di atas ListItem ListBox menggunakan VB6 Code. Adapun cara menampilkan ToolTipText pada ListBox adalah sebagai berikut:

Option Explicit 
 
Private Type POINTAPI 
    x As Long 
    Y As Long
End Type 
 
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 
Private Declare Function LBItemFromPt Lib "COMCTL32.DLL" (ByVal hLB As Long, ByVal ptX As Long, ByVal ptY As Long, ByVal bAutoScroll As Long) As Long 
Private Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
 
Private WithEvents lst As ListBox 
Private Const LB_SETHORIZONTALEXTENT = &H194 
 
Public Property Let List(New_List As ListBox) 
    Set lst = New_List 
End Property 
     
Private Sub lst_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single) 
    '    lst.ListIndex = ItemUnderMouse(lst.hwnd, X, Y) 
    Dim l As Long 
    Dim a As Long
    a = lst.Parent.TextWidth(lst.List(ItemUnderMouse(lst.hwnd, x, Y))) / Screen.TwipsPerPixelX
    l = lst.Parent.TextWidth("AAAAAAAAAAAAAAAAAAAAAAA") / Screen.TwipsPerPixelX 
    If a > l Then 
        If lst.ToolTipText <> lst.List(ItemUnderMouse(lst.hwnd, x, Y)) Then
            lst.ToolTipText = lst.List(ItemUnderMouse(lst.hwnd, x, Y))
        End If 
    Else
        lst.ToolTipText = ""
    End If 
End Sub 
     
' Return the index of the item under the mouse. 
Public Function ItemUnderMouse(ByVal list_hWnd As Long, ByVal x As Single, ByVal Y As Single) 
    Dim pt As POINTAPI 
    pt.x = x \ Screen.TwipsPerPixelX 
    pt.Y = Y \ Screen.TwipsPerPixelY 
    ClientToScreen list_hWnd, pt 
    ItemUnderMouse = LBItemFromPt(list_hWnd, pt.x, pt.Y, False)
End Function 

READ MORE - VB6 Code - Cara Menampilkan ToolTipText Pada ListBox

VB6 Code - Mengisi ListBox Atau ComboBox Dengan File

Mengenai cara mengisi ListBox atau ComboBox dengan seluruh isi file menggunakan VB6 Code. Adapun cara mengisi ListBox atau ComboBox dengan isi seluruh file adalah sebagai berikut: 

Public Sub LoadFileToComboOrList(FileName As String, obj As Object) 
    Dim s As String 
    Dim InFile As Integer   ' Descriptor for file. 
    InFile = FreeFile 
    Open FileName For Input As InFile 
        While Not EOF(InFile) 
            Line Input #InFile, s 
            obj.AddItem s 
        Wend 
    Close InFile 
End Sub 

READ MORE - VB6 Code - Mengisi ListBox Atau ComboBox Dengan File

TextBox Auto Complete Dan Pencarian Cepat Pada ListBox

Apabila Anda pernah menggunakan Tools API-Guide salah satu produk AllApi.net, maka kita akan melihat salah satu TextBox (untuk pencarian fungsi API) yang dilengkapi dengan fasilitas Auto Complete. Auto Complete ini sangat tepat bagi Anda yang sedang mengembangkan aplikasi kamus, database (unbound-control), maupun aplikasi-aplikasi yang menuntut pencarian cepat. Agar lebih jelas, apa yang dimaksud dengan AutoComplete itu perhatikan gambar di bawah ini:

'simpan kode di bawah ini pada modul 
Option Explicit 
 
Public Function TextBoxAutoComplete(Key As Integer, txt As TextBox, lst As ListBox) 
    'fitur auto complete 
    If Key = vbKeyBack Then Exit Function 
    If Key =   vbKeyDelete Then Exit Function 
    
    Dim start As Integer 
     
    If InStr(1, lst.Text, txt.Text) > 0 Then 
        start = txt.SelStart 
        txt.Text = lst.Text 
        If Key = 13 Then 'enter 
            txt.SelStart = Len(txt.Text) 
            Exit Function 
        End If 
        txt.SelStart = start 
        txt.SelLength = Len(lst.Text) 
    End If 
End Function 

Contoh penggunaan fungsi di atas:

'simpan kode di bawah ini pada form 
Private Sub Text1_KeyUp(KeyCode As Integer, Shift As Integer) 
    Call TextBoxAutoComplete(KeyCode, Text1, List1) 
End Sub 

READ MORE - TextBox Auto Complete Dan Pencarian Cepat Pada ListBox

Memilih Item ListBox Secara Otomatis

Bagaimana cara memilih item yang terdapat pada ListBox secara otomatis pada saat mouse berada di atasnya.

Option Explicit 
 
Private Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 
Private Declare Function LBItemFromPt Lib "COMCTL32.DLL" (ByVal hLB As Long, ByVal ptX As Long, ByVal ptY As Long, ByVal bAutoScroll As Long) As Long 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long 
 
Private Const LB_SETCURSEL = &H186 
Private Const LB_GETCURSEL = &H188 
 
Private Type POINTAPI 
    X As Long 
    Y As Long 
End Type 
 
Private Sub HightLightListBox(ByVal hwndLB As Long, ByVal X As Single, ByVal Y As Single) 
 
    Dim IndexItem As Long 
    Dim Point As POINTAPI 
 
    Point.X = X \ Screen.TwipsPerPixelX   
    Point.Y = Y \ Screen.TwipsPerPixelY 
 
    Call ClientToScreen(hwndLB, Point) 
 
    IndexItem = LBItemFromPt(hwndLB, Point.X, Point.Y, False) 
 
    If IndexItem <> SendMessage(hwndLB, LB_GETCURSEL, 0, 0) Then 
        Call SendMessage(hwndLB, LB_SETCURSEL, IndexItem, 0) 
    End If 
 
End Sub 

Contoh penggunaan kode di atas:

Private Sub Form_Load() 
    Dim i As Long 
    For i = 0 To 100 
        List1.AddItem 1234567 + i 
      Next 
End Sub 
 
Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    HightLightListBox List1.hwnd, X, Y 
End Sub 

READ MORE - Memilih Item ListBox Secara Otomatis

Menambah Horizontal ScrollBar pada ListBox

Di bawah ini merupakan procedure untuk menambah ScrollBar pada objek ListBox. Seperti yang kita ketahui, ListBox tidak memiliki properties horizontal scroll bar akan tetapi dengan memanggil beberapa fungsi API hal tersebut mungkin untuk dilakukan.

Option Explicit 
 
Private Declare Function SendMessageByNum Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
Private Const LB_SETHORIZONTALEXTENT = &H194 
 
Public Sub AddHSBToListBox(sText As String, lst As ListBox) 
    Static x As Long   
    lst.AddItem sText 
    If x < TextWidth(sText & "  ") Then 
        x = TextWidth(sText & "  ") 
    End If 
    If ScaleMode = vbTwips Then 
        x = x / Screen.TwipsPerPixelX 
        SendMessageByNum lst.hwnd, LB_SETHORIZONTALEXTENT, x, 0 
    End If 
End Sub 

Contoh penggunaan menambah horizontal scrollbar pada listbox

Private Sub Command1_Click() 
    Dim sText As String 
    sText = ("This is a sample of long text, if the text longer than   listbox, it will be create horizontal scrollbar automatically") 
    AddHSBToListBox sText, List1 
End Sub 

READ MORE - Menambah Horizontal ScrollBar pada ListBox

Mencari Dengan Cepat Pada ListBox Menggunakan Fungsi API

Di bawah ini merupakan fungsi yang digunakan untuk mencari sebuah item yang terdapat dalam objek ListBox dengan cepat.

Option Explicit 
 
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Any) As Long 
Private Const LB_FINDSTRING = &H18F 
 
Public Function SearchInList(sText As String, lst As ListBox) 
    On Error Resume Next 
    lst.ListIndex = SendMessage(lst.hWnd, LB_FINDSTRING, -1, ByVal sText) 
    lst.TopIndex = List1.ListIndex - 1 
End Function 

Contoh penggunaan mencari dengan cepat menggunakan fungsi API

Private Sub Form_Load() 
    With List1 
        .AddItem "Bandung" 
        .AddItem "Jakarta" 
        .AddItem "Garut" 
        .AddItem "Surabaya" 
        .AddItem "New York" 
        .AddItem "Khoiriyyah" 
    End With 
End Sub 
 
Private Sub Text1_Change() 
      SearchInList Text1.Text, List1 
End Sub 

READ MORE - Mencari Dengan Cepat Pada ListBox Menggunakan Fungsi API

Cara Termudah Untuk Mengisi Seluruh Fonts Ke dalam ListBox

Di bawah ini merupakan fungsi untuk mengisi seluruh fonts yang ada dalam komputer Anda ke dalam objek ListBox

Public Function LoadAllFonts(lst As Control) 
    Dim i As Integer 
    For i = 1 To 1000 
        If Screen.Fonts(i) = "" Then Exit For 
        lst.AddItem Screen.Fonts(i) 
    Next i 
End Function 

Contoh penggunaan fungsi untuk mengisi seluruh fonts ke dalam ListBox

Private Sub Form_Load() 
    LoadAllFonts List1 
End Sub 

READ MORE - Cara Termudah Untuk Mengisi Seluruh Fonts Ke dalam ListBox

Drag And Drop Pada Dua ListBox - VB6 Souce Code

Terkadang dalam memprogram kita membutuhkan operasi drag and drop antara dua object ListBox, contohnya untuk pembuatan wizard dan lain sebagainya. Di bawah ini merupakan contoh source codenya. Dibuat oleh Luciano Esteban Lodola pemilik situs: http://www.recursosvisualbasic.com.ar

Option Explicit 
' --------------------------------------------------------------------------------------- 
' \ -- Autor : Luciano Lodola -- http://www.recursosvisualbasic.com.ar 
' --------------------------------------------------------------------------------------- 
 
' \ -- funciNn de windows para poder obtener un elemento (Indice) de un control de lista a partir de la psiciNn del mouse 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long 
                 
' -- Constante / mensaje para recupera el Item a partir de la posiciNn del mouse ( con SendMessage ) 
Private Const LB_ITEMFROMPOINT = &H1A9 
Public iX As Integer 
' -------------------------------------------------------------------------------------- 
'\ -- Inicio 
' -------------------------------------------------------------------------------------- 
Private Sub Form_Load() 
 
    Dim i As Byte 
    ' -- Agregar elementos de muestra para el ejemplo 
    With List1 
        .AddItem "Impresora Epson" 
        .AddItem "Impresora Lexmark" 
        .AddItem "Monitor LG" 
        .AddItem "Monitor Samsung" 
        .AddItem "PC Pentium Dual Core" 
        .AddItem "PC Pentium Core Duo" 
        .AddItem "Impresora lDser HP - MonocromDtica" 
        .AddItem "Impresora lDser Epson - MonocromDtica" 
        .AddItem "Impresora lDser color" 
    End With 
    ' -- Importante !!!! Habilitar el Drag con el mï؟½todo OLEDragMode, y el Drop para el List2 
    List1.OLEDragMode = 1 
    List2.OLEDropMode = 1 
End Sub 
 
' -------------------------------------------------------------------------------------- 
'\ -- FunciNn que retorna el Jndice del Item del List2 ( Donde se encuentra el mouse ) 
' -------------------------------------------------------------------------------------- 
Private Function pvGetItemFromPoint(X As Single, Y As Single, lBox As ListBox) As Long 
 
    Dim indice      As Long 
    Dim XPoint      As Long 
    Dim YPoint      As Long 
    Dim ZPoint      As Long 
     
    ' -- Valor por defecto de retorno de la funciNn ( NingRn item estD seleccionado) 
    indice = -1 
     
    XPoint = CLng(X / Screen.TwipsPerPixelX) 
    YPoint = CLng(Y / Screen.TwipsPerPixelY) 
    ZPoint = CLng(YPoint * &H10000 + XPoint) 
    With lBox 
         ' -- Recupera el item seleccionado (el Jndice ) 
         indice = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ZPoint) 
         If indice >= 0 And indice <= .ListCount Then 
            pvGetItemFromPoint = indice 
         End If 
    End With 
End Function 
' -------------------------------------------------------------------------------------- 
'\ -- Iniciar Drag del item 
' -------------------------------------------------------------------------------------- 
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
    iX = X 
    List1.OLEDrag 
End Sub 
 
' -------------------------------------------------------------------------------------- 
'\ -- evento que se produce al soltar el item 
' -------------------------------------------------------------------------------------- 
Private Sub List2_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) 
     
    Dim lIndex As Long 
    ' -- Obtener el Jndice pasando a la funciNn 
    lIndex = pvGetItemFromPoint(X, Y, List2) 
    ' -- Agregar con el mï؟½todo Additem en la posiciNn indicada por el Jndice 
    If lIndex >= 0 Then 
        List2.AddItem Data.GetData(1), lIndex 
    Else 
        List2.AddItem Data.GetData(1) 
    End If 
    ' -- seleccionar el dato 
    If lIndex <> -1 Then List2.Selected(lIndex) = True 
    ' -- Opcional - eliminar el elemento del List 
    List1.RemoveItem (List1.ListIndex) 
 
End Sub 

READ MORE - Drag And Drop Pada Dua ListBox - VB6 Souce Code

Menambahkan Item Ke dalam ListBox tanpa Duplikat - VB6

Menggunakan fungsi API, sehingga kecepatannya bisa dikatakan sangat baik. Adapun kodenya adalah seperti di bawah ini:

Option Explicit 
 
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 Const LB_FINDSTRINGEXACT As Long = &H1A2 
 
Private Function AddItemListUnix(lst As ListBox, ByVal sItem As String) As Boolean 
    If (SendMessage(lst.hwnd, LB_FINDSTRINGEXACT, -1&, ByVal sItem) > -1) Then Exit Function 
     lst.AddItem sItem 
End Function 

Mengenai contoh penggunaannya:

Private Sub Command1_Click() 
    AddItemListUnix List1, "Test" 
    AddItemListUnix List1, "Test" 
    AddItemListUnix List1, "Form" 
    AddItemListUnix List1, "Test" 
    AddItemListUnix List1, "CommandButton" 
    AddItemListUnix List1, "CommandButton" 
End Sub 

READ MORE - Menambahkan Item Ke dalam ListBox tanpa Duplikat - VB6

ListBox Load Table - 10 s/d 20 X Lebih Cepat - Tips dan Tric

Option Explicit

Tentu Anda sudah tidak asing lagi dengan potongan kode di bawah:

Do While Recordset.EOF = False 
    ListBox.AddItem Recordset!Field 
    Recordset.MoveNext 
Loop 

Atau kode di bawah ini:

For i = 1 To Recordset.RecordCount 
    ListBox.AddItem Recordset!Field 
    Recordset.MoveNext 
Next 

Kedua kode di atas digunakan untuk mem-populate (mengisi) ListBox atau ComboBox dengan Field dari sebuah database. Kode di atas bisa menjadi 10 s/d 20 kali lebih cepat dengan sedikit memodifikasi kodenya yakni dengan membuat satu variable yang diperlakukan sebagai buffer. Coba Anda bandingkan dua kode di bawah ini:

Private Sub Command2_Click() 
 
    Dim L As Long 
    Dim v As Variant 
    Dim t As Double 
     
    t = GetTickCount 
    Set adoPrimaryRS = New Recordset 
    adoPrimaryRS.Open "SELECT isbn FROM [Title Author] ORDER BY isbn", db, adOpenStatic, adLockOptimistic 
     
    List1.Clear 
    List1.Visible = False 
     
    For L = 0 To adoPrimaryRS.RecordCount - 1 
        List1.AddItem adoPrimaryRS!isbn 
        adoPrimaryRS.MoveNext 
    Next 
     
    List1.Visible = True 
    Me.Caption = GetTickCount - t & " milliseconds" 
     
End Sub 

Dengan kode di bawah ini:

Private Sub Command1_Click() 
 
    Dim L As Long 
    Dim v As Variant 
    Dim t As Double 
     
    t = GetTickCount 
    Set adoPrimaryRS = New Recordset 
    adoPrimaryRS.Open "SELECT isbn FROM [Title Author] ORDER BY isbn", db, adOpenStatic, adLockOptimistic 
     
    List1.Clear 
    List1.Visible = False 
    v = adoPrimaryRS.GetRows 
     
    For L = 0 To adoPrimaryRS.RecordCount - 1 
        List1.AddItem v(0, L) 
    Next 
     
    v = Empty 
     
    List1.Visible = True 
    Me.Caption = GetTickCount - t & " milliseconds" 
     
End Sub 

Catatan: Dua kode di atas digunakan untuk mengakses database BIBLIO.MDB.

READ MORE - ListBox Load Table - 10 s/d 20 X Lebih Cepat - Tips dan Tric