home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD90128162000.psc / v0.5 / modOperations.bas < prev   
Encoding:
BASIC Source File  |  2000-08-13  |  3.8 KB  |  120 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. 'CrΘer un fils
  9. Sub CreerFils(Parent As Long)
  10.     'Redimensionner l'arbre (+1)
  11.     ReDim Preserve Arbre(UBound(Arbre) + 1)
  12.     
  13.     'CrΘer le noeud
  14.     Arbre(UBound(Arbre)).Legende = ""
  15.     Arbre(UBound(Arbre)).NbSuivants = 0
  16.     Arbre(UBound(Arbre)).URL = ""
  17.     Arbre(UBound(Arbre)).PositionForcee = False
  18.     Arbre(UBound(Arbre)).x = 0
  19.     Arbre(UBound(Arbre)).y = 0
  20.     
  21.     'Ajouter le fils au parent
  22.     If Arbre(Parent).NbSuivants = 0 Then
  23.         Arbre(Parent).NbSuivants = 1
  24.         ReDim Arbre(Parent).Suivants(0)
  25.         Arbre(Parent).Suivants(0) = UBound(Arbre)
  26.     Else
  27.         ReDim Preserve Arbre(Parent).Suivants(UBound(Arbre(Parent).Suivants) + 1)
  28.         Arbre(Parent).Suivants(UBound(Arbre(Parent).Suivants)) = UBound(Arbre)
  29.         Arbre(Parent).NbSuivants = Arbre(Parent).NbSuivants + 1
  30.     End If
  31. End Sub 'CreerFils
  32.  
  33.  
  34.  
  35.  
  36.  
  37. 'Supprimer un noeud
  38. Sub SupprimerNoeud(index As Long)
  39.     'Indice correct ?
  40.     If index < 0 Or index > UBound(Arbre) Then
  41.         MsgBox "Tentative de suppression d'un noeud inexistant", vbExclamation, "Erreur..."
  42.         Exit Sub
  43.     End If
  44.     
  45.     'Tentative de suppression de la racine ?
  46.     If index = 0 Then
  47.         MsgBox "impossible de supprimer le premier noeud !", vbExclamation, "Erreur..."
  48.         Exit Sub
  49.     End If
  50.     
  51.     'Supprimer de l'arbre
  52.     Dim i, j
  53.     For i = index + 1 To UBound(Arbre)
  54.         Arbre(i - 1) = Arbre(i)
  55.     Next i
  56.     ReDim Preserve Arbre(UBound(Arbre) - 1)
  57.     
  58.     'Supprimer le lien depuis le parent
  59.     Dim k
  60.     Dim found As Boolean
  61.     found = False
  62.     For i = 0 To UBound(Arbre)
  63.         If Arbre(i).NbSuivants > 0 Then
  64.             For j = 0 To UBound(Arbre(i).Suivants)
  65.                 If Arbre(i).Suivants(j) = index Then 'Supprimer la rΘfΘrence
  66.                     'DΘcaler les suivants
  67.                     For k = j + 1 To UBound(Arbre(i).Suivants)
  68.                         Arbre(i).Suivants(k - 1) = Arbre(i).Suivants(k)
  69.                     Next k
  70.                     
  71.                     'Redimensionner l'arbre
  72.                     If UBound(Arbre(i).Suivants) > 0 Then ReDim Preserve Arbre(i).Suivants(UBound(Arbre(i).Suivants) - 1)
  73.                     Arbre(i).NbSuivants = Arbre(i).NbSuivants - 1
  74.                     found = True
  75.                 End If
  76.                 If found Then Exit For
  77.             Next j
  78.         End If
  79.         If found Then Exit For
  80.     Next i
  81.     
  82.     'DΘplacer les liens sur les indices supΘrieur α l'indice du noeud α supprimer
  83.     For i = 0 To UBound(Arbre)
  84.         If Arbre(i).NbSuivants > 0 Then
  85.             For j = 0 To UBound(Arbre(i).Suivants)
  86.                 If Arbre(i).Suivants(j) > index Then Arbre(i).Suivants(j) = Arbre(i).Suivants(j) - 1
  87.             Next j
  88.         End If
  89.     Next i
  90. End Sub 'SupprimerNoeud
  91.  
  92.  
  93.  
  94.  
  95. 'Retourner le N░ du noeud le plus proche. Dist max = largeur de "OOOO"
  96. Function NoeudLePlusProcheXY(x As Long, y As Long) As Long
  97.     Dim i As Long      'Variable de boucle
  98.     Dim Dist As Long, DistTemp As Long 'Distance au point
  99.     Dim Noeud As Long  'Noeud le plus proche
  100.     
  101.     'Initialisation
  102.     Dist = frmMap.TextWidth("OOOO")
  103.     Noeud = -1
  104.     
  105.     'Chercher le point le plus proche
  106.     For i = 0 To UBound(Arbre)
  107.         'Calculer la distance au point
  108.         DistTemp = Sqr((Arbre(i).x - x) ^ 2 + (Arbre(i).y - y) ^ 2)
  109.         
  110.         'Distance plus petite ? => on enregistre le point et la distance
  111.         If DistTemp < Dist Then
  112.             Dist = DistTemp
  113.             Noeud = i
  114.         End If
  115.     Next i
  116.     
  117.     'Retourner le noeud le plus proche
  118.     NoeudLePlusProcheXY = Noeud
  119. End Function 'NoeudLePlusProche
  120.