re j' ai trouver ma solution !!
héhéhé!!!
bon alors je ne sais pas pourquoi j'ai eté objigé d'ajouter 2 ligne dans le calcul si je met le tout dans une seul fonction mais j'y suis arrivé
il fallait comparer le nombre de colonne * L + le nombre de colonne*ec pour le xx et pareillement pour le yy et la on a plus de soucis avec les interstices
cerde2000 c'est normal que ca fasse beaucoup de post c'est un sujet assez récurrent (les classes sans classe ;)) et jusqu'à présent personne n'avais proposer quoi que ce soit
je suis en train de travailler sur une solution encore plus farfelue et la il n'y aura pas de boucle du tout ni de calcul
en tout cas parti de mon idée de colonne toi et Mercatog avec vos vectorielles vous avez fait forts
voila ma version en une seul fonction :
Code:
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
| Option Explicit
'Généralisation des dimensions et nombre de labels
Const Nc As Integer = 30 'nombre de labels en colonnes
Const Nl As Integer = 21 'nombre de labels en lignes
Const L As Integer = 20 'largeur des labels
Const H As Integer = 12 'hauteur des labels
Const Ec As Integer = 5 'Ecart horizontal entre labels
Const El As Integer = 2 'Ecart vertical entre labels
Dim Couleur() As Long 'On peut s'en passer si tous les labels ont la même couleur
Dim old
Private Sub UserForm_Initialize()
Dim i As Integer, j As Integer, k As Integer
Dim Lbl As Control
'Règlage de la taille et la position du contrôle image
With Me.Image1
.Left = 0
.Top = 0
.Width = Nc * (L + Ec) + 2 * Ec
.Height = Nl * (H + El) + 2 * El
.ZOrder 0
.BackStyle = 0
.BorderStyle = 0
End With
ReDim Couleur(1 To Nc * Nl)
For i = 1 To Nl
For j = 1 To Nc
k = Nc * (i - 1) + j
Set Lbl = Me.Controls.Add("Forms.Label.1", "LB" & k, True)
With Lbl
.Left = Ec + ((L + Ec) * (j - 1))
.Top = El + ((H + El) * (i - 1))
.Width = L
.Height = H
.Caption = "LB" & k
.TextAlign = 2
.BorderStyle = 1
.ZOrder 1
.BackColor = 225
Couleur(k) = .BackColor
End With
Next j
Next i
End Sub
Private Sub Image1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim Indx As Integer
If old <> 0 Then Me("LB" & old).BackColor = Couleur(old)
Indx = FindLabel2(X, Y)
If Indx <> 0 Then
If Indx > Nc * Nl Then Exit Sub
Me.Caption = "Label survolé: LB" & Indx
old = Indx
Me("LB" & Indx).BackColor = vbWhite
End If
End Sub
Private Function FindLabel2(ByVal xX As Single, ByVal yY As Single) As Long
Dim Col As Integer, Lig As Integer, NX As Single, NY As Single, X As Integer, Y As Integer
FindLabel2 = 0
' on calcule la colonne
X = L + Ec: NX = xX \ X
If xX - NX * X >= Ec And xX - NX * X <= X Then NX = NX + 1
' on calcule la ligne
Y = H + El: NY = yY \ Y
If yY - NY * Y >= El And yY - NY * Y <= Y Then NY = NY + 1
' c'est ici qu'il faut ajouter la comparaison de xx a la largeur d'un label * par NX + largeur ec * par NX
' et pareil pour yy
' par contre je ne comprends pas pourquoi en separant les deux 'xx et yy )
'dans un retour different de la meme fonction je n'ai pas besoins de ces deux lignes suivantes
If xX > (L * NX) + (Ec * (NX)) Then NX = 0
If yY > (H * NY) + (El * NY) Then NY = 0
If NY * NX > 0 Then FindLabel2 = (Nc * NY) - (Nc - NX)
End Function
Private Sub Image1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
MsgBox "LB" & FindLabel2(X, Y)
End Sub |