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

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