Thursday, July 11, 2013

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:

VB6 NO Auto Heigh Dropdown ListBox DataGrid
Gambar - DropDown DataGrid tanpa Auto Heigh

Padahal tinggi DropDown ListBox seharusnya seperti gambar di bawah ini:

VB6 Drop Down Datagrid
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:

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

Wednesday, July 10, 2013

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.

Tuesday, July 9, 2013

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