Arbre

Commande de compilation

Dans le menu Project - References de Visual Basic, il faut importer les déclarations du module Up ! Kernel en cochant la case correspondante.

Commande d'enregistrement des ActiveX

upsvtm Com=Charger

Commande d'exécution

arbre.exe

Fichiers sources

Source du module


Public Const ComparaisonAvant As Integer = 1

Public Const ComparaisonEgal As Integer = 2

Public Const ComparaisonApres As Integer = 3

Public Const ComparaisonNul As Integer = 4



Public MUpsKrn As Object



Public Sub EcrireEcran(ByVal Libelle As String)

' =============================================

Form1.Ecran.AddItem Libelle

End Sub



Public Function F(ByVal O1 As IUpsKrnCaractere, ByVal 
O2 As IUpsKrnCaractere) As Integer

' 
	======================================================================================

On Error GoTo GestionErreur



If MUpsKrn.EstNul(O1) Or MUpsKrn.EstNul(O2) Then

	F = ComparaisonNul

ElseIf MUpsKrn.Booleen2ComVariantBool(O1.Inferieur(O2)) Then

	F = ComparaisonAvant

ElseIf MUpsKrn.Booleen2ComVariantBool(O1.Superieur(O2)) Then

	F = ComparaisonApres

Else

	F = ComparaisonEgal

End If



Exit Function



GestionErreur:

'=============

EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le 
	source '" + Err.Source + "' :"

EcrireEcran Err.Description

End Function

Source de la fenêtre principale


Private Sub EcrireArbre(ByVal A As IUpsKrnArbreBinaire)

' =====================================================

Dim C As IUpsKrnCaractere



On Error GoTo GestionErreur



Set C = A.ParcoursAuDebut(0)

Do

	EcrireEcran MUpsKrn.Caractere2ComBStr(C)

	If C.Identique(A.DernierElement()) Then
	
		Exit Do
	
	End If

	Set C = A.Suivant(0)

Loop



Exit Sub



GestionErreur:

'=============

EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le 
	source '" + Err.Source + "' :"

EcrireEcran Err.Description

End Sub



Private Sub EcrireArbre2(ByVal A As IUpsKrnArbreBinaire)

' ======================================================

Dim C As IUpsKrnCaractere



On Error GoTo GestionErreur



Set C = A.ParcoursALaFin(0)

Do


	EcrireEcran MUpsKrn.Caractere2ComBStr(C)

	If C.Identique(A.PremierElement()) Then
	
		Exit Do
	
	End If

	Set C = A.Precedent(0)

Loop



Exit Sub



GestionErreur:

'=============

EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le 
	source '" + Err.Source + "' :"

EcrireEcran Err.Description

End Sub



Private Sub EcrireArbre3(ByVal A As IUpsKrnArbreBinaire)

' ======================================================

Dim C As IUpsKrnCaractere



On Error GoTo GestionErreur



Set C = A.ParcoursAuDebut(0)

Do

	EcrireEcran MUpsKrn.Caractere2ComBStr(C)

	If C.Identique(A.DernierElement()) Then
	
		Exit Do
	
	End If

	Set C = A.SuivantGroupe(0)

Loop



Exit Sub



GestionErreur:

'=============

EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le 
	source '" + Err.Source + "' :"

EcrireEcran Err.Description

End Sub



Private Sub EcrireArbre4(ByVal A As IUpsKrnArbreBinaire)

' ======================================================

Dim C As IUpsKrnCaractere



On Error GoTo GestionErreur



Set C = A.ParcoursALaFin(0)

Do

	EcrireEcran MUpsKrn.Caractere2ComBStr(C)

	If C.Identique(A.PremierElement()) Then
	
		Exit Do
	
	End If

	Set C = A.PrecedentGroupe(0)

Loop



Exit Sub



GestionErreur:

'=============

EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le 
	source '" + Err.Source + "' :"

EcrireEcran Err.Description

End Sub



Private Sub EcrireArbre5(ByVal A As IUpsKrnArbreBinaire)

' ======================================================

Dim C As IUpsKrnCaractere



On Error GoTo GestionErreur



