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