Showing posts with label TreeView. Show all posts
Showing posts with label TreeView. Show all posts

Sunday, June 17, 2012

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

Sunday, May 27, 2012

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