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

Télécharger le projet
Commenter

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"
Télécharger le projet

Codes Sources

A voir également

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 (cs_azerty25)