Scroll Treeview Ketika Sedang Drag And Drop Sebuah Node

Option Explicit

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Dim mfX As Single
Dim mfY As Single
Dim moNode As node
Dim m_iScrollDir As Integer
Dim mbFlag As Boolean

Private Sub Form_DragOver(Source As Control, x As Single, y As Single, State As Integer)
    If Source.Name = "TreeView1" Then
        Timer1.Enabled = False
    End If
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim n As Integer
    Timer1.Enabled = False
    Timer1.Interval = 200
    TreeView1.Style = tvwTreelinesPlusMinusPictureText
    TreeView1.ImageList = ImageList1
    For i = 1 To 50
        TreeView1.Nodes.Add Text:="Node " & i, Image:=1, SelectedImage:=2
    Next i
    For i = 1 To 50
        For n = 1 To 5
            TreeView1.Nodes.Add Relative:=i, Relationship:=tvwChild, Text:="Child Node " & n, Image:=1, SelectedImage:=2
        Next n
    Next i
End Sub

Private Sub Timer1_Timer()
    Set TreeView1.DropHighlight = TreeView1.HitTest(mfX, mfY)
    If m_iScrollDir = -1 Then
        SendMessage TreeView1.hwnd, 277&, 0&, vbNull
    Else
        SendMessage TreeView1.hwnd, 277&, 1&, vbNull
    End If
End Sub

Private Sub TreeView1_DragDrop(Source As Control, x As Single, y As Single)
    If Not TreeView1.DropHighlight Is Nothing Then
        MsgBox moNode.Text & " was dropped on " & TreeView1.DropHighlight.Text
    End If
    Set TreeView1.DropHighlight = Nothing
    Set moNode = Nothing
    Timer1.Enabled = False
End Sub

Private Sub TreeView1_DragOver(Source As Control, x As Single, y As Single, State As Integer)
    Set TreeView1.DropHighlight = TreeView1.HitTest(x, y)
    mfX = x
    mfY = y
    If y > 0 And y < 100 Then
        m_iScrollDir = -1
        Timer1.Enabled = True
    ElseIf y > (TreeView1.Height - 200) And y < TreeView1.Height Then
        m_iScrollDir = 1
        Timer1.Enabled = True
    Else
        Timer1.Enabled = False
    End If
End Sub

Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Timer1.Enabled = False
End Sub

Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    TreeView1.DropHighlight = TreeView1.HitTest(x, y)
    If Not TreeView1.DropHighlight Is Nothing Then
        TreeView1.SelectedItem = TreeView1.HitTest(x, y)
        Set moNode = TreeView1.SelectedItem
    End If
    Set TreeView1.DropHighlight = Nothing
End Sub

Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbLeftButton Then
        TreeView1.DragIcon = TreeView1.SelectedItem.CreateDragImage
        TreeView1.Drag vbBeginDrag
    End If
End Sub

READ MORE - Scroll Treeview Ketika Sedang Drag And Drop Sebuah Node

Apakah ScrollBar Visible Pada Sebuah Control?

Option Explicit

Private Const GWL_STYLE = (-16)
Private Const WS_HSCROLL = &H100000
Private Const WS_VSCROLL = &H200000

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Sub Command1_Click()
    Dim wndStyle As Long
    wndStyle = GetWindowLong(TreeView1.hwnd, GWL_STYLE)
    If (wndStyle And WS_HSCROLL) <> 0 Then
        MsgBox "A horizontal scroll bar is visible."
    Else
        MsgBox "A horizontal scroll bar is NOT visible."
    End If

    If (wndStyle And WS_VSCROLL) <> 0 Then
        MsgBox "A vertical scroll bar is visible."
    Else
        MsgBox "A vertical scroll bar is NOT visible."
    End If
End Sub

Private Sub Command2_Click()
    TreeView1.Move 250, 900, 1000, 1000
End Sub

