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 PictureBox - Print Left Center Right Align - PictureBox

Di bawah ini merupakan contoh print left - center - right pada PictureBox, seperti pada gambar di bawah ini:

Gambar - VB6 Print Left Center Right Align PictureBox

Option Explicit 
 
'------------------------------------------------------------------------- 
'http://khoiriyyah.blogspot.com 
'-------------------------------------------------------------------------  
'Print right align pada objek PictureBox 
Private Sub PrintRightAlign(ByVal Teks As String, pic As PictureBox) 
    With pic 
        .CurrentX = pic.ScaleWidth - pic.TextWidth(Teks) 
        pic.Print Teks 
    End With 
End Sub 
 
'Print center pada objek PictureBox 
Private Sub PrintCenter(ByVal Teks As String, pic As PictureBox) 
    With pic 
        .CurrentX = (pic.ScaleWidth - pic.TextWidth(Teks)) / 2 
        pic.Print Teks 
    End With 
End Sub 
 
'Print left pada objek PictureBox 
Private Sub PrintLeft(ByVal Teks As String, pic As PictureBox) 
    With pic 
        pic.Print Teks 
    End With 
End Sub 
 
Private Sub Form_Load() 
    Picture1.AutoRedraw = True 
End Sub 
 
'Contoh print left align 
Private Sub cmdLeft_Click() 
    Static i As Long 
    i = i + 1 
    Call PrintLeft(i, Picture1) 
End Sub 
 
'Contoh print center 
Private Sub cmdCenter_Click() 
    Static i As Long 
    i = i + 1 
    Call PrintCenter(i, Picture1) 
End Sub 
 
'Contoh print right 
Private Sub cmdRight_Click() 
    Static i As Long 
    i = i + 1 
    Call PrintRightAlign(i, Picture1) 
End Sub 

Download: vb6_print_center_right_left.zip

READ MORE - VB6 PictureBox - Print Left Center Right Align - PictureBox

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