Objets réagissant au survol de la souris, sans clic !

J'ai trouvé une astuce pour faire réagir des objets au survol de la souris, sans avoir à cliquer dedans !

Le programme utilise KGF.dll et KGF_SUB.bas.

Les zones EDIT et MEMO de ce programme se colorient en rouge au survol de la souris.

Au lieu de colorier en rouge, on pourrait imaginer n'importe quoi d'autre.

Si cette fonctionnalité vous intéresse, je la rendrai disponible sous une forme facile à utiliser. Voici la démo:

Code:: ' test_mouse_over.bas

label scruter

dim x%, y%, i%, k%, kold%, ki%, kiold%
dim objets%(7), nobj%, gauche%(7),haut%(7),large%(7),hauteur%(7)
dim colorer%(7)
nobj% = 7
objets%(1) = 1
objets%(2) = 2
objets%(3) = 11
objets%(4) = 12
objets%(5) = 13
objets%(6) = 14
objets%(7) = 10
colorer%(1) = 0
colorer%(2) = 1
colorer%(3) = 0
colorer%(4) = 1
colorer%(5) = 0
colorer%(6) = 1
colorer%(7) = 0

alpha 1 : top 1,10 : left 1,10 : caption 1,"Votre nom:"
edit 2 : top 2,10 : left 2,70 : width 2,200

container 10 : top 10,40 : left 10,10 : caption 10,"Fiche personnelle"
width 10,400 : height 10,300

alpha 11 : parent 11,10 : top 11,20 : left 11,10 : caption 11,"Adresse:"
memo 12 : parent 12,10 : top 12,20 : left 12,80
width 12,200 : height 12,50
alpha 13 : parent 13,10 : top 13,80 : left 13,10 : caption 13,"Numéro SS:"
edit 14 : parent 14,10 : top 14,80 : left 14,80 : width 14,200

for i%=1 to 7
gauche%(i%) = left(objets%(i%))
haut%(i%) = top(objets%(i%))
large%(i%) = width(objets%(i%))
hauteur%(i%) = height(objets%(i%))
next i%
for i%=3 to 6
gauche%(i%) = gauche%(i%) + left(objets%(7))
haut%(i%) = haut%(i%) + top(objets%(7))
next i%

alpha 99 : top 99,400 : left 99,10 : caption 99,"Repos"

timer 100 : timer_interval 100,100 : on_timer 100,scruter

KGF_initialize("KGF.dll")

end

scruter:
timer_off 100
GetMousePosition(handle(0))
x% = GetMousePositionX%
y% = GetMousePositionY%
if (x%>=0) and (y%>=0)
k% = 0
ki% = 0
for i%=1 to 7
if x%>=gauche%(i%)
if x%<(gauche%(i%)+large%(i%))
if y%>=haut%(i%)
if y%<(haut%(i%)+hauteur%(i%))
k% = objets%(i%)
ki% = i%
exit_for
end_if
end_if
end_if
end_if
next i%
if k%>0
if kold%>0
if colorer%(kiold%)=1 then color kold%,255,255,255
end_if
kold% = k%
kiold% = ki%
if kold%>0
if colorer%(kiold%)=1 then color kold%,255,0,0
end_if
end_if
caption 99,str$(x%)+","+str$(y%)+" sur objet "+str$(k%)
else
caption 99,"Sorti"
end_if
timer_on 100
return

#INCLUDE "KGF_SUB.bas"

Et comment qu'elle est bien cette fonction. Wink

Bravo Klaus

Alors, voici une version de "production", utilisable facilement par #INCLUDE.

Programme de démo:

Code:: ' test_mouse_over.bas

' === définition de quelques objets dont le survol est contrôlé
alpha 1 : top 1,10 : left 1,10 : caption 1,"Votre nom:"
edit 2 : top 2,10 : left 2,70 : width 2,200
container 10 : top 10,40 : left 10,10 : caption 10,"Fiche personnelle"
width 10,400 : height 10,300
alpha 11 : parent 11,10 : top 11,20 : left 11,10 : caption 11,"Adresse:"
memo 12 : parent 12,10 : top 12,20 : left 12,80
width 12,200 : height 12,50
alpha 13 : parent 13,10 : top 13,80 : left 13,10 : caption 13,"Numéro SS:"
edit 14 : parent 14,10 : top 14,80 : left 14,80 : width 14,200
list 15 : top 15,10 : left 15,430 : height 15,400

' objet pour la trace du programme
alpha 99 : top 99,400 : left 99,10 : caption 99,"Repos"

KGF_initialize("KGF.dll")

create_mouse_over(8,100)
add_mouse_over(1,0,0,0,0)
add_mouse_over(2,0,255,0,0)
add_mouse_over(11,10,0,0,0)
add_mouse_over(12,10,0,255,255)
add_mouse_over(13,10,0,0,0)
add_mouse_over(14,10,0,255,255)
add_mouse_over(10,0,0,0,0)
add_mouse_over(15,0,255,255,0)

end

' cette procédure est appelée chaque fois que le curseur entre
' dans un des objets surveillés, ou sur la form 0
' flag%=1 ==> on est dans la form
' flag%=0 ==> on est en-dehors de la form
sub on_mouse_over(flag%,obj%)
if flag%=1
caption 99,str$(mouse_over_x%)+","+str$(mouse_over_y%)+" sur objet "+str$(obj%)+" "+str$(mouse_over_n%)
' à titre d'exemple, on va interdire l'entrée dans le champ "adresse"
' (objet 12) si le nom est vide (objet 2)
if mouse_over_k%=12
if trim$(text$(2))=""
MousePosition(left(12)+width(12)+left(10)+10,top(12)+top(10)+10)
end_if
end_if
else
caption 99,"Sorti"
end_if
end_sub

#INCLUDE "mouse_over_SUB.bas"
#INCLUDE "KGF_SUB.bas"

et le module mouse_over_SUB.bas:

Code:: ' mouse_over_SUB.bas

' le programme principal doit contenir une procédure on_mouse_over().
' Cette procédure sera appelée chaque fois que le curseur entre dans
' un objet surveillé. Avant d'appeler cette procédure, le programme
' effectue un éventuel changement de couleur, mais cette procédure est
' appelée pour tout objet scruté dans lequel le curseur entre, même
' s'il n'y a pas de changement de couleur.
'
' sub on_mouse_over(flag%,obj%)
' if flag%=1
' traiter ici l'évènement "dans la form" pour objet obj%
' else
' traiter ici l'évènement "en-dehors de la form"
' end_if
' end_sub

message "mouse_over: ce module ne peut pas être exécuté directement."
terminate

' ===== routine évènement pour le timer (usage internne)
mouse_over_scruter:
timer_off mouse_over_ntimer%
GetMousePosition(handle(0))
mouse_over_x% = GetMousePositionX%
mouse_over_y% = GetMousePositionY%
if (mouse_over_x%>=0) and (mouse_over_y%>=0)
mouse_over_kold% = mouse_over_k%
mouse_over_kiold% = mouse_over_ki%
mouse_over_k% = 0
mouse_over_ki% = 0
for mouse_over_i%=1 to mouse_over_nobj%
if mouse_over_x%>=mouse_over_gauche%(mouse_over_i%)
if mouse_over_x%<(mouse_over_gauche%(mouse_over_i%)+mouse_over_largeur%(mouse_over_i%))
if mouse_over_y%>=mouse_over_haut%(mouse_over_i%)
if mouse_over_y%<(mouse_over_haut%(mouse_over_i%)+mouse_over_hauteur%(mouse_over_i%))
mouse_over_k% = mouse_over_objets%(mouse_over_i%)
mouse_over_ki% = mouse_over_i%
exit_for
end_if
end_if
end_if
end_if
next mouse_over_i%
if mouse_over_k%<>mouse_over_kold%
if mouse_over_kold%>0
if mouse_over_colorer%(mouse_over_kiold%)=1 then color mouse_over_kold%,255,255,255
end_if
if mouse_over_k%>0
if mouse_over_colorer%(mouse_over_ki%)=1
color mouse_over_k%,mouse_over_RGB%(mouse_over_ki%,1),mouse_over_RGB%(mouse_over_ki%,2),mouse_over_RGB%(mouse_over_ki%,3)
end_if
end_if
mouse_over_n% = mouse_over_n% + 1
on_mouse_over(1,mouse_over_k%)
end_if
else
on_mouse_over(0,0)
end_if
timer_on mouse_over_ntimer%
return

' ===== création du système mouse_over
' maxobj% ==> nombre maxi d'objets à scruter
' ntimer% ==> un numéro d'objet disponible pour créer le timer interne
sub create_mouse_over(maxobj%,ntimer%)
if label("mouse_over_scruter")=0 then label mouse_over_scruter
if variable("mouse_over_nobj%")=0
dim mouse_over_maxobj% : mouse_over_maxobj% = maxobj%
dim mouse_over_ntimer% : mouse_over_ntimer% = ntimer%
dim mouse_over_nobj%
dim mouse_over_k%
dim mouse_over_ki%
dim mouse_over_kold%
dim mouse_over_kiold%
dim mouse_over_i%
dim mouse_over_n%
dim mouse_over_x%
dim mouse_over_y%
dim mouse_over_objets%(mouse_over_maxobj%)
dim mouse_over_gauche%(mouse_over_maxobj%)
dim mouse_over_haut%(mouse_over_maxobj%)
dim mouse_over_largeur%(mouse_over_maxobj%)
dim mouse_over_hauteur%(mouse_over_maxobj%)
dim mouse_over_colorer%(mouse_over_maxobj%)
dim mouse_over_RGB%(mouse_over_maxobj%,3)
timer mouse_over_ntimer% : timer_interval mouse_over_ntimer%,100
on_timer mouse_over_ntimer%,mouse_over_scruter
end_if
end_sub

' ===== supprimer le système mouse_over
sub delete_mouse_over()
if variable("mouse_over_nobj%")=1
timer_off mouse_over_ntimer%
delete mouse_over_ntimer%
free mouse_over_maxobj%
free mouse_over_ntimer%
free mouse_over_nobj%
free mouse_over_k%
free mouse_over_ki%
free mouse_over_kold%
free mouse_over_kiold%
free mouse_over_i%
free mouse_over_n%
free mouse_over_x%
free mouse_over_y%
free mouse_over_objets%
free mouse_over_gauche%
free mouse_over_haut%
free mouse_over_large%
free mouse_over_hauteur%
free mouse_over_colorer%
free mouse_over_RGB%
end_if
end_sub

' ===== ajouter un objet à surveiller au système mouse_over
' obj% ==> numéro de l'objet
' parent% ==> numéro de l'objet parent de obj%
' R%, G%, B% ==> couleurs RGB pour changement de couleur de fond
' R%=G%=B%=0 ==> pas de changement de couleur
sub add_mouse_over(obj%,parent%,R%,G%,B%)
if mouse_over_nobj%<mouse_over_maxobj%
mouse_over_nobj% = mouse_over_nobj% + 1
mouse_over_objets%(mouse_over_nobj%) = obj%
if parent%=0
mouse_over_gauche%(mouse_over_nobj%) = left(obj%)
mouse_over_haut%(mouse_over_nobj%) = top(obj%)
else
mouse_over_gauche%(mouse_over_nobj%) = left(obj%)+left(parent%)
mouse_over_haut%(mouse_over_nobj%) = top(obj%)+top(parent%)
end_if
mouse_over_largeur%(mouse_over_nobj%) = width(obj%)
mouse_over_hauteur%(mouse_over_nobj%) = height(obj%)
if (R%=0) and (G%=0) and (B%=0)
mouse_over_colorer%(mouse_over_nobj%) = 0
else
mouse_over_colorer%(mouse_over_nobj%) = 1
mouse_over_RGB%(mouse_over_nobj%,1) = R%
mouse_over_RGB%(mouse_over_nobj%,2) = G%
mouse_over_RGB%(mouse_over_nobj%,3) = B%
end_if
end_if
end_sub

Le code est documenté.

Une brève explication: il y a deux objets placés directement sur la form 0, puis un container ayant lui-même 4 objets. La boucle de reconnaissance parcourt la table des numéros d'objets, dans l'ordre chronologique de leur ajout. Il est donc nécessaire d'ajouter d'abord tous les objets individuels, et le container après, car sinon, le programme s'arrêtera à la reconnaissance du container lorsque le curseur y entrera et ne réagira plus lorsque le curseur entre dans un des objets du container.

Et pour montrer que la routine on_mouse_over fonctionne vraiment comme une routine évènement, j'ai interdit le survol du mémo adresse (objet 12) si l'edit nom (objet 2) n'est pas renseigné. Spectaculaire !

EDIT

J'ai modifié les 2 modules pour passer le numéro de l'objet concerné en paramètre à la procédure on_mouse_over(). C''est plus intuitif comme ça.

Invité

C'est bien Klaus.
Dire qu'en voyant le sujet sur un objet TreeViem je crois, et en regardant Delphi, j'avais fait un poste pour te répondre et te demandé si te serais pas possible de faire cette dll. Et puis j'ai effacé, vu que tu voulais que ce soit en Panoramic pur, et que tu avais mieux à faire!

En effet, ce sera sympa avec l'affichage de l'arborescence.
On survol un élément, la ligne change de couleur , on clique ça le déplit ou le replit

L'objet LIST de Panoramic ne sait pas colorier une ligne ! On peut changer globalement la couleur de fond, ou globalement la couleur ou les attributs de la police, mais pas pour une seule ligne.

EDIT

Et sans faire un clic, comment identifier la ligne sur laquelle se trouve le curseur ? On ne connaît que les coordonnées x et y, mais en fonction de la police, de sa taille et de ses attributs, les lignes sont plus ou moins hautes !

Correction d'un bug dans mouse_over_SUB.bas. Mis à jour dans le post plus haut. Le programme test_mouse_over.bas a été mis à jour aussi, mais indépendamment de ce bug: c'est pour ajouter un objet LIST dans la surveillance.

J'ai ajouté une fonction à KGF.dll permettant de connaître le numéro de lignesous le curseur d'un objet LIST ! KGF.dll, KGF_SUB.bas et demo_KGF_SUB.bas ont été mis à jour.

J'ai utilisé cette fonction pour afficher le numéro de ligne de la list, lorsque le curseur glisse dessus.

Ceci implique une surveillance permanente, et pas seulement lorsque le curseur entre ou sort d'un objet. J'ai donc ajouté une case à cocher dans le programme de démo pour choisir le moce de surveillance (par défaut: surveillance permanente). Ainsi, vous verrez le changement de comportement.

Je republie ici les sources nouvelle version:

test_mouse_over.bas:

Code:: ' test_mouse_over.bas

label changer_type
dim res%

' === définition de quelques objets dont le survol est contrôlé
alpha 1 : top 1,10 : left 1,10 : caption 1,"Votre nom:"
edit 2 : top 2,10 : left 2,70 : width 2,200
container 10 : top 10,40 : left 10,10 : caption 10,"Fiche personnelle"
width 10,400 : height 10,300
alpha 11 : parent 11,10 : top 11,20 : left 11,10 : caption 11,"Adresse:"
memo 12 : parent 12,10 : top 12,20 : left 12,80
width 12,200 : height 12,50
alpha 13 : parent 13,10 : top 13,80 : left 13,10 : caption 13,"Numéro SS:"
edit 14 : parent 14,10 : top 14,80 : left 14,80 : width 14,200
list 15 : top 15,10 : left 15,430 : height 15,400
item_add 15,"aaaaaa"
item_add 15,"bbbbbb"
item_add 15,"cccccc"
check 16 : top 16,340 : left 16,10 : caption 16,"Surveillance permanente"
width 16,150 : mark_on 16 : on_click 16,changer_type
check 17 : top 17,360 : left 17,10 : caption 17,"Sélection dans liste par glissement"
width 17,250 : mark_off 17

' objet pour la trace du programme
alpha 99 : top 99,400 : left 99,10 : caption 99,"Repos"

KGF_initialize("KGF.dll")

create_mouse_over(8,100,1)
add_mouse_over(1,0,0,0,0)
add_mouse_over(2,0,255,0,0)
add_mouse_over(11,10,0,0,0)
add_mouse_over(12,10,0,255,255)
add_mouse_over(13,10,0,0,0)
add_mouse_over(14,10,0,255,255)
add_mouse_over(10,0,0,0,0)
add_mouse_over(15,0,255,255,0)

end

changer_type:
mouse_over_type(checked(16))
return

' cette procédure est appelée chaque fois que le curseur entre
' dans un des objets surveillés, ou sur la form 0
' flag%=1 ==> on est dans la form
' flag%=0 ==> on est en-dehors de la form
sub on_mouse_over(flag%,obj%)
if flag%=1
caption 99,str$(mouse_over_x%)+","+str$(mouse_over_y%)+" sur objet "+str$(obj%)+" "+str$(mouse_over_n%)
' à titre d'exemple, on va interdire l'entrée dans le champ "adresse"
' (objet 12) si le nom est vide (objet 2)
if obj%=12
if trim$(text$(2))=""
MousePosition(left(12)+width(12)+left(10)+10,top(12)+top(10)+10)
end_if
end_if
if object_type(obj%)=8
GetListBoxItemFromPoint(obj%,mouse_over_x%, mouse_over_y%)
if GetListBoxItemFromPoint>0
if checked(17)=1 then
SelectListBoxItem(handle(obj%),GetListBoxItemFromPoint)
end_if
caption 99,str$(mouse_over_x%)+","+str$(mouse_over_y%)+" sur objet "+str$(obj%)+" "+str$(mouse_over_n%)+" item "+str$(GetListBoxItemFromPoint)
end_if
else
caption 99,"Sorti"
end_if
end_sub

#INCLUDE "mouse_over_SUB.bas"
#INCLUDE "KGF_SUB.bas"

mouse_over_SUB.bas:

Code:: ' mouse_over_SUB.bas

' le programme principal doit contenir une procédure on_mouse_over().
' Cette procédure sera appelée chaque fois que le curseur entre dans
' un objet surveillé. Avant d'appeler cette procédure, le programme
' effectue un éventuel changement de couleur, mais cette procédure est
' appelée pour tout objet scruté dans lequel le curseur entre, même
' s'il n'y a pas de changement de couleur.
'
' sub on_mouse_over(flag%,obj%)
' if flag%=1
' traiter ici l'évènement "dans la form" pour objet obj%
' else
' traiter ici l'évènement "en-dehors de la form"
' end_if
' end_sub

message "mouse_over: ce module ne peut pas être exécuté directement."
terminate

' ===== routine évènement pour le timer (usage internne)
mouse_over_scruter:
timer_off mouse_over_ntimer%
GetMousePosition(handle(0))
mouse_over_x% = GetMousePositionX%
mouse_over_y% = GetMousePositionY%
if (mouse_over_x%>=0) and (mouse_over_y%>=0)
mouse_over_kold% = mouse_over_k%
mouse_over_kiold% = mouse_over_ki%
mouse_over_k% = 0
mouse_over_ki% = 0
for mouse_over_i%=1 to mouse_over_nobj%
if mouse_over_x%>=mouse_over_gauche%(mouse_over_i%)
if mouse_over_x%<(mouse_over_gauche%(mouse_over_i%)+mouse_over_largeur%(mouse_over_i%))
if mouse_over_y%>=mouse_over_haut%(mouse_over_i%)
if mouse_over_y%<(mouse_over_haut%(mouse_over_i%)+mouse_over_hauteur%(mouse_over_i%))
mouse_over_k% = mouse_over_objets%(mouse_over_i%)
mouse_over_ki% = mouse_over_i%
exit_for
end_if
end_if
end_if
end_if
next mouse_over_i%
if (mouse_over_k%<>mouse_over_kold%) or (mouse_over_type%=1)
if mouse_over_kold%>0
if mouse_over_colorer%(mouse_over_kiold%)=1 then color mouse_over_kold%,255,255,255
end_if
if mouse_over_k%>0
if mouse_over_colorer%(mouse_over_ki%)=1
color mouse_over_k%,mouse_over_RGB%(mouse_over_ki%,1),mouse_over_RGB%(mouse_over_ki%,2),mouse_over_RGB%(mouse_over_ki%,3)
end_if
end_if
mouse_over_n% = mouse_over_n% + 1
on_mouse_over(1,mouse_over_k%)
end_if
else
on_mouse_over(0,0)
end_if
timer_on mouse_over_ntimer%
return

' ===== création du système mouse_over
' maxobj% ==> nombre maxi d'objets à scruter
' ntimer% ==> un numéro d'objet disponible pour créer le timer interne
' typ% ==> type de surveillance 0=changement d'objet 1=continuel
sub create_mouse_over(maxobj%,ntimer%,typ%)
if label("mouse_over_scruter")=0 then label mouse_over_scruter
if variable("mouse_over_nobj%")=0
dim mouse_over_maxobj% : mouse_over_maxobj% = maxobj%
dim mouse_over_ntimer% : mouse_over_ntimer% = ntimer%
dim mouse_over_type% : mouse_over_type% = typ%
dim mouse_over_nobj%
dim mouse_over_k%
dim mouse_over_ki%
dim mouse_over_kold%
dim mouse_over_kiold%
dim mouse_over_i%
dim mouse_over_n%
dim mouse_over_x%
dim mouse_over_y%
dim mouse_over_objets%(mouse_over_maxobj%)
dim mouse_over_gauche%(mouse_over_maxobj%)
dim mouse_over_haut%(mouse_over_maxobj%)
dim mouse_over_largeur%(mouse_over_maxobj%)
dim mouse_over_hauteur%(mouse_over_maxobj%)
dim mouse_over_colorer%(mouse_over_maxobj%)
dim mouse_over_RGB%(mouse_over_maxobj%,3)
timer mouse_over_ntimer% : timer_interval mouse_over_ntimer%,100
on_timer mouse_over_ntimer%,mouse_over_scruter
end_if
end_sub

' ===== supprimer le système mouse_over
sub delete_mouse_over()
if variable("mouse_over_nobj%")=1
timer_off mouse_over_ntimer%
delete mouse_over_ntimer%
free mouse_over_maxobj%
free mouse_over_ntimer%
free mouse_over_type%
free mouse_over_nobj%
free mouse_over_k%
free mouse_over_ki%
free mouse_over_kold%
free mouse_over_kiold%
free mouse_over_i%
free mouse_over_n%
free mouse_over_x%
free mouse_over_y%
free mouse_over_objets%
free mouse_over_gauche%
free mouse_over_haut%
free mouse_over_large%
free mouse_over_hauteur%
free mouse_over_colorer%
free mouse_over_RGB%
end_if
end_sub

' ===== ajouter un objet à surveiller au système mouse_over
' obj% ==> numéro de l'objet
' parent% ==> numéro de l'objet parent de obj%
' R%, G%, B% ==> couleurs RGB pour changement de couleur de fond
' R%=G%=B%=0 ==> pas de changement de couleur
sub add_mouse_over(obj%,parent%,R%,G%,B%)
if mouse_over_nobj%<mouse_over_maxobj%
mouse_over_nobj% = mouse_over_nobj% + 1
mouse_over_objets%(mouse_over_nobj%) = obj%
if parent%=0
mouse_over_gauche%(mouse_over_nobj%) = left(obj%)
mouse_over_haut%(mouse_over_nobj%) = top(obj%)
else
mouse_over_gauche%(mouse_over_nobj%) = left(obj%)+left(parent%)
mouse_over_haut%(mouse_over_nobj%) = top(obj%)+top(parent%)
end_if
mouse_over_largeur%(mouse_over_nobj%) = width(obj%)
mouse_over_hauteur%(mouse_over_nobj%) = height(obj%)
if (R%=0) and (G%=0) and (B%=0)
mouse_over_colorer%(mouse_over_nobj%) = 0
else
mouse_over_colorer%(mouse_over_nobj%) = 1
mouse_over_RGB%(mouse_over_nobj%,1) = R%
mouse_over_RGB%(mouse_over_nobj%,2) = G%
mouse_over_RGB%(mouse_over_nobj%,3) = B%
end_if
end_if
end_sub

' ===== changer le type de surveillance
' typ% ==> type de surveillance 0=changement d'objet 1=continuel
sub mouse_over_type(typ%)
mouse_over_type% = typ%
end_sub

Dans le programme test_mouse_over.bas, j'ai ajouté une check box pour permettre de sélectionner une ligne simplement en glissant le curseur dessus ! Seul le programme de démo est modifie. KGF_SUB.bas et mouse_over_SUB.bas contenaient déjà tout ce qu'il faut.

» Tolérance dans le clic souris
» Survol des objets
» Position de la souris sur un objet à travers d'autres objets
» Clic souris répétitif automatique
» Simuler un clic gauche souris