Monday, July 15, 2013

VB6 DataGrid: Multiple Delete (Del Key)

Option Explicit 

Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Dim DontResponseErrorTemporary As Boolean

Private Sub DeleteRows(dtGrid As DataGrid)
Dim varBmk As Variant
For Each varBmk In dtGrid.SelBookmarks
Adodc1.Recordset.Bookmark = varBmk
Adodc1.Recordset.Delete
Sleep 5 'miliseconds (as delay multiple delete animations)
dtGrid.Refresh
Next
End Sub

Private Sub DataGrid1_Error(ByVal DataError As Integer, Response As Integer)
If DontResponseErrorTemporary Then
Response = 0
DontResponseErrorTemporary = False
End If
End Sub

Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyDelete Then
If Not DeleteConfirm Then
KeyCode = 0
Exit Sub
End If
DontResponseErrorTemporary = True
Call DeleteRows(DataGrid1)
KeyCode = 0
End If
End Sub

Private Function DeleteConfirm() As Boolean
If MsgBox("Are you sure want to delete this record?", vbQuestion + vbYesNo + vbDefaultButton2, "Delete Confirm") = vbYes Then
DeleteConfirm = True
End If
End Function
READ MORE - VB6 DataGrid: Multiple Delete (Del Key)

VB6 DataGrid: Multiple Selection (Left Mouse Down + SHIFT)

Option Explicit 

Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Const
VK_SHIFT = &H10
Private LastRow As Long
Private
SelectionCount As Long

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Private Sub Form_Load()
'load database
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb;Persist Security Info=False"
.RecordSource = "Select * from [titles]"
.Refresh
.Recordset.MoveFirst
End With
Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
Call SetSelectionPlusShiftKey(DataGrid1)
End Sub

Private Sub SetSelectionPlusShiftKey(dtGrid As DataGrid)
Dim i As Integer
Dim Direction As Integer
If GetKeyState(VK_SHIFT) < 0 Then
SelectionCount = LastRow - dtGrid.Row
If SelectionCount < 0 Then
Direction = 1
Else
Direction = -1
End If
For i = 0 To SelectionCount Step -Direction
DataGrid1.SelBookmarks.Add (dtGrid.GetBookmark(i))
Next i
Else
LastRow = dtGrid.Row
End If
End Sub

Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub
READ MORE - VB6 DataGrid: Multiple Selection (Left Mouse Down + SHIFT)

Sunday, July 14, 2013

VB6 DataGrid: Multiple Selection (Mouse Down + Mouse Move)

Option Explicit 

Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
Private Declare Function
SetCapture Lib "user32.dll" (ByVal hwnd As Long) As Long

'-------------------------------------------------------------------------------
'http://khoiriyyah.blogspot.com
'-------------------------------------------------------------------------------

Dim BeginSelect As Boolean
Dim
CurrentRowY As Long

Private Sub DataGrid1_Click()
BeginSelect = False
ReleaseCapture
End Sub

Private Sub Form_Load()
'load database
With Adodc1
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=biblio.mdb;Persist Security Info=False"
.RecordSource = "Select * from [titles]"
.Refresh
.Recordset.MoveFirst
End With
Set DataGrid1.DataSource = Adodc1
End Sub

Private Sub RemoveAllSelected()
Dim h As Integer
Dim i As Integer
h = DataGrid1.SelBookmarks.Count
If h = 0 Then Exit Sub
For i = h - 1 To 0 Step -1
DataGrid1.SelBookmarks.Remove i
Next i
End Sub

Private Sub DataGrid1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Static t As Integer
Dim Direction As Integer
Dim i As Integer
If BeginSelect Then
SetCapture DataGrid1.hwnd
If CurrentRowY > DataGrid1.RowContaining(Y) Then
Direction = 1
Else
Direction = -1
End If
RemoveAllSelected
For i = CurrentRowY To DataGrid1.RowContaining(Y) Step -Direction
If i = -1 Then
Exit For
End If
DataGrid1.SelBookmarks.Add DataGrid1.RowBookmark(i)
Next
End If
End Sub

Private Sub DataGrid1_SelChange(Cancel As Integer)
If BeginSelect = False Then
Debug.Print DataGrid1.Col
CurrentRowY = DataGrid1.Row
End If
BeginSelect = True
End Sub

Private Sub Form_Resize()
On Error Resume Next
DataGrid1.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight
End Sub

Private Sub ReleaseSelect()
BeginSelect = False
ReleaseCapture
End Sub
READ MORE - VB6 DataGrid: Multiple Selection (Mouse Down + Mouse Move)

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