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)

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)

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