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 / modMap.bas < prev    next >
Encoding:
BASIC Source File  |  2000-08-16  |  9.7 KB  |  256 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.     PositionForcee As Boolean 'true si la positions (x,y) est forcΘe par l'utilisateur
  19. End Type 'TNoeud
  20.  
  21.  
  22. Global Arbre() As TNoeud         'L'arbre du mindmap
  23. Global NoeudSelectionne As Long  'Noeud sΘlectionnΘ
  24.  
  25.  
  26.  
  27. 'Dessiner un noeud
  28. Private Sub DessinerNoeud(x, y, index As Long)
  29.     Dim txtW As Long
  30.     Dim txtH As Long
  31.     Dim w As Long           'Largeur
  32.     Dim h As Long           'Hauteur
  33.     
  34.     'Calculer la hauteur et la largeur
  35.     txtW = frmMap.TextWidth(Arbre(index).Legende)
  36.     txtH = frmMap.TextHeight(Arbre(index).Legende)
  37.     w = txtW * 0.5 + frmMap.TextWidth("OO")
  38.     h = txtH * 0.5 + frmMap.TextHeight("O") / 2
  39.     
  40.     'Dessiner le centre
  41.     frmMap.FillColor = RGB(255, 255, 255)
  42.     frmMap.FillStyle = 0 'solide
  43.     frmMap.DrawWidth = 2
  44.     frmMap.Circle (frmMap.ScaleWidth / 2 + x, frmMap.ScaleHeight / 2 + y), w, , , , h / w
  45.     frmMap.DrawWidth = 1
  46.     
  47.     'SΘlectionnΘ ? => tracer un cadre traitillΘ autour de l'ellipse
  48.     If index = NoeudSelectionne Then
  49.         frmMap.ForeColor = 0
  50.         frmMap.DrawStyle = 2
  51.         frmMap.FillStyle = 1 'transparent
  52.         frmMap.Line (frmMap.ScaleWidth / 2 + x - txtW / 2 - 2, frmMap.ScaleHeight / 2 + y - txtH / 2 - 2)-(frmMap.ScaleWidth / 2 + x + txtW / 2 + 2, frmMap.ScaleHeight / 2 + y + txtH / 2 + 2), , B
  53.         frmMap.DrawStyle = 0
  54.     End If
  55.     
  56.     'Afficher le label
  57.     frmMap.CurrentX = frmMap.ScaleWidth / 2 + x - txtW / 2
  58.     frmMap.CurrentY = frmMap.ScaleHeight / 2 + y - txtH / 2
  59.     frmMap.ForeColor = 0 'Couleur du cadre
  60.     'frmMap.BackColor = RGB(255, 255, 200)
  61.     'frmMap.FillColor = RGB(0, 255, 0)
  62.     frmMap.Print Arbre(index).Legende & vbCrLf & Arbre(index).URL
  63.     
  64.     'Enregistrer la position
  65.     'If Not Arbre(index).PositionForcee Then
  66.     '    Arbre(index).x = x
  67.     '    Arbre(index).y = y
  68.     'End If
  69. End Sub 'DessinerNoeud
  70.  
  71.  
  72.  
  73. Private Sub DessinerNoeudEtFils(NoeudDepart As Long, Etape)
  74.  Dim NewX, NewY, AngleTexte As Single, text As String, hcar As Byte, i, x, y
  75.     x = Arbre(NoeudDepart).x
  76.     y = Arbre(NoeudDepart).y
  77.  
  78.     'Dessiner les suivants
  79.     If Arbre(NoeudDepart).NbSuivants > 0 Then
  80.         'Afficher chaque suivant
  81.         For i = 0 To Arbre(NoeudDepart).NbSuivants - 1
  82.             'CoordonnΘes
  83.             NewX = Arbre(Arbre(NoeudDepart).Suivants(i)).x
  84.             NewY = Arbre(Arbre(NoeudDepart).Suivants(i)).y
  85.             
  86.             'ReCalculer l'angle du texte
  87.             If x = NewX Then
  88.                 AngleTexte = 90
  89.             Else
  90.                 AngleTexte = -Atn((NewY - y) / (NewX - x)) * 180 / 3.1415926535
  91.             End If
  92.             
  93.                         
  94.             'Forcer la position ?
  95.             If Arbre(Arbre(NoeudDepart).Suivants(i)).PositionForcee Then
  96.                 'Afficher un rond => pos forcΘe ?
  97.                 If frmMDI.mnuNoeudsAffNPosForcee.Checked = True Then
  98.                     frmMap.FillStyle = 0 'solide
  99.                     frmMap.FillColor = RGB(0, 0, 255)
  100.                     frmMap.Circle (frmMap.ScaleWidth / 2 + NewX, frmMap.ScaleHeight / 2 + NewY), 5, RGB(0, 0, 255)
  101.                     frmMap.FillStyle = 1 'transparent
  102.                 End If
  103.             End If
  104.             
  105.             'Tracer une ligne
  106.             frmMap.ForeColor = RGB(Etape * 64 Mod 256, Etape * 128 Mod 256, Etape * 32 Mod 256)
  107.             frmMap.DrawWidth = ((HauteurArbre(0) - Etape) / HauteurArbre(0) * 3) ^ 2 + 1
  108.             frmMap.Line (frmMap.ScaleWidth / 2 + x, frmMap.ScaleHeight / 2 + y)-(frmMap.ScaleWidth / 2 + NewX, frmMap.ScaleHeight / 2 + NewY)
  109.             frmMap.DrawWidth = 1
  110.            
  111.             '***
  112.             hcar = ((HauteurArbre(0) - Etape) * 3 / HauteurArbre(0)) ^ 2 + 8
  113.             text = Arbre(Arbre(NoeudDepart).Suivants(i)).Legende
  114.             Dim XTexte As Long, YTexte As Long, Angle As Single
  115.             If Etape = 1 Then
  116.                 XTexte = frmMap.ScaleWidth / 2 + (3 * NewX + 2 * x) / 5 '- Cos(AngleTexte) * Dist
  117.                 YTexte = frmMap.ScaleHeight / 2 + (3 * NewY + 2 * y) / 5 '- Sin(AngleTexte) * Dist
  118.             Else
  119.                 XTexte = frmMap.ScaleWidth / 2 + (NewX + x) / 2  '- Cos(AngleTexte) * Dist
  120.                 YTexte = frmMap.ScaleHeight / 2 + (NewY + y) / 2  '- Sin(AngleTexte) * Dist
  121.             End If
  122.             
  123.             'If NewX - x < 0 Then Angle = AngleTexte + 180
  124.             
  125.             XTexte = XTexte + frmMap.TextHeight("O") / 4 * Cos((90 - Angle) * 3.1415926535 / 180) * 2
  126.             YTexte = YTexte + frmMap.TextHeight("O") / 4 * Sin((90 - Angle) * 3.1415926535 / 180) * 2
  127.             PrintRotfrmMap XTexte, YTexte, AngleTexte, text, hcar
  128.                                       
  129.             DessinerNoeudEtFils Arbre(NoeudDepart).Suivants(i), Etape + 1
  130.         Next i
  131.     End If
  132.     
  133.     'Dessiner la racine
  134.     If Etape = 1 Then DessinerNoeud x, y, NoeudDepart
  135.     
  136.     'Noeud sΘlectionnΘ => tracer un cercle
  137.     If NoeudSelectionne = NoeudDepart And NoeudSelectionne <> 0 Then
  138.         frmMap.FillColor = RGB(255, 255, 255)
  139.         frmMap.ForeColor = RGB(255, 0, 0)
  140.         frmMap.FillStyle = 0 'solide
  141.         frmMap.Circle (frmMap.ScaleWidth / 2 + x, frmMap.ScaleHeight / 2 + y), 5, RGB(255, 0, 0)
  142.     End If
  143. End Sub 'DessinerNoeudEtFils
  144.  
  145.  
  146.  
  147. 'Dessiner tous le mindmap
  148. Sub DessinerAllMindMap()
  149.     frmMap.Cls
  150.     CalculerCoordonnees
  151.     DessinerNoeudEtFils 0, 1
  152. End Sub 'DessinerAllMindMap
  153.  
  154.  
  155. 'Calculer les coordonnΘes de tous les noeuds par rΘcursion
  156. Private Sub CalculerCoordonneesRec(NoeudDepart As Long, AngleDeb, AngleFin, x, y, Etape)
  157.     Arbre(NoeudDepart).x = x
  158.     Arbre(NoeudDepart).y = y
  159.     
  160.  
  161.     'Dessiner les suivants
  162.     If Arbre(NoeudDepart).NbSuivants > 0 Then
  163.         'Normaliser les angles
  164.         Dim IncAngle
  165.         If AngleDeb < 0 Then AngleDeb = AngleDeb + 360
  166.         If AngleFin < AngleDeb Then AngleFin = AngleFin + 360
  167.     
  168.         'Calculer l'incrΘment
  169.         If Arbre(NoeudDepart).NbSuivants = 1 Then
  170.             IncAngle = 0
  171.             AngleDeb = (AngleDeb + AngleFin) / 2
  172.         Else
  173.             If AngleDeb Mod 360 = AngleFin Mod 360 Then
  174.                 IncAngle = (AngleFin - AngleDeb) / (Arbre(NoeudDepart).NbSuivants)
  175.             Else
  176.                 IncAngle = (AngleFin - AngleDeb) / (Arbre(NoeudDepart).NbSuivants - 1)
  177.             End If
  178.         End If
  179.     
  180.         Dim i
  181.         Dim NewAngleDeb
  182.         Dim NewAngleFin
  183.         Dim Delta
  184.         Dim NewX, NewY
  185.         Dim Dist, Angle As Single '***modifiΘ
  186.         Dim Xp, Yp
  187.  
  188.     
  189.         'Afficher chaque suivant
  190.         For i = 0 To Arbre(NoeudDepart).NbSuivants - 1
  191.             'Calculer les angles limites
  192.             Delta = (90 - Etape * 9)
  193.             NewAngleDeb = IncAngle * i + AngleDeb - Delta / 2
  194.             NewAngleFin = IncAngle * i + AngleDeb + Delta / 2
  195.         
  196.             'Calculer l'angle (en radian)
  197.             Angle = (IncAngle * i + AngleDeb) / 180 * 3.1415926535
  198.             
  199.             'Calculer la pos. finale
  200.             Dim texte As String
  201.             Dim AngleTexte As Long
  202.             Dim hcar As Byte
  203.             AngleTexte = Angle * 180 / 3.1415926535 '-Atn((NewY - Y) / (NewX - X)) * 180 / 3.1415926535
  204.             If AngleTexte Mod 360 > 90 And AngleTexte Mod 360 < 270 Then AngleTexte = AngleTexte Mod 360 - 180
  205.             texte = Arbre(Arbre(NoeudDepart).Suivants(i)).Legende
  206.             hcar = ((HauteurArbre(0) - Etape) * 3 / HauteurArbre(0)) ^ 2 + 8
  207.             
  208.             'Forcer la position ?
  209.             If Arbre(Arbre(NoeudDepart).Suivants(i)).PositionForcee Then
  210.                 NewX = Arbre(Arbre(NoeudDepart).Suivants(i)).x
  211.                 NewY = Arbre(Arbre(NoeudDepart).Suivants(i)).y
  212.                 
  213.                 'ReCalculer l'angle du texte
  214.                 AngleTexte = -Atn((NewY - y) / (NewX - x + 0.000001)) * 180 / 3.1415926535
  215.             Else
  216.                 NewX = x + LongueurTexteRot(texte & "OO", hcar) * Cos(Angle)  ' * Dist '((HauteurArbre(0) - Etape + 1) / HauteurArbre(0) * Dist + 10)
  217.                 NewY = y - LongueurTexteRot(texte & "OO", hcar) * Sin(Angle)  '* Dist '((HauteurArbre(0) - Etape + 1) / HauteurArbre(0) * Dist + 10)
  218.                 
  219.                 If NoeudDepart = 0 Then 'fils de racine ? => agrandir
  220.                     NewX = NewX + LongueurTexteRot(Arbre(0).Legende & "OO", hcar) / 2 * Cos(Angle)
  221.                     NewY = NewY - LongueurTexteRot(Arbre(0).Legende, hcar) / 2 * Sin(Angle)
  222.                 End If
  223.             End If
  224.                            
  225.                    
  226.             CalculerCoordonneesRec Arbre(NoeudDepart).Suivants(i), NewAngleDeb, NewAngleFin, NewX, NewY, Etape + 1
  227.         Next i
  228.     End If
  229. End Sub 'DessinerNoeudEtFils
  230.  
  231.  
  232.  
  233. 'Calculer les coordonnΘes de tous les noeuds (sauf les noeuds fixΘs)
  234. Sub CalculerCoordonnees()
  235.     CalculerCoordonneesRec 0, 0, 360, 0, 0, 1
  236. End Sub 'CalculerCoordonnees
  237.  
  238.  
  239.  
  240. Function HauteurArbre(Racine) As Long
  241.     Dim h As Long       'Hauteur de l'arbre
  242.     h = 0               'Hauteur α 0
  243.     
  244.     'Hauteur des fils
  245.     Dim i, HTemp
  246.     For i = 0 To Arbre(Racine).NbSuivants - 1
  247.         HTemp = HauteurArbre(Arbre(Racine).Suivants(i))
  248.         If HTemp > h Then h = HTemp
  249.     Next i
  250.     
  251.     'Retourner la hauteur + 1 pour cet Θtage
  252.     HauteurArbre = h + 1
  253. End Function 'HauteurArbre
  254.  
  255.  
  256.