Private Sub Form_Load()
    Form1.ScaleMode = 1
    Form1.Move 0, 0, 5100, 5040
    Command1.Caption = "Scroll Bar Test"
    Command1.Move 120, 120, 1700, 500
    Command2.Caption = "Size Control"
    Command2.Move 2000, 120, 1700, 500
    TreeView1.Move 250, 900, 3000, 1500
    TreeView1.Nodes.Add , , , "1: Sample Text"
    TreeView1.Nodes.Add , , , "2: Sample Text"
    TreeView1.Nodes.Add , , , "3: Sample Text"
    TreeView1.Nodes.Add , , , "4: Sample Text"
End Sub

READ MORE - Apakah ScrollBar Visible Pada Sebuah Control?

Rename Node TreeView Seperti Pada Explorer

Option Explicit

Dim sNodeText As String

Private Sub Form_Load()
    TreeView1.Nodes.Add , , , "test"
    TreeView1.Nodes.Add , , , "test 1"
    TreeView1.Nodes.Add , , , "test 2"
End Sub

Private Sub Timer1_Timer()
    TreeView1.StartLabelEdit
    Timer1.Enabled = False
End Sub

Private Sub TreeView1_AfterLabelEdit(Cancel As Integer, NewString As String)
    If Len(NewString) < 1 Then
        MsgBox "Error! You must enter a value"
        Timer1.Interval = 100
        Timer1.Enabled = True
    End If
End Sub

Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
    If Len(TreeView1.SelectedItem.Text) > 0 Then
        sNodeText = TreeView1.SelectedItem.Text
    End If
End Sub

Private Sub TreeView1_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        TreeView1.SelectedItem.Text = sNodeText
    End If
End Sub

READ MORE - Rename Node TreeView Seperti Pada Explorer

Mengubat BackGround TreeView Control

Option Explicit

Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
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 GWL_STYLE = -16&
Private Const TVM_SETBKCOLOR = 4381&
Private Const TVM_GETBKCOLOR = 4383&
Private Const TVS_HASLINES = 2&

Dim frmlastForm As Form

Private Sub Form_Load()
    Dim nodX As node
    Set nodX = TreeView1.Nodes.Add(, , "R", "Root")
    Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1")
    Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2")
    Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3")
    Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4")
    nodX.EnsureVisible
    TreeView1.Style = tvwTreelinesText
    TreeView1.BorderStyle = vbFixedSingle
End Sub

Private Sub Command1_Click()
    Dim lngStyle As Long
    Call SendMessage(TreeView1.hWnd, TVM_SETBKCOLOR, 0, ByVal RGB(255, 0, 0))
    lngStyle = GetWindowLong(TreeView1.hWnd, GWL_STYLE)
    Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle - TVS_HASLINES)
    Call SetWindowLong(TreeView1.hWnd, GWL_STYLE, lngStyle)
End Sub

READ MORE - Mengubat BackGround TreeView Control

Fungsi Mengubah Object LeftToRigth Menjadi RightToLeft

Di bawah ini merupakan fungsi untuk mengubah objek yang tidak memiliki properties LeftToRight agar seolah-olah memiliki properties tersebut. Melalui akal-akalan fungsi API, hal tersebut mungkin untuk dilakukan.

Option Explicit 
 
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 'TreeView1 RightToLeft True 
 
Private Const WS_EX_LAYOUTRTL = 4194304 
Private Const GWL_EXSTYLE = -20 
 
Public Sub ctlRightToLeft(ctl As   Control) 
    SetWindowLong ctl.hWnd, GWL_EXSTYLE, WS_EX_LAYOUTRTL 
End Sub 

Contoh penggunaan fungsi di atas:

Private Sub Command1_Click() 
    ctlRightToLeft TreeView1 
    TreeView1.Appearance = cc3D 
    TreeView1.BorderStyle = ccFixedSingle 
    TreeView1.Refresh 
End Sub 

Coba Anda ganti objeknya misalnya menggunakan Progress Bar, kemudian lihat apa yang terjadi?

READ MORE - Fungsi Mengubah Object LeftToRigth Menjadi RightToLeft