Set C = A.ParcoursAuDebut(0)

Do

	EcrireEcran "Groupe " + 
	MUpsKrn.Caractere2ComBStr(MUpsKrn.Caractere5(A.NumeroElement(0)))

	Set C = A.PremierElementGroupe(0)

	Do
	
		EcrireEcran MUpsKrn.Caractere2ComBStr(C)

		If C.Identique(A.DernierElementGroupe(0)) Then
		
			Exit Do
		
		End If

		Set C = A.Suivant(0)
	
	Loop

	If C.Identique(A.DernierElement()) Then
	
		Exit Do
	
	End If

	Set C = A.SuivantGroupe(0)

Loop



Exit Sub



GestionErreur:

'=============

EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le 
	source '" + Err.Source + "' :"

EcrireEcran Err.Description

End Sub



Private Sub Form_Load()

' =====================

Dim A1 As IUpsKrnArbreBinaire

Dim A2 As IUpsKrnArbreBinaire

Dim A3 As IUpsKrnArbreBinaire

Dim Coucou As IUpsKrnCaractere

Dim Bonjour As IUpsKrnCaractere

Dim Salut As IUpsKrnCaractere

Dim Schluss As IUpsKrnCaractere

Dim I As Integer

Dim LibelleA As IUpsKrnCaractere

Dim LibelleB As IUpsKrnCaractere

Dim LibelleC As IUpsKrnCaractere

Dim LibelleD As IUpsKrnCaractere

Dim LibelleE As IUpsKrnCaractere

Dim LibelleF As IUpsKrnCaractere



On Error GoTo GestionErreur



Set MUpsKrn = CreateObject("UpsApp.UpsKrn")



Set Coucou = MUpsKrn.ComBStr2Caractere("coucou")

Set Bonjour = MUpsKrn.ComBStr2Caractere("bonjour")

Set Salut = MUpsKrn.ComBStr2Caractere("salut")

Set Schluss = MUpsKrn.ComBStr2Caractere("schluss")

Set A1 = MUpsKrn.ArbreBinaire1(MUpsKrn.ComAppel2Appel(MUpsKrn.Caractere, HRESULT F([in] 
	IUpsKrn::Caractere *O1, [in] IUpsKrn::Caractere *O2, [out, retval] short 
	*retval)", AddressOf F), False)

A1.AdditionnerAffecter Bonjour

A1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hello")

A1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("guten tag")

A1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hello")

A1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("coucou")

A1.AdditionnerAffecter Coucou

A1.AdditionnerAffecter Salut

A1.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hie")

A1.AdditionnerAffecter Schluss

EcrireArbre A1

EcrireEcran "

EcrireArbre2 A1

EcrireEcran "

EcrireArbre3 A1

EcrireEcran "

EcrireArbre4 A1

EcrireEcran "



Set A2 = MUpsKrn.ArbreBinaire1(MUpsKrn.Caractere, MUpsKrn.ComAppel2Appel(HRESULT F([in] 
	IUpsKrn::Caractere *O1, [in] IUpsKrn::Caractere *O2, [out, retval] short 
	*retval)", AddressOf F), False)

A2.AdditionnerAffecter Schluss

A2.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hie")

A2.AdditionnerAffecter Salut

A2.AdditionnerAffecter Coucou

A2.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("bonjour")

A2.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hello")

A2.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("guten tag")

A2.AdditionnerAffecter MUpsKrn.ComBStr2Caractere("hello")

A2.AdditionnerAffecter Bonjour

EcrireArbre5 A2

EcrireEcran "



If MUpsKrn.Booleen2ComVariantBool(A1.Egal(A2)) Then

	EcrireEcran "A1==A2"

End If

If MUpsKrn.Booleen2ComVariantBool(A1.Different(A2)) Then

	EcrireEcran "A1!=A2"

End If

EcrireEcran MUpsKrn.Caractere2ComBStr(A1.PremierElement())

EcrireEcran MUpsKrn.Caractere2ComBStr(A1.DernierElement())

EcrireEcran Str$(A1.NbElements())

EcrireEcran Str$(A1.NbGroupes())

EcrireEcran "



EcrireEcran MUpsKrn.Entier2ComInt(A1.Compter(Bonjour, MUpsKrn.ComInt2Entier(0)))

EcrireEcran "

Set A2 = A2.SupprimerTous(Schluss, MUpsKrn.ComInt2Entier(0))

EcrireArbre A2

EcrireEcran "

Set A2 = A2.RemplacerTous(Bonjour, MUpsKrn.ComBStr2Caractere("hola"), MUpsKrn.ComInt2Entier(0))

EcrireArbre A2

EcrireEcran "



Set A2 = A1.Gauche(MUpsKrn.ComInt2Entier(3))

EcrireArbre A2

EcrireEcran "

Set A2 = A1.Gauche(MUpsKrn.ComInt2Entier(8))

EcrireArbre A2

EcrireEcran "

Set A2 = A1.Droite(MUpsKrn.ComInt2Entier(8))

EcrireArbre A2

EcrireEcran "

Set A2 = A1.Droite(MUpsKrn.ComInt2Entier(2))

EcrireArbre A2

EcrireEcran "

Set A2 = A1.Milieu(MUpsKrn.ComInt2Entier(1), MUpsKrn.ComInt2Entier(7))

EcrireArbre A2

EcrireEcran "



Set A2 = A1

EcrireArbre A2

EcrireEcran "

I = 0

Do

	EcrireEcran MUpsKrn.Caractere2ComBStr(A1.Index(MUpsKrn.ComInt2Entier(I)))

	If I = A1.NbElements() - 1 Then
	
		Exit Do
	
	End If

	I = I + 1

Loop

EcrireEcran "



Set LibelleA = MUpsKrn.ComBStr2Caractere("A")

Set LibelleB = MUpsKrn.ComBStr2Caractere("B")

Set LibelleC = MUpsKrn.ComBStr2Caractere("C")

Set LibelleD = MUpsKrn.ComBStr2Caractere("D")

Set LibelleE = MUpsKrn.ComBStr2Caractere("E")

Set LibelleF = MUpsKrn.ComBStr2Caractere("F")

Set A1 = MUpsKrn.ArbreBinaire1(MUpsKrn.Caractere, MUpsKrn.ComAppel2Appel(HRESULT F([in] 
	IUpsKrn::Caractere *O1, [in] IUpsKrn::Caractere *O2, [out, retval] short 
	*retval)", AddressOf F), False)

A1.AdditionnerAffecter LibelleA

A1.AdditionnerAffecter LibelleB

A1.AdditionnerAffecter LibelleC

A1.AdditionnerAffecter LibelleD

Set A2 = MUpsKrn.ArbreBinaire1(MUpsKrn.Caractere, MUpsKrn.ComAppel2Appel(HRESULT F([in] 
	IUpsKrn::Caractere *O1, [in] IUpsKrn::Caractere *O2, [out, retval] short 
	*retval)", AddressOf F), False)

A2.AdditionnerAffecter LibelleC

A2.AdditionnerAffecter LibelleD

A2.AdditionnerAffecter LibelleE

A2.AdditionnerAffecter LibelleF

Set A3 = A1.Union(A2)

EcrireArbre A3

EcrireEcran "

Set A3 = A1.Intersection(A2)

EcrireArbre A3

EcrireEcran "

Set A3 = A1.Soustraction(A2)

EcrireArbre A3

EcrireEcran "

Set A3 = A1.Exclusion(A2)

EcrireArbre A3

EcrireEcran "



Set A1 = Nothing

Set A2 = Nothing

Set A3 = Nothing

Set Coucou = Nothing

Set Bonjour = Nothing

Set Salut = Nothing

Set Schluss = Nothing

Set LibelleA = Nothing

Set LibelleB = Nothing

Set LibelleC = Nothing

Set LibelleD = Nothing

Set LibelleE = Nothing

Set LibelleF = Nothing

Set MUpsKrn = Nothing

Exit Sub



GestionErreur:

'=============

EcrireEcran Erreur UpsKrn-0 : L'exception suivante a été envoyée dans le 
	source '" + Err.Source + "' :"

EcrireEcran Err.Description

End Sub