1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Donner à une form le premier plan et le focus, d'être séléctioné ! ! !

Donner à une form le premier plan et le focus, d'être séléctioné ! ! !

Soyez le premier à donner votre avis sur cette source.

Snippet vu 3 781 fois - Téléchargée 19 fois

Commenter

Contenu du snippet

Donner à une Form la possibilité d'être en premier plan et d'avoir LE FOCUS, d'être séléctioné ! ! !

voir un problème que j'avais là :
http://www.vbfrance.com/forum/sujet-COMMENT-FAIRE-GLISSER-FORM-VENANT-BORDDE-ECRAN_1605687.aspx

Source / Exemple : 


'--------------------------  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

Conclusion :


pour le FOCUS c'est plus une astuce d'utiliser le clic souris, mais j'ai rien trouver d'autre, si quelqu'un à mieux ne pas hésiter, cela serais plus propre !

A voir également

Ajouter un commentaire Commentaires
Signaler
Messages postés
43
Date d'inscription
jeudi 9 décembre 2004
Statut
Membre
Dernière intervention
11 octobre 2013
passer la form: la_form au 1er plan, on peut aussi faire:
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
Signaler
Messages postés
34
Date d'inscription
lundi 25 juin 2007
Statut
Membre
Dernière intervention
22 février 2021
ça serait bien si tu précisais les références nécessaires dans le projet visual basic
Signaler
Messages postés
130
Date d'inscription
dimanche 16 décembre 2007
Statut
Membre
Dernière intervention
28 janvier 2013
Sur un de mes logiciels, j'ai du remplacer deux lignes pour que cela marche bien :

=>>>
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
Signaler
Messages postés
130
Date d'inscription
dimanche 16 décembre 2007
Statut
Membre
Dernière intervention
28 janvier 2013
oui j'ai dejà essayer SetTop(cela suffit pas) comme on le voie dans ma procédure, je fait :

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 ! ;)
Signaler
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
 75
Gros danger si l'emplacement calculé du curseur tombe sur un bouton ou une case à cocher ...
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)
Afficher les 8 commentaires
S'inscrire maintenant

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.

Du même auteur (rebixav)