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 Code - Membuat Cue Banner atau Placeholder Text

Apa yang dimaksud dengan cue banner atau placeholder text atau sebagian menyebutnya dengan watermark text itu? untuk memahaminya perhatikan gambar di bawah ini:

VB6 Cue Banner Placeholder Text Watermark Text

Terlihat pada gambar di atas beberapa objek (ComboBox dan beberapa TextBox) yang memiliki tulisan kurang jelas dengan warna keabu-abuan. Nah, tulisan yang kurang jelas itulah yang dinamakan dengan cue banner/placeholder text/watermark text. Tulisan itu hanya akan muncul apabila objek-objek tersebut memiliki property Text = "" serta dalam keadaan lost focus.

Berikut beberapa bagian kode darinya:

Option Explicit
 
Private Declare Function GetComboBoxInfo Lib "user32" (ByVal hwndCombo As Long, CBInfo As COMBOBOXINFO) As Long
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 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type
 
Private Type COMBOBOXINFO
    cbSize As Long
    rcItem As RECT
    rcButton As RECT
    stateButton  As Long
    hwndCombo  As Long
    hwndEdit  As Long
    hwndList As Long
End Type
 
Private Const ECM_FIRST As Long = &H1500
Private Const EM_SETCUEBANNER As Long = (ECM_FIRST + 1)
 
Public Sub SetCueBanner(obj As Object, str As String)
    Dim s As String
    Dim c As COMBOBOXINFO
    If TypeOf obj Is ComboBox Then
        c.cbSize = Len(c)
        Call GetComboBoxInfo(obj.hwnd, c)
        s = StrConv(str, vbUnicode)
        Call SendMessage(c.hwndEdit, EM_SETCUEBANNER, 0&, ByVal s)
    Else 'TextBox
        s = StrConv(str, vbUnicode)
        Call SendMessage(obj.hwnd, EM_SETCUEBANNER, 0&, ByVal s)
    End If
End Sub

Catatan sangat penting:

1. Cue banner tidak bisa berjalan pada WinXP yang terinstall left to rigth language seperti arabic dsb. Hal tersebut merupakan bug dari Microsoft sendiri, dan telah diperbaiki pada OS selanjutnya.
2. Cue banner hanya akan berjalan setelah dicompile serta diberi manifest (XP Style)

Lebih lengkap mengenai pembuatan cue banner/placeholder text/watermark text bisa Anda download pada tautan di bawah ini:

Download: VB6_CueBanner

READ MORE - VB6 Code - Membuat Cue Banner atau Placeholder Text

VB6 Code - Mengurangi dan Menambah Item Pada ComboBox

Mengenai Code VB6 untuk menambah dan mengurangi item yang terdapat pada ComboBox. Code VB6 untuk menambah dan mengurangi item pada ComboBox harmpir sama dengan menambah dan mengurangi/menghilangkan item pada ListBox. Dalam hal ini hanya objectnya saja yang berbeda.

Berikut contoh Code VB6 untuk menambah dan mengurangi item yang terdapat pada ComboBox:

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

Demikian VB6 Code mengenai cara menambah dan mengurangi item pada object ComboBox. Semoga bermanfaat.

READ MORE - VB6 Code - Mengurangi dan Menambah Item Pada ComboBox

ComboBox Class - Mempermudah Pembuatan Aplikasi VB6

Option Explicit 
 
Private WithEvents cbo As ComboBox 
Public AutoDropDown As Boolean 
 
Private Type POINTAPI 
    x As Long 
    y As Long 
End Type 
 
Private Type RECT 
    Left As Long 
    Top As Long 
    Right As Long 
    Bottom As Long 
End Type 
 
'API Declarations 
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 Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long 
Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long 
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 Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long 
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
 
'Contanta 
Private Const CB_GETITEMHEIGHT As Long = &H154 
Private Const CB_SHOWDROPDOWN As Long = &H14F 
Private Const CB_FINDSTRING = &H14C 
Private Const CB_SETDROPPEDWIDTH = &H160 
Private Const CB_FINDSTRINGEXACT As Long = &H158 
Private Const CB_SELECTSTRING As Long = &H14D 
 
Private Const EC_LEFTMARGIN = &H1 
Private Const EC_RIGHTMARGIN = &H2 
Private Const EC_USEFONTINFO = &HFFFF& 
Private Const EM_SETMARGINS = &HD3& 
Private Const EM_GETMARGINS = &HD4& 
 
