Topmost m@n@g(r) - mettre une fenetre au premier plan permanent ou non

Soyez le premier à donner votre avis sur cette source.

Vue 8 449 fois - Téléchargée 476 fois

Description

Salut la compagnie

Hier, j'avai besoin d'un prog comme celui ci pour faire un pti boulot, mais le prob, c'est que Vbfrance était HS :-/ Alors je l'ai fait, et fignolé ce matin pour vous. Je sais qu'il éxiste peut etre déja, mais je ne l'ai pas vu quans j'ai cherché (c'est à dire tout de suite) mais c'est pas grave, c'est bien d'avoir plusieurs exemples ;)

Source / Exemple :


Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const Flags = SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE

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 wFlags As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Dim Ssave As String
Dim Handles() As Long

Private Sub Command1_Click()

    Dim hwnd As Long
    hwnd = GetForegroundWindow
    Dim ipass As Long
    ipass = 0
    
    On Error GoTo ErreurTableau 'évite l'erreur si le tableau est totalement vide(non formaté)
        Do While ipass <> UBound(Handles)
            If hwnd = Handles(ipass) Then GoTo Suite
        ipass = ipass + 1
        Loop
    GoTo ApresBoucle
    
ErreurTableau:
Dim ErreurTableau As Boolean
ErreurTableau = True

ApresBoucle:
    SetTopMostWindow hwnd, True
    If ErreurTableau = True Then
    ReDim Preserve Handles(1)
    Else: ReDim Preserve Handles(UBound(Handles) + 1)
    End If
    Handles(UBound(Handles)) = hwnd
    Exit Sub
    
Suite:
    SetTopMostWindow hwnd, False
    Delete Handles, ipass

End Sub

Private Sub Form_Load()
    
    Me.Caption = App.ProductName & " v" & App.Major & "." & App.Minor & "." & App.Revision
    SetTopMostWindow Me.hwnd, True
    For Each object In Me
    On Error Resume Next
    If object.Name <> "Label2" Then object.Font = "Tahoma"
    Next object

End Sub

Private Sub Label2_Click()
frmAbout.Show
End Sub

Private Sub Timer1_Timer()

Dim hwnd As Long
hwnd = GetForegroundWindow
Text1.Text = hwnd
Dim ipass As Long
ipass = 0
On Error GoTo Erreur 'évite l'erreur si le tableau est totalement vide(non formaté)
    Do While ipass <> UBound(Handles)
        If hwnd = Handles(ipass) Then GoTo Checking
    ipass = ipass + 1
    Loop
    Check1.Value = 0
    GoTo Suite
    
Checking:
Check1.Value = 1
GoTo Suite:

Erreur:
Check1.Value = 0

Suite:
Ret = GetPressedKey
If Ret <> sOld Then
    sOld = Ret
    Ssave = Ssave + sOld
End If

If Right$(Ssave, 2) = "XY" Then
Call Command1_Click
Ssave = ""
End If

End Sub

Function GetPressedKey() As String

For Cnt = 32 To 128
    If GetAsyncKeyState(Cnt) <> 0 Then
    GetPressedKey = Chr$(Cnt)
    Exit For
    End If
Next Cnt

End Function

Private Sub Delete(ByRef tableau As Variant, element As Variant) 'http://www.vbfrance.com/code.aspx?ID=2104
Dim i As Integer
For i = element To UBound(tableau) - 1
tableau(i) = tableau(i + 1)
Next
ReDim Preserve tableau(UBound(tableau) - 1)
End Sub
Private Function SetTopMostWindow(ByRef handle As Long, Topmost As Boolean) As Long

    If Topmost = True Then
        SetTopMostWindow = SetWindowPos(handle, HWND_TOPMOST, 0, 0, 0, 0, Flags)
    Else
        SetTopMostWindow = SetWindowPos(handle, HWND_NOTOPMOST, 0, 0, 0, 0, Flags)
    End If

End Function

Conclusion :


reponse = msgbox ("Do you want download the ZIP ?")
if reponse = vbyes then Call ZipDownload
else msgbox "Fuck U :p"

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_azerty25
Messages postés
1115
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
6 mai 2007
-
Ne vous gênez pas pour mettre un commentaire surtout (sauf si c'est pour dire des conneries ;))
J'ai trouvé un bug, qui ne vient pas de mon code, mais avec Dreamveawer 2, cet utilitaire ne fonctionne que si aucune fenetre "volante" dans Dreamveawer n'est ouverte, exemple, la fenetre de propriétées, sinon, le topmost ne fonctionne pas sur la fenetre principale de DW.
Renfield
Messages postés
17283
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
56 -
Salut azerty25.

J'ai regardé dans le code (et la fenetre d'aide m'a confirmé la chose, j'aurais du la regarder en premier, peut-etre ;) )
Il faut presser séquentiellement X puis Y pour activer/désactiver la fenetre...
quelques peu inhabituel, et ca pourrait avoir des effets nefastes...

Tu pourrais utiliser un raccourcis du genre Ctrl + L ....
si tu veux, j'ai une source qui permet d'utiliser des raccourcis clavier facilement, ca te permetterais de l'intercepter même si ton appli n'a pas le focus...


ah, oui, plutôt que d'afficher le handle (ce qui ne dit pas grand chose a certains !!) tu pourrais afficher le caption de la fenetre (utilises pour cela l'API GetWindowText)

A part ca, je dois dire que c'est clair et commenté, un bel effort avec les API... ;)
cs_azerty25
Messages postés
1115
Date d'inscription
jeudi 19 décembre 2002
Statut
Membre
Dernière intervention
6 mai 2007
-
Salut
Merci pour ton attention
En effet, c'est inabituel, j'aura du prendre autre chose, mais il me fallai une idée et vite, alors j'ai pris un peu au hasard. Et j'ai déja subi les effets dont tu parle ;) Je vais regarder ton code. J'ai fait cette combine de touches car au début, je devai presser un bouton, et j'ai vite vu que sa n'allait pas ... (quel étourdit :-/)
Pour ce qui est du handle, j'ai préféré sa, car une fenetre peu avoir le meme caption mais pas le meme handle ;)
Pour ce qui est du commentage, je suis pas dac avec toi, j'ai rien commenté :p (ce qui est dans la boite de dialogue about c'est fait par VB ;))
hvb
Messages postés
961
Date d'inscription
vendredi 25 octobre 2002
Statut
Membre
Dernière intervention
27 janvier 2009
1 -
"Explication finale
reponse = msgbox ("Do you want download the ZIP ?")
if reponse = vbyes then Call ZipDownload
else msgbox "Fuck U :p" "

...!!!!!

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.