home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD8704872000.psc / v0.3 / modOperations.bas < prev    next >
Encoding:
BASIC Source File  |  2000-08-03  |  3.2 KB  |  99 lines
  1. Attribute VB_Name = "modOperations"
  2. 'modOperations : OpΘrations diverses sur le Mindmap
  3. 'Par C.Dutoit, 2 Ao√t 2000 (dutoitc@hotmail.com)
  4. 'http://www.home.ch/~spaw4758
  5. Option Explicit
  6.  
  7.  
  8.  
  9. Sub InsererFils(Parent As Long, Legende As String, URL As String)
  10.     'Redimensionner l'arbre (+1)
  11.     ReDim Preserve Arbre(UBound(Arbre) + 1)
  12.     
  13.     'CrΘer le noeud
  14.     Arbre(UBound(Arbre)).Legende = Legende
  15.     Arbre(UBound(Arbre)).NbSuivants = 0
  16.     Arbre(UBound(Arbre)).URL = URL
  17.     
  18.     'Ajouter le fils au parent
  19.     If Arbre(Parent).NbSuivants = 0 Then
  20.         Arbre(Parent).NbSuivants = 1
  21.         ReDim Arbre(Parent).Suivants(0)
  22.         Arbre(Parent).Suivants(0) = UBound(Arbre)
  23.     Else
  24.         ReDim Preserve Arbre(Parent).Suivants(UBound(Arbre(Parent).Suivants) + 1)
  25.         Arbre(Parent).Suivants(UBound(Arbre(Parent).Suivants)) = UBound(Arbre)
  26.         Arbre(Parent).NbSuivants = Arbre(Parent).NbSuivants + 1
  27.     End If
  28.     
  29.     'Redessiner le mindmap
  30.     DessinerAllMindMap
  31. End Sub 'InsererFils
  32.  
  33.  
  34.  
  35. 'Editer un noeud
  36. Sub EditerNoeud(Index As Long)
  37.     If Index < 0 Then Exit Sub
  38.     
  39.     Arbre(Index).Legende = InputBox("Entrez la lΘgende", "Editer un noeud (1/2)", Arbre(Index).Legende)
  40.     Arbre(Index).URL = InputBox("Entrez l'URL", "Editer un noeud (2/2)", Arbre(Index).URL)
  41. End Sub 'EditerNoeud
  42.  
  43.  
  44.  
  45. 'Supprimer un noeud
  46. Sub SupprimerNoeud(Index As Long)
  47.     'Indice correct ?
  48.     If Index < 0 Or Index > UBound(Arbre) Then
  49.         MsgBox "Tentative de suppression d'un noeud inexistant", vbExclamation, "Erreur..."
  50.         Exit Sub
  51.     End If
  52.     
  53.     'Tentative de suppression de la racine ?
  54.     If Index = 0 Then
  55.         MsgBox "impossible de supprimer le premier noeud !", vbExclamation, "Erreur..."
  56.         Exit Sub
  57.     End If
  58.     
  59.     'Supprimer de l'arbre
  60.     Dim i, j
  61.     For i = Index + 1 To UBound(Arbre)
  62.         Arbre(i - 1) = Arbre(i)
  63.     Next i
  64.     ReDim Preserve Arbre(UBound(Arbre) - 1)
  65.     
  66.     'Supprimer le lien depuis le parent
  67.     Dim k
  68.     Dim found As Boolean
  69.     found = False
  70.     For i = 0 To UBound(Arbre)
  71.         If Arbre(i).NbSuivants > 0 Then
  72.             For j = 0 To UBound(Arbre(i).Suivants)
  73.                 If Arbre(i).Suivants(j) = Index Then 'Supprimer la rΘfΘrence
  74.                     'DΘcaler les suivants
  75.                     For k = j + 1 To UBound(Arbre(i).Suivants)
  76.                         Arbre(i).Suivants(k - 1) = Arbre(i).Suivants(k)
  77.                     Next k
  78.                     
  79.                     'Redimensionner l'arbre
  80.                     ReDim Preserve Arbre(i).Suivants(UBound(Arbre(i).Suivants) - 1)
  81.                     Arbre(i).NbSuivants = Arbre(i).NbSuivants - 1
  82.                     found = True
  83.                 End If
  84.                 If found Then Exit For
  85.             Next j
  86.         End If
  87.         If found Then Exit For
  88.     Next i
  89.     
  90.     'DΘplacer les liens sur les indices supΘrieur α l'indice du noeud α supprimer
  91.     For i = 0 To UBound(Arbre)
  92.         If Arbre(i).NbSuivants > 0 Then
  93.             For j = 0 To UBound(Arbre(i).Suivants)
  94.                 If Arbre(i).Suivants(j) > Index Then Arbre(i).Suivants(j) = Arbre(i).Suivants(j) - 1
  95.             Next j
  96.         End If
  97.     Next i
  98. End Sub 'SupprimerNoeud
  99.