Public Sub ChangeComboDropDownHeight(Optional ItemToDisplay As Integer = 10) 
 
    Dim pt As POINTAPI 
    Dim rc As RECT 
    Dim cWidth As Long 
    Dim newHeight As Long 
    Dim oldScaleMode As Long 
    Dim numItemsToDisplay As Long 
    Dim itemHeight As Long 
 
    numItemsToDisplay = ItemToDisplay 
 
    oldScaleMode = cbo.Parent.ScaleMode 
    cbo.Parent.ScaleMode = vbPixels 
    cWidth = cbo.Width 
 
    itemHeight = SendMessage(cbo.hwnd, CB_GETITEMHEIGHT, 0, ByVal 0) 
    newHeight = itemHeight * (numItemsToDisplay + 2) 
    Call GetWindowRect(cbo.hwnd, rc) 
 
    pt.x = rc.Left 
    pt.y = rc.Top 
 
    Call ScreenToClient(cbo.Parent.hwnd, pt) 
    Call MoveWindow(cbo.hwnd, pt.x, pt.y, cbo.Width, newHeight, True) 
    cbo.Parent.ScaleMode = oldScaleMode 
 
End Sub 
 
Public Property Let ComboBox(New_ComboBox As ComboBox) 
    Set cbo = New_ComboBox 
End Property 
 
Public Sub ShowDropDown() 
    If cbo.ListCount > 0 Then 
        SendMessage cbo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0& 
    End If 
End Sub 
 
Private Sub cbo_GotFocus() 
    If Not AutoDropDown Then Exit Sub 
    Dim ret As Long 
    ret = SendMessage(cbo.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&) 
End Sub 
 
Public Sub SetDropWidth(lngWidth As Long) 
    SendMessageLong cbo.hwnd, CB_SETDROPPEDWIDTH, lngWidth, 0 
End Sub 
 
Public Function GetEditHwnd() As Long 
    GetEditHwnd = FindWindowEx(cbo.hwnd, 0, "EDIT", vbNullString) 
End Function 
 
Public Function Find(FindText As String, Optional SetTopIndex As Boolean) As Boolean 
    Dim ret As Long 
    ret = SendMessage(cbo.hwnd, CB_FINDSTRING, -1, ByVal FindText) 
    If ret > -1 Then 
        Find = True 
        If SetTopIndex Then 
            cbo.TopIndex = ret 
            cbo.ListIndex = ret 
        Else 
            cbo.ListIndex = ret 
        End If 
    End If 
End Function 
 
Public Function FindExact(ByVal SearchString As String, Optional ByVal StartFrom As Long = -1) As Long 
    FindExact = SendMessage(cbo.hwnd, CB_FINDSTRINGEXACT, StartFrom, ByVal SearchString) 
End Function 
 
Public Function FindSelect(ByVal SearchString As String, Optional ByVal StartFrom As Long = -1) As Long 
    FindSelect = SendMessage(cbo.hwnd, CB_SELECTSTRING, StartFrom, ByVal SearchString) 
End Function 
 
Public Sub DisableScroll() 
    Call pUnSubClassCombo(cbo) 
    glPrevWndProcC = fSubClassCombo(cbo) 
End Sub 
 
Private Sub Class_Terminate() 
    Call pUnSubClassCombo(cbo) 
End Sub 

READ MORE - ComboBox Class - Mempermudah Pembuatan Aplikasi VB6

ComboBox SubClassing - Private Collections

Option Explicit 
 
 
Public glPrevWndProc As Long 
Public glPrevWndProcC As Long 
 
Private Const GWL_WNDPROC = (-4) 
Private Const WM_RBUTTONUP = &H205 
Private Const WM_RBUTTONDOWN = &H204 
Private Const WM_PARENTNOTIFY = &H210 
Private Const WM_MOUSEMOVE = &H200 
Private Const WM_MOUSEWHEEL As Long = &H20A 
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
 
'ComboBox 
Public Sub pUnSubClassCombo(cbo As ComboBox) 
    Call SetWindowLong(cbo.hwnd, GWL_WNDPROC, glPrevWndProcC) 
End Sub 
 
Public Function pMyWindowProcC(ByVal hw As Long, ByVal uMsg As Long, _ 
    ByVal wParam As Long, ByVal lParam As Long) As Long 
    If uMsg = WM_PARENTNOTIFY And wParam = WM_RBUTTONDOWN Then 
'        Call frmMain.Text2_MouseUp(vbRightButton, 0, 0, 0) 
        Exit Function 
    ElseIf uMsg = WM_MOUSEWHEEL Then 
        Exit Function 
    End If 
    pMyWindowProcC = CallWindowProc(glPrevWndProcC, hw, uMsg, wParam, lParam) 
End Function 
 
Public Function fSubClassCombo(cbo As ComboBox) As Long 
    fSubClassCombo = SetWindowLong(cbo.hwnd, GWL_WNDPROC, AddressOf pMyWindowProcC) 
End Function 
 
'TextBox 
Public Function pMyWindowProc(ByVal hw As Long, ByVal uMsg As Long, _ 
    ByVal wParam As Long, ByVal lParam As Long) As Long 
    If uMsg = WM_RBUTTONUP Then 
'        Call frmMain.Text2_MouseUp(vbRightButton, 0, 0, 0) 
        Exit Function 
    End If 
    pMyWindowProc = CallWindowProc(glPrevWndProc, hw, uMsg, wParam, lParam) 
End Function 
 
Public Function fSubClass(txt As TextBox) As Long 
    fSubClass = SetWindowLong(txt.hwnd, GWL_WNDPROC, AddressOf pMyWindowProc) 
End Function 
 
Public Sub pUnSubClass(txt As TextBox) 
    Call SetWindowLong(txt.hwnd, GWL_WNDPROC, glPrevWndProc) 
End Sub 

READ MORE - ComboBox SubClassing - Private Collections

Menyembunyikan TextBox dan ComboBox Caret Menggunakan VB6

Terkadang dalam sebuah aplikasi, kita membutuhkan kode untuk menyembunyikan caret yang terdapat dalam TextBox maupun ComboBox. Nah, bagaimana cara menyembunyikan caret yang terdapat dalam TextBox maupun ComboBox menggunakan Visual Basic 6.0 (VB6)? kode di bawah mungkin jawabannya:

'simpan kode di bawah pada modul 
Option Explicit 
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long 
'Public Declare Function HideCaret Lib "user32" ByVal hwnd As Long) As Long 
 
'prosedur memperoleh handle edit yang terdapat   dalam ComboBox 
Public Function EditComboHWND(cmb As ComboBox) As Long 
    Dim r As Long 
    r = FindWindowEx(cmb.hwnd, ByVal 0&, "Edit", vbNullString) 
    EditComboHWND = r 
End Function 

Contoh penggunaan:

'simpan kode ini pada Form 
Option Explicit 
 
Private Sub Combo1_GotFocus() 
    'sembunyikan caret yang terdapat dalam ComboBox 
    HideCaret EditComboHWND(Combo1) 
End Sub 
 
Private Sub Text1_GotFocus() 
    'sembunyikan caret yang terdapat pada TextBox 
      HideCaret Text1.hwnd 
End Sub 

READ MORE - Menyembunyikan TextBox dan ComboBox Caret Menggunakan VB6

Procedure Auto Drop Down Pada ComboBox

Di bawah ini merupakan procedure auto drop down pada objek ComboBox standar. Maksudnya, drop down otomatis apabila mouse berada di atasnya tanpa harus mengkliknya terlebih dahulu.

Option Explicit 
 
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 
Const CB_SHOWDROPDOWN = &H14F 
 
Public Sub AutoDropDown(cmb As ComboBox) 
    Call SendMessage(cmb.hwnd, CB_SHOWDROPDOWN, 1, ByVal 0&) 
    If cmb.ListIndex = -1   Then cmb.ListIndex = 0 
End Sub 

Contoh penggunaan proceder auto drop down pada combobox

Private Sub Combo1_GotFocus() 
    AutoDropDown Combo1 
End Sub 
 
Private Sub Form_Load() 
    With Combo1 
        .AddItem "asep hibban" 
        .AddItem "fahmi nurul anwar" 
        .AddItem "mohammad galbi" 
        .AddItem "karim wafi" 
    End With 
End Sub 

READ MORE - Procedure Auto Drop Down Pada ComboBox