bONJOUR !
j'étais besoin dans mon projet en TGA (theorie de graphe) d'une fleche pour faire un graphe
avec vb6 mais ma recherche n'aboutit a rien donc j'ai effectué ce travail individuel
pour montrer comment on peut dessiner une flèche a l'aide de geometrie!
ce petit code ecrit en vb6 vous permet de dessiner un graphe avec des flèches.
comment dessiner un fleche ?
A l'aide de la bouton droite de la souris cliquer sur le corps de depart puis
sur le corps de destination et comme ça le fleche est inséré avec une couleur aleatoire.
comment actualiser le schéma ?
tout simplement on appuyant sur la bouton gauche de la souris sur le pictureBox le graphe
s'actualise.
Nouveau corps ?
pour avoir un nouveau noeuds.
comment bouger un noeuds?
avec une simple click sur le noeud puis on fait bouger le souris et le noued va bouger!
Source / Exemple :
je vais afficher ici seulement la méthode essentielle (flèche) :
Private Sub Fleche(ByVal index1 As Integer, ByVal index2 As Integer, color As Double, largeur As Integer)
On Error Resume Next
Dim left1, left2, top1, top2, mesure As Integer
Picture1.DrawWidth = largeur
'degager les coordonnees des deux corps
left1 = Corps(index1).Left
left2 = Corps(index2).Left
top1 = Corps(index1).Top
top2 = Corps(index2).Top
mesure = Corps(index1).Width
'1er cas : a peu pres en meme ligne
If top1 <= top2 + 1000 And top1 >= top2 - 1000 Then
If left1 < left2 Then
Picture1.Line (left1 + mesure, top1 + mesure / 2)-(left2, top2 + mesure / 2), color
Picture1.Line (left2, top2 + mesure / 2)-(left2 - mesure / 2, top2), color
Picture1.Line (left2, top2 + mesure / 2)-(left2 - mesure / 2, top2 + mesure), color
Else
Picture1.Line (left1, top1 + mesure / 2)-(left2 + mesure, top2 + mesure / 2), color
Picture1.Line (left2 + mesure, top2 + mesure / 2)-(left2 + mesure * 1.5, top2), color
Picture1.Line (left2 + mesure, top2 + mesure / 2)-(left2 + mesure * 1.5, top2 + mesure), color
End If
'2eme cas : a peu pres en meme colonne
Else
If left1 <= left2 + 1000 And left1 >= left2 - 1000 Then
If top1 < top2 Then
Picture1.Line (left1 + mesure / 2, top1 + mesure)-(left2 + mesure / 2, top2), color
Picture1.Line (left2 + mesure / 2, top2)-(left2, top2 - mesure / 2), color
Picture1.Line (left2 + mesure / 2, top2)-(left2 + mesure, top2 - mesure / 2), color
Else
Picture1.Line (left1 + mesure / 2, top1)-(left2 + mesure / 2, top2 + mesure), color
Picture1.Line (left2 + mesure / 2, top2 + mesure)-(left2, top2 + mesure * 1.5), color
Picture1.Line (left2 + mesure / 2, top2 + mesure)-(left2 + mesure, top2 + mesure * 1.5), color
End If
Else
'3eme cas : 1 diagonale
If top1 > top2 And left1 > left2 Then
Picture1.Line (left1, top1)-(left2 + mesure, top2 + mesure), color
Picture1.Line (left2 + mesure, top2 + mesure)-(left2 + mesure * 1.5, top2 + mesure), color
Picture1.Line (left2 + mesure, top2 + mesure)-(left2 + mesure, top2 + mesure * 1.5), color
Else
'inverse
If top1 < top2 And left1 < left2 Then
Picture1.Line (left1 + mesure, top1 + mesure)-(left2, top2), color
Picture1.Line (left2, top2)-(left2 - mesure / 2, top2), color
Picture1.Line (left2, top2)-(left2, top2 - mesure / 2), color
Else
'4eme diagonale
If top1 < top2 Then
Picture1.Line (left1, top1 + mesure)-(left2 + mesure, top2), color
Picture1.Line (left2 + mesure, top2)-(left2 + mesure * 1.5, top2), color
Picture1.Line (left2 + mesure, top2)-(left2 + mesure, top2 - mesure / 2), color
Else
Picture1.Line (left1 + mesure, top1)-(left2, top2 + mesure), color
Picture1.Line (left2, top2 + mesure)-(left2 - mesure / 2, top2 + mesure), color
Picture1.Line (left2, top2 + mesure)-(left2, top2 + mesure * 1.5), color
End If
End If
End If
End If
End If
End Sub
Conclusion :
vos remarques sont très importants pour moi !!!
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.