Windowsmove(r) - déplacer des fenêtres (handles) qui ne sont pas prévues pour (ex:borderstyle = none)

Télécharger le projet
Commenter

Description

Hello la compagnie.

J'avais besoin de ce code, tout de suite, la, maintenant, pour déplacer la fenêtre d'un prog dont j'ai pas accès à la source, que l'on pourrait dire "borderstyle = none", car elle ne possède pas la barre de déplacement, et bouger la souris dessus en maintenant le clic n'étant pas prévu pour la déplacer.

Fonctionnement : vous mettez le curseur sur une fenêtre, vous appuyez sur CONTROL+F, et vous la bougez ensuite ;)

Attention : vérifiez bien de vous mettre sur une fenêtre et non pas sur un controle, car vous risqueriez d'avoir des suprises ... Par exemple, en voulant aller trop vite, j'ai "sélectionné" la barre d'outils de Visual Basic et bougé la souris après ... Résultat ? On la voyait plus :p

Au menu : trouver la fenêtre qui est sous la souris (handle pour être plus précis), déplacer des fenêtres (handles encore une fois), obtenir le texte d'un handle, comment faire une touche de raccourcis, récupèrer la position du curseur, récupèrer les dimensions et position d'un handle etc

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 WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long

Dim Locked As Boolean
Dim Handle As Long
Dim Rec As RECT
Dim CurPosWindow As POINTAPI
Dim PrecedentLocked As Boolean

Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private Type Msg
    hWnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean

Private Sub Form_Load()
SetTopMostWindow Me, True 'Active l'affichage au premier plan
Locked = False
Me.Caption = App.ProductName

    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim ret As Long
    bCancel = False
    'register the Ctrl-F hotkey
    ret = RegisterHotKey(Me.hWnd, &HBFFF&, MOD_CONTROL, vbKeyF)
    Show
    'process the Hotkey messages
    ProcessMessages
    
On Error Resume Next 'pour éviter l'erreur quand un contrôle n'ayant pas la propriété FONT. On place On Error Resume Next avant le code que l'on juge comme potentiellement cause d'erreur, pour ne pas affecter les lignes ne risquant rien (les lignes ci-dessus, dans certains cas, on à des "fausses erreurs")
Dim Ctl As Object
For Each Ctl In Me
Ctl.Font = "Tahoma"
Next Ctl

End Sub

Private Function SetTopMostWindow(Window As Form, Topmost As Boolean) As Long

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

End Function

Private Sub Label1_Click()
If Label1.Caption = "Vérouiller (CTRL+F)" Then
Label1.Caption = "Déverouiller (CTRL+F)"
Locked = True
ElseIf Label1.Caption = "Déverouiller (CTRL+F)" Then
Label1.Caption = "Vérouiller (CTRL+F)"
Locked = False
End If
End Sub

Private Sub Timer1_Timer()
Dim Pos As POINTAPI
GetCursorPos Pos

If Locked = False Then
Handle = WindowFromPoint(Pos.x, Pos.y)
lblHw.Caption = "Handle : " & Handle
Dim MyStr As String
MyStr = String(100, Chr$(0))
GetWindowText Handle, MyStr, 100
lblTxt.Caption = "Titre :  " & MyStr
GetWindowRect Handle, Rec
lblX.Caption = "X : " & Rec.Left
lblY.Caption = "Y : " & Rec.Top
lblW.Caption = "Largeur : " & Rec.Right - Rec.Left
lblH.Caption = "Hauteur : " & Rec.Bottom - Rec.Top
End If

If PrecedentLocked <> Locked Then
CurPosWindow.x = Pos.x - Rec.Left
CurPosWindow.y = Pos.y - Rec.Top
PrecedentLocked = Locked
End If

If Locked = True Then
Dim x As Long
Dim y As Long
Dim cX As Long
Dim cY As Long
x = Pos.x - CurPosWindow.x
y = Pos.y - CurPosWindow.y
cX = Rec.Right - Rec.Left
cY = Rec.Bottom - Rec.Top
SetWindowPos Handle, HWND_TOP, x, y, cX, cY, SWP_SHOWWINDOW
End If
PrecedentLocked = Locked
End Sub

Private Sub ProcessMessages()
    Dim Message As Msg
    'loop until bCancel is set to True
    Do While Not bCancel
        'wait for a message
        WaitMessage
        'check if it's a HOTKEY-message
        If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
            'MsgBox ""
            Call Label1_Click
        End If
        'let the operating system process other events
        DoEvents
    Loop
End Sub

Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
    'unregister hotkey
    Call UnregisterHotKey(Me.hWnd, &HBFFF&)
    End
End Sub

Conclusion :


Des morceaux de codes sont tirés de l'API Guide
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)