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 / modMap.bas < prev    next >
Encoding:
BASIC Source File  |  2000-08-07  |  6.9 KB  |  209 lines
  1. Attribute VB_Name = "modMap"
  2. 'modMap : Gestion de l'affichage du mindmap + structure de donnΘe
  3. 'Par C.Dutoit, 1er Ao√t 2000 (dutoitc@hotmail.com)
  4. 'http://www.home.ch/~spaw4758
  5. Option Explicit
  6.  
  7. 'max 10 fils !
  8.  
  9.  
  10. 'Un Noeud
  11. Type TNoeud
  12.     Legende As String       'LΘgende du noeud
  13.     URL As String           'URL
  14.     X As Long
  15.     Y As Long               'Position centrale
  16.     NbSuivants As Byte      'Nombre de fils
  17.     Suivants() As Long      'Liste des fils
  18. End Type 'TNoeud
  19.  
  20.  
  21. Global Arbre() As TNoeud         'L'arbre du mindmap
  22. Global NoeudSelectionne As Long  'Noeud sΘlectionnΘ
  23.  
  24.  
  25.  
  26. 'Dessiner un noeud
  27. Private Sub DessinerNoeud(X, Y, Index As Long)
  28.     Dim txtW As Long
  29.     Dim txtH As Long
  30.     Dim w As Long           'Largeur
  31.     Dim h As Long           'Hauteur
  32.     
  33.     'Calculer la hauteur et la largeur
  34.     txtW = frmMap.TextWidth(Arbre(Index).Legende)
  35.     txtH = frmMap.TextHeight(Arbre(Index).Legende)
  36.     w = txtW * 0.5 + frmMap.TextWidth("OO")
  37.     h = txtH * 0.5 + frmMap.TextHeight("O") / 2
  38.     
  39.     'Dessiner le centre
  40.     frmMap.FillColor = RGB(255, 255, 255)
  41.     frmMap.FillStyle = 0 'solide
  42.     frmMap.DrawWidth = 2
  43.     frmMap.Circle (X, Y), w, , , , h / w
  44.     frmMap.DrawWidth = 1
  45.     
  46.     'SΘlectionnΘ ? => tracer un cadre traitillΘ autour de l'ellipse
  47.     If Index = NoeudSelectionne Then
  48.         frmMap.ForeColor = 0
  49.         frmMap.DrawStyle = 2
  50.         frmMap.FillStyle = 1 'transparent
  51.         frmMap.Line (X - txtW / 2 - 2, Y - txtH / 2 - 2)-(X + txtW / 2 + 2, Y + txtH / 2 + 2), , B
  52.         frmMap.DrawStyle = 0
  53.     End If
  54.     
  55.     'Afficher le label
  56.     frmMap.CurrentX = X - txtW / 2
  57.     frmMap.CurrentY = Y - txtH / 2
  58.     frmMap.ForeColor = 0 'Couleur du cadre
  59.     'frmMap.BackColor = RGB(255, 255, 200)
  60.     'frmMap.FillColor = RGB(0, 255, 0)
  61.     frmMap.Print Arbre(Index).Legende & vbCrLf & Arbre(Index).URL
  62.     
  63.     'Enregistrer la position
  64.     Arbre(Index).X = X
  65.     Arbre(Index).Y = Y
  66. End Sub 'DessinerNoeud
  67.  
  68.  
  69.  
  70. Private Sub DessinerNoeudEtFils(NoeudDepart As Long, AngleDeb, AngleFin, X, Y, Etape)
  71.     Dim Etalon1 As Long
  72.     Etalon1 = frmMap.ScaleWidth / 20
  73.  
  74.     'Dessiner les suivants
  75.     If Arbre(NoeudDepart).NbSuivants > 0 Then
  76.         'Normaliser les angles
  77.         Dim IncAngle
  78.         If AngleDeb < 0 Then AngleDeb = AngleDeb + 360
  79.         If AngleFin < AngleDeb Then AngleFin = AngleFin + 360
  80.     
  81.         'Calculer l'incrΘment
  82.         If Arbre(NoeudDepart).NbSuivants = 1 Then
  83.             IncAngle = 0
  84.             AngleDeb = (AngleDeb + AngleFin) / 2
  85.         Else
  86.             If AngleDeb Mod 360 = AngleFin Mod 360 Then
  87.                 IncAngle = (AngleFin - AngleDeb) / (Arbre(NoeudDepart).NbSuivants)
  88.             Else
  89.                 IncAngle = (AngleFin - AngleDeb) / (Arbre(NoeudDepart).NbSuivants - 1)
  90.             End If
  91.         End If
  92.     
  93.         Dim i
  94.         Dim NewAngleDeb
  95.         Dim NewAngleFin
  96.         Dim Delta
  97.         Dim NewX, NewY
  98.         Dim dist, Angle As Single '***modifiΘ
  99.         Dim Xp, Yp
  100.  
  101.     
  102.         'Afficher chaque suivant
  103.         For i = 0 To Arbre(NoeudDepart).NbSuivants - 1
  104.             'Calculer les angles limites
  105.             Delta = (90 - Etape * 9)
  106.             NewAngleDeb = IncAngle * i + AngleDeb - Delta / 2
  107.             NewAngleFin = IncAngle * i + AngleDeb + Delta / 2
  108.         
  109.             'Calculer l'angle (en radian)
  110.             Angle = (IncAngle * i + AngleDeb) / 180 * 3.1415926535
  111.             'Dist = frmMap.TextWidth(Arbre(Arbre(NoeudDepart).Suivants(i)).Legende) * 2
  112.             'If NoeudDepart = 0 Then Dist = Dist + frmMap.TextWidth(Arbre(0).Legende)
  113.             'Dist = Dist * 1.1
  114.             
  115.             'Calculer la pos. finale
  116.             Dim texte As String
  117.             Dim AngleTexte As Long
  118.             Dim HCar As Byte
  119.             AngleTexte = Angle * 180 / 3.1415926535 '-Atn((NewY - Y) / (NewX - X)) * 180 / 3.1415926535
  120.             If AngleTexte Mod 360 > 90 And AngleTexte Mod 360 < 270 Then AngleTexte = AngleTexte Mod 360 - 180
  121.             texte = Arbre(Arbre(NoeudDepart).Suivants(i)).Legende
  122.             HCar = ((HauteurArbre(0) - Etape) * 3 / HauteurArbre(0)) ^ 2 + 8
  123.         
  124.             NewX = X + LongueurTexteRot(texte & "OO", HCar) * Cos(Angle)  ' * Dist '((HauteurArbre(0) - Etape + 1) / HauteurArbre(0) * Dist + 10)
  125.             NewY = Y - LongueurTexteRot(texte & "OO", HCar) * Sin(Angle)  '* Dist '((HauteurArbre(0) - Etape + 1) / HauteurArbre(0) * Dist + 10)
  126.  
  127.             If NoeudDepart = 0 Then 'fils de racine ? => agrandir
  128.                 NewX = NewX + Cos(Angle) * Etalon1
  129.                 NewY = NewY - Sin(Angle) * Etalon1
  130.             End If
  131.             
  132.            
  133.             'Tracer une ligne
  134.             frmMap.ForeColor = RGB(Etape * 64 Mod 256, Etape * 128 Mod 256, Etape * 32 Mod 256)
  135.             frmMap.DrawWidth = (HauteurArbre(0) - Etape) + 1
  136.             frmMap.Line (X, Y)-(NewX, NewY)
  137.             frmMap.DrawWidth = 1
  138.            
  139.             '***
  140.             PrintRotfrmMap (X + NewX) / 2, (Y + NewY) / 2, AngleTexte, texte, HCar
  141.                    
  142.             DessinerNoeudEtFils Arbre(NoeudDepart).Suivants(i), _
  143.                NewAngleDeb, NewAngleFin, _
  144.                 NewX, NewY, Etape + 1
  145.         Next i
  146.     End If
  147.     
  148.     'Dessiner la racine
  149.     If Etape = 1 Then DessinerNoeud X, Y, NoeudDepart
  150.     
  151.     
  152.     'Enregistrer la position
  153.     Arbre(NoeudDepart).X = X
  154.     Arbre(NoeudDepart).Y = Y
  155.     If NoeudSelectionne = NoeudDepart And NoeudSelectionne <> 0 Then frmMap.Circle (X, Y), 5, RGB(255, 0, 0)
  156. End Sub 'DessinerNoeudEtFils
  157.  
  158.  
  159.  
  160. 'Dessiner tous le mindmap
  161. Sub DessinerAllMindMap()
  162.     frmMap.Cls
  163.     DessinerNoeudEtFils 0, 0, 360, frmMap.ScaleWidth / 2, frmMap.ScaleHeight / 2, 1
  164. End Sub 'DessinerAllMindMap
  165.  
  166.  
  167.  
  168. Function HauteurArbre(Racine) As Long
  169.     Dim h As Long       'Hauteur de l'arbre
  170.     h = 0               'Hauteur α 0
  171.     
  172.     'Hauteur des fils
  173.     Dim i, HTemp
  174.     For i = 0 To Arbre(Racine).NbSuivants - 1
  175.         HTemp = HauteurArbre(Arbre(Racine).Suivants(i))
  176.         If HTemp > h Then h = HTemp
  177.     Next i
  178.     
  179.     'Retourner la hauteur + 1 pour cet Θtage
  180.     HauteurArbre = h + 1
  181. End Function 'HauteurArbre
  182.  
  183.  
  184.  
  185. 'Retourner le N░ du noeud le plus proche
  186. Function NoeudLePlusProche(X As Long, Y As Long) As Long
  187.     Dim i As Long      'Variable de boucle
  188.     Dim dist As Long, DistTemp As Long 'Distance au point
  189.     Dim Noeud As Long  'Noeud le plus proche
  190.     
  191.     'Initialisation
  192.     dist = -1
  193.     
  194.     'Chercher le point le plus proche
  195.     For i = 0 To UBound(Arbre)
  196.         'Calculer la distance au point
  197.         DistTemp = Sqr((Arbre(i).X - X) ^ 2 + (Arbre(i).Y - Y) ^ 2)
  198.         
  199.         'Distance plus petite ? => on enregistre le point et la distance
  200.         If dist = -1 Or DistTemp < dist Then
  201.             dist = DistTemp
  202.             Noeud = i
  203.         End If
  204.     Next i
  205.     
  206.     'Retourner le noeud le plus proche
  207.     NoeudLePlusProche = Noeud
  208. End Function 'NoeudLePlusProche
  209.