Ini adalah contoh program linked list yaitu binary tree , program ini akan men sort angka - angka yang dimasukkan sesuai dengan pilihan , yaitu PreOrder , InOrder , dan juga PostOrder . Angka akan di sort dengan sistem Tree. Untuk lebih lanjut dapat di download program ini beserta source code nya :
Download Link : http://www.easy-share.com/1913034556/Program Tree.rar
Download Link : http://www.ziddu.com/download/12637601/ProgramTree.rar.html
Coding di Form :
Public Class Form1
Private Sub cmdtambah_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdtambah.Click
If Len(Trim(txtinput.Text)) = 0 Then
MessageBox.Show("Mohon Isi Data yang akan di input")
Exit Sub
End If
If IsNumeric(txtinput.Text) Then
insert(CInt(txtinput.Text))
End If
str = str & " " & txtinput.Text
txtshow.Text = str
txtinput.Text = ""
txtinput.Focus()
End Sub
Private Sub cmdpre_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdpre.Click
If Len(Trim(txtshow.Text)) = 0 Then
MessageBox.Show("Mohon Isi Data Terlebih dahulu")
Exit Sub
End If
STRPREORDER = ""
Call PREORDER(akar)
txtorder.Text = STRPREORDER
txtinput.Text = ""
txtinput.Focus()
Me.Size = New Size(742, 475)
End Sub
Private Sub cmdin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdin.Click
If Len(Trim(txtshow.Text)) = 0 Then
MessageBox.Show("Mohon Isi Data Terlebih dahulu")
Exit Sub
End If
STRINORDER = ""
Call INORDER(akar)
txtorder.Text = STRINORDER
txtinput.Text = ""
txtinput.Focus()
Me.Size = New Size(742, 475)
End Sub
Private Sub cmdpost_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdpost.Click
If Len(Trim(txtshow.Text)) = 0 Then
MessageBox.Show("Mohon Isi Data Terlebih dahulu")
Exit Sub
End If
STRPOSTORDER = ""
Call POSTORDER(akar)
txtorder.Text = STRPOSTORDER
txtinput.Text = ""
txtinput.Focus()
Me.Size = New Size(742, 475)
End Sub
Private Sub cmdbatal_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
txtinput.Text = ""
txtinput.Focus()
End Sub
Private Sub cmdEnd_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdEnd.Click
End
End Sub
Private Sub cmdcari_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmdcari.Click
If Len(Trim(txtinput.Text)) = 0 Then
MessageBox.Show("Mohon Isi Data yang akan di input")
Exit Sub
End If
Dim cari As Integer
cari = CInt(txtinput.Text)
If Not find(cari) Is Nothing Then
MsgBox(cari & " Ditemukan", MsgBoxStyle.Information, "Informasi")
Else
MsgBox(cari & "Tidak Ditemukan Dalam Tree", MsgBoxStyle.Information, "Informasi")
End If
txtinput.Text = ""
txtinput.Focus()
Me.Size = New Size(742, 475)
End Sub
Private Sub cmddelete_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
If IsNumeric(txtinput.Text) Then
delete(CInt(txtinput.Text))
End If
str = str & " " & txtinput.Text
txtshow.Text = str
txtinput.Text = ""
txtinput.Focus()
End Sub
Private Sub cmdmin_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim a As Node
a = minimum()
MsgBox("Nilai Minimumnya adalah : ", MsgBoxStyle.Information, "Informasi")
End Sub
Private Sub cmdmax_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Dim a As Node
a = maximum()
MsgBox("Nilai Maximumnya adalah : ", MsgBoxStyle.Information, "Informasi")
End Sub
Private Sub cmddelall_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cmddelall.Click
deleteAll(akar)
str = ""
txtshow.Text = ""
txtorder.Text = ""
txtinput.Focus()
Me.Size = New Size(742, 475)
End Sub
Private Sub txtinput_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles txtinput.KeyPress
If Not ((e.KeyChar >= "0" And e.KeyChar <= "9") Or e.KeyChar = vbBack) Then
e.Handled = True
End If
End Sub
End Class
Coding di Module1 :
Public akar As Node
Public p As Node
Public STRPREORDER As String
Public STRPOSTORDER As String
Public STRINORDER As String
Public str As String
Public Sub PREORDER(ByVal T As Node)
If Not T Is Nothing Then
STRPREORDER = STRPREORDER & " " & T.data
Call PREORDER(T.left)
Call PREORDER(T.right)
End If
End Sub
Public Sub INORDER(ByVal T As Node)
If Not T Is Nothing Then
Call INORDER(T.LEFT)
STRINORDER = STRINORDER & " " & T.data
Call INORDER(T.RIGHT)
End If
End Sub
Public Sub POSTORDER(ByVal T As Node)
If Not T Is Nothing Then
Call POSTORDER(T.LEFT)
Call POSTORDER(T.RIGHT)
STRPOSTORDER = STRPOSTORDER & " " & T.data
End If
End Sub
Public Function find(ByVal key As Integer) As Object
Dim current As Node
current = akar
While (current.data <> key)
If (key < current.data) Then
current = current.left
Else
current = current.right
End If
If current Is Nothing Then
Return Nothing
End If
End While
Return current
End Function
Public Sub insert(ByVal id As Integer)
Dim newNode As New Node
newNode.data = id
If (akar Is Nothing) Then
akar = newNode
Else
Dim current As Node
Dim parent As Node
current = akar
While (True)
parent = current
If (id < current.data) Then
current = current.left
If current Is Nothing Then
parent.left = newNode
Return
End If
ElseIf id = current.data Then
id = Nothing
Return
Else
current = current.right
If current Is Nothing Then
parent.right = newNode
Return
End If
End If
End While
End If
End Sub
Public Function minimum() As Node
Dim current, last As Node
current = Nothing
last = Nothing
current = akar
While (Not current Is Nothing)
last = current
current = current.left
End While
Return last
End Function
Public Sub deleteAll(ByRef tmp As Node)
Try
If Not tmp.left Is Nothing Then deleteAll(tmp.left)
If Not tmp.right Is Nothing Then deleteAll(tmp.right)
tmp = Nothing
Catch
MsgBox("Tree Kosong", MsgBoxStyle.Information, "Informasi")
End Try
End Sub
Public Function maximum() As Node
Dim current, last As Node
current = Nothing
last = Nothing
current = akar
Try
While (Not current Is Nothing)
last = current
current = current.right
End While
'MsgBox(last.data & "Nilai Max nya : ", MsgBoxStyle.Exclamation)
Catch
MsgBox("Tree Kosong")
End Try
Return last
End Function
Public Function delete(ByVal id As Integer) As Boolean
Dim current As Node
Dim parent As Node
current = akar
parent = akar
Dim isleft As Boolean
isleft = True
While (current.data <> id)
parent = current
If (id < current.data) Then
isleft = True
current = current.left
Else
isleft = False
current = current.right
End If
If (current Is Nothing) Then
Return False
End If
End While
If current.left Is Nothing And current.right Is Nothing Then
If (current.data = akar.data) Then
akar = Nothing
ElseIf isleft Then
parent.left = Nothing
Else
parent.right = Nothing
End If
ElseIf current.right Is Nothing Then
If current.data = akar.data Then
akar = Nothing
ElseIf isleft Then
parent.left = current.left
Else
parent.right = current.left
End If
ElseIf current.left Is Nothing Then
If current.data = akar.data Then
akar = current.right
ElseIf isleft Then
parent.left = current.right
Else
parent.right = current.right
End If
Else
Dim successor As Node
successor = getSuccessor(current)
If current.data = akar.data Then
akar = successor
ElseIf isleft Then
parent.left = successor
Else
parent.right = successor
successor.left = current.left
End If
End If
Return True
End Function
Public Function getSuccessor(ByVal delNode As Node) As Node
Dim successorParent As Node
Dim successor As Node
successor = delNode
successorParent = delNode
Dim current As Node
current = delNode.right
While Not current Is Nothing
successorParent = successor
successor = current
current = current.left
End While
If successor.data <> delNode.right.data Then
successorParent.left = successor.right
successor.right = delNode.right
End If
Return successor
End Function
End Module
Coding di Module2 :
Public Class Node
Public data As Integer
Public left As Node
Public right As Node
End Class
1 comments:
thanks infonya
Post a Comment