Soyez le premier à donner votre avis sur cette source.
Snippet vu 4 184 fois - Téléchargée 20 fois
'-------------------------- la souris -------------------------- Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long Public Declare Sub mouse_event Lib "user32" (ByVal dwflags As Long, _ ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _ ByVal dwExtraInfo As Long) ' ---Définition des constantes--- Public Const MOUSEEVENTF_ABSOLUTE = &H8000 Public Const MOUSEEVENTF_LEFTDOWN = &H2 Public Const MOUSEEVENTF_LEFTUP = &H4 Public Const MOUSEEVENTF_MIDDLEDO = &H20 Public Const MOUSEEVENTF_MIDDLEUP = &H40 Public Const MOUSEEVENTF_MOVE = &H1 Public Const MOUSEEVENTF_RIGHTDOWN = &H8 Public Const MOUSEEVENTF_RIGHTUP = &H10 Public Sub Premier_plan(la_form As Object, Optional ByVal active As Boolean = True, Optional ByVal Clic_mouse_pour_avoir_le_focus As Boolean = False) 'force l'affichage au dessus des autres fenetres, bien sûr 'Clic_mouse_pour_avoir_le_focus=true permet de forcer le FOCUS ! ! ! ! la_form.Show If active = True Then SetWindowPos la_form.hWnd, -1, 0, 0, 0, 0, &H2 Or &H1 Else SetWindowPos la_form.hWnd, -2, 0, 0, 0, 0, &H2 Or &H1 End If If Clic_mouse_pour_avoir_le_focus = True Then X% = (la_form.Left + la_form.Width / 2) / Screen.TwipsPerPixelX Y% = ((la_form.Top + la_form.Height) / Screen.TwipsPerPixelX) - 4 SetCursorPos X%, Y% Call mouse_event(MOUSEEVENTF_LEFTDOWN, X%, Y%, 0, 0) 'on enfonce le bouton Call mouse_event(MOUSEEVENTF_LEFTUP, X%, Y%, 0, 0) 'on relache le bouton End If End Sub
11 oct. 2013 à 15:47
la_form.topmost = true (par exemple dans l'évènement onload
quand l'action à faire est terminée, repasser à false pour que ça fonctionne le prochain coup
21 mars 2013 à 17:00
16 déc. 2012 à 12:32
=>>>
If la_form.Left + la_form.Width > 0 And (la_form.Left + la_form.Width) \ Screen.TwipsPerPixelX < Lx% Then x% = (la_form.Left + la_form.Width) \ Screen.TwipsPerPixelX: GoTo suite_y
par
If la_form.Left + la_form.Width > 0 And (la_form.Left + la_form.Width) \ Screen.TwipsPerPixelX < Lx% Then x% = (la_form.Left + la_form.Width) \ Screen.TwipsPerPixelX - 1: GoTo suite_y
et
=>>>
If la_form.Top + la_form.Height > 0 And (la_form.Top + la_form.Height) \ Screen.TwipsPerPixelY < Lx% Then Y% = (la_form.Top + la_form.Height) \ Screen.TwipsPerPixelY
par
If la_form.Top + la_form.Height > 0 And (la_form.Top + la_form.Height) \ Screen.TwipsPerPixelY < Lx% Then Y% = (la_form.Top + la_form.Height) \ Screen.TwipsPerPixelY - 1
26 oct. 2012 à 09:17
1> un .show
2> un setwindows(SetTop) pour avoir la fenêtre en premier plan !
3> un clic de souris si on veut que cela force le focus, surtout la prise de focus !
...
là cela fait fait deux mois que je l'utilise sur un utilitaire que j'utilise 100 fois par jours, donc cela marche très bien !
Évidement comme on le voit dans ma procédure c'est un clic de souris à la fin qui donne le vrai focus(j'ai essayer tout type d'api donnant le focus), donc sur une fenetre incliné d'une autre façons peut poser problème, d'ailleur j'ai du faire une nouvelle mise à jour à ma procédure pour un autre utilitaire que j'utilise maintenant :
Public Sub Premier_plan(la_form As Form, Optional ByVal active As Boolean True, Optional ByVal Clic_mouse_pour_avoir_le_focus As Boolean False)
'force l'affichage au dessus des autres fenetres, bien sûr
'Clic_mouse_pour_avoir_le_focus=true permet de forcer le FOCUS définitevement ! ! ! !
' ps : cette dernière options marche à 90% sur la plupart des fenetres !
'il est fortement recommandé pour l'option clic_mouse que le borderstyle de la fenetre soit sur 1 !
la_form.Show
If active = True Then
SetWindowPos la_form.hWnd, -1, 0, 0, 0, 0, &H2 Or &H1
Else
SetWindowPos la_form.hWnd, -2, 0, 0, 0, 0, &H2 Or &H1
End If
If Clic_mouse_pour_avoir_le_focus = True Then
Souris X_av%, Y_av% 'la procédure perméttant de récupérer la position x et y de la souris lx% Screen.Width \ Screen.TwipsPerPixelX: ly% Screen.Height \ Screen.TwipsPerPixelY
form_lx% = (la_form.Left + la_form.Width / 2) / Screen.TwipsPerPixelX
If form_lx% > 0 And form_lx% < lx% Then x% = form_lx%: GoTo suite_y
If la_form.Left > 0 And la_form.Left \ Screen.TwipsPerPixelX < lx% Then x% = la_form.Left \ Screen.TwipsPerPixelX: GoTo suite_y
If la_form.Left + la_form.Width > 0 And (la_form.Left + la_form.Width) \ Screen.TwipsPerPixelX < lx% Then x% = (la_form.Left + la_form.Width) \ Screen.TwipsPerPixelX: GoTo suite_y
suite_y:
form_ly% = (la_form.Top + la_form.Height / 2) / Screen.TwipsPerPixelY
If form_ly% > 0 And form_ly% < lx% Then y% = form_ly%: GoTo suite
If la_form.Top > 0 And la_form.Top \ Screen.TwipsPerPixelY < ly% Then y% = la_form.Top \ Screen.TwipsPerPixelY: GoTo suite
If la_form.Top + la_form.Height > 0 And (la_form.Top + la_form.Height) \ Screen.TwipsPerPixelY < lx% Then y% = (la_form.Top + la_form.Height) \ Screen.TwipsPerPixelY
suite:
SetCursorPos x%, y%
'la_form.BorderStyle = 1 'zut cela ne fonctionne pas, le borderstyyle est en lecture seul !
Call mouse_event(MOUSEEVENTF_LEFTDOWN, x%, y%, 0, 0) 'on enfonce le bouton
Call mouse_event(MOUSEEVENTF_LEFTUP, x%, y%, 0, 0) 'on relache le bouton
SetCursorPos X_av%, Y_av% 'remet la souris à sa place d'origine, ni vue, ni connue ! :)
End If
End Sub
cadeaux indispensable pour ma procédure :
Public Function Souris(x%, y%)
Dim position_souris As POINTAPI
GetCursorPos position_souris x% position_souris.x: y% position_souris.y
End Function
et si vous avez toujours pas il faut cela aussi :
'-------------------------- la souris --------------------------
Public Type POINTAPI
x As Long
y As Long
End Type
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare Sub mouse_event Lib "user32" (ByVal dwflags As Long, _
ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, _
ByVal dwExtraInfo As Long)
' ---Définition des constantes---
Public Const MOUSEEVENTF_ABSOLUTE = &H8000
Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_MIDDLEDO = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_MOVE = &H1
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
' Constantes de SetWindowPos :
Private Const HWND_TOPMOST As Long = -1
Private Const HWND_NOTOPMOST As Long = -2
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOACTIVATE As Long = &H10
Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'---------- la déclaration suivante permet de rendre visible ou pas le cursseur (true ou false)
Public Declare Function ShowCursor Lib "user32" (ByVal bShow As Long) As Long
croyez moi cela fonctionne très bien ! ;)
1 sept. 2012 à 16:15
As-tu essayé de faire un SetTop ?
(exemple VB6)
' Constantes de SetWindowPos :
Private Const HWND_TOPMOST As Long = -1
Private Const HWND_NOTOPMOST As Long = -2
Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOACTIVATE As Long = &H10
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal uFlags As Long) As Long
Public Sub SetTop(maForm As VB.Form, _
ByVal Topmost As Boolean)
Dim hWndInsertAfter As Long
If Topmost Then
hWndInsertAfter = HWND_TOPMOST
Else
hWndInsertAfter = HWND_NOTOPMOST
End If
SetWindowPos maForm.hWnd, hWndInsertAfter, 0, 0, 0, 0, _
SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE
End Sub
et, pour faire passer ta forme en premier plan permanent + suppression de la permanence :
Call (maForme, True)
DoEvents
' et derrière aussitôt
Call (maForme, False)
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.