WINDOWSMOVE(R) - DÉPLACER DES FENÊTRES (HANDLES) QUI NE SONT PAS PRÉVUES POUR (EX:BORDERSTYLE = NONE)

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