Classe Window

'
' clsWindow : classe Window
'
' Permet de manipuler des fenetres
'
' Auteur: ChF
'
' Property
'    Hwnd : Handle de fenetre
'    Enabled : Enabled or disabled the window
'    Parent : Return a clsWindow to the parent window
'    X : Return or set  X position
'    Y : Return or set  Y Position
'    Height : Return or set  height
'    Width : Return or set  width
'    Caption : Return or set the window title
'    Visible : Set the Window visible or not visible. It can be read

'
'
' Méthodes
'    Create : Create this Window Object
'    Destroy : Destroy this object
'    Center : Center the window in the parent Window
'    Maximize : Maximize the Window
'    Minimize : Minimize the Window
'    Restore : Restore the Window to the last size
'    SetPos : Set the TopLevel position of the window
'    Find : Find a window
'    Destroy : Destroy this window


Option Compare Database
Option Explicit

Private clsHwnd As Long
Private clsEnabled As Boolean
Private clsVisible As Boolean
Private clsRect As udtRECT
Private clsCaption As String

Private Dummy As Long

'************************************************
'API de gestion de fenetre
'************************************************
Private Type udtRECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const SW_ERASE = &H4
Private Const SW_HIDE = 0
Private Const SW_INVALIDATE = &H2
Private Const SW_MAX = 10
Private Const SW_MAXIMIZE = 3
Private Const SW_MINIMIZE = 6
Private Const SW_NORMAL = 1
Private Const SW_OTHERUNZOOM = 4
Private Const SW_OTHERZOOM = 2
Private Const SW_PARENTCLOSING = 1
Private Const SW_PARENTOPENING = 3
Private Const SW_RESTORE = 9
Private Const SW_SCROLLCHILDREN = &H1
Private Const SW_SHOW = 5
Private Const SW_SHOWDEFAULT = 10
Private Const SW_SHOWMAXIMIZED = 3
Private Const SW_SHOWMINIMIZED = 2
Private Const SW_SHOWNA = 8
Private Const SW_SHOWMINNOACTIVE = 7
Private Const SW_SHOWNOACTIVATE = 4
Private Const SW_SHOWNORMAL = 1

Private Const SWP_NOSIZE As Long = &H1
Private Const SWP_NOMOVE As Long = &H2
Private Const SWP_NOZORDER As Long = &H4
Private Const SWP_NOREDRAW As Long = &H8
Private Const SWP_NOACTIVATE As Long = &H10
Private Const SWP_FRAMECHANGED As Long = &H20
Private Const SWP_DRAWFRAME As Long = SWP_FRAMECHANGED
Private Const SWP_SHOWWINDOW As Long = &H40
Private Const SWP_HIDEWINDOW As Long = &H80

Private Declare Function API_EnableWindow Lib "user32" Alias "EnableWindow" (ByVal hwnd As Long, ByVal fenable As Long) As Long
Private Declare Function API_SetFocus Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function API_GetParent Lib "user32" Alias "GetParent" (ByVal hwnd As Long) As Long
Private Declare Function API_GetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hwnd As Long, lpRect As udtRECT) As Long
Private Declare Function API_MoveWindow Lib "user32" Alias "MoveWindow" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function API_GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function API_GetClientRect Lib "user32" Alias "GetClientRect" (ByVal hwnd As Long, lpRect As udtRECT) As Long
Private Declare Function API_ShowWindow Lib "user32" Alias "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function API_SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function API_SetWindowPos Lib "user32" Alias "SetWindowPos" (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 API_FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function API_Destroy Lib "user32" Alias "DestroyWindow" (ByVal hwnd As Long) As Long
Private Declare Function API_GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function API_GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
 
 
Public Property Let hwnd(lngValue As Long)
    clsHwnd = lngValue
    API_GetWindowRect clsHwnd, clsRect
End Property
Public Property Get hwnd() As Long
    hwnd = clsHwnd
End Property

Public Property Let Enabled(blnValue As Boolean)
    clsEnabled = blnValue
    Dummy = API_EnableWindow(clsHwnd, clsEnabled)
End Property
Public Property Get Enabled() As Boolean
    Enabled = clsEnabled
End Property
Public Property Get Parent() As clsWindow
Dim ow As New clsWindow
    ow.Create API_GetParent(clsHwnd)
    Set Parent = ow
End Property
Public Property Let x(lngValue As Long)
Dim w As Long
    With clsRect
        w = Width
        .Left = lngValue
        .Right = .Left + w
        API_MoveWindow clsHwnd, .Left, .Top, .Right - .Left, .Bottom - .Top, True
    End With
End Property
Public Property Get x() As Long
    x = clsRect.Left
End Property
Public Property Let y(lngValue As Long)
Dim w As Long
    With clsRect
        w = Height
        .Top = lngValue
        .Bottom = .Top + w
        API_MoveWindow clsHwnd, .Left, .Top, .Right - .Left, .Bottom - .Top, True
    End With
End Property
Public Property Get y() As Long
    y = clsRect.Top
End Property
Public Property Let Width(lngValue As Long)
    With clsRect
        .Right = .Left + lngValue
        API_MoveWindow clsHwnd, .Left, .Top, .Right - .Left, .Bottom - .Top, True
    End With
End Property
Public Property Get Width() As Long
    Width = clsRect.Right - clsRect.Left
End Property
Public Property Let Height(lngValue As Long)
    With clsRect
        .Bottom = .Top + lngValue
        API_MoveWindow clsHwnd, .Left, .Top, .Right - .Left, .Bottom - .Top, True
    End With
End Property
Public Property Get Height() As Long
    Height = clsRect.Bottom - clsRect.Top
End Property
Public Property Let Visible(blnValue As Boolean)
    If blnValue Then
        API_ShowWindow clsHwnd, SW_SHOW
    Else
        API_ShowWindow clsHwnd, SW_HIDE
    End If
    clsVisible = blnValue
End Property
Public Property Get Visible() As Boolean
    Visible = clsVisible
End Property
Public Property Let Caption(strValue As String)
    clsCaption = strValue
    API_SetWindowText clsHwnd, strValue
End Property
Public Property Get Caption() As String
Dim s As String * 256
Dim l As Integer
    
    If Len(clsCaption) = 0 Then
        l = API_GetWindowTextLength(clsHwnd) + 1
        API_GetWindowText clsHwnd, s, l
    End If
    clsCaption = Left(s, l - 1)
    Caption = clsCaption
End Property
Public Function Maximize()
    API_ShowWindow clsHwnd, SW_MAXIMIZE
End Function
Public Function Minimize()
    API_ShowWindow clsHwnd, SW_MINIMIZE
End Function
Public Function Restore()
    API_ShowWindow clsHwnd, SW_RESTORE
End Function
Public Function Center()
Dim r As udtRECT
Dim rDesk As udtRECT
Dim hwnd As Long
Dim hwndDesk As Long
Dim szClass As String
Dim x As Long
Dim y As Long
Dim xDesk As Long
Dim yDesk As Long

Const BufferLength = 255
Dim szBuffer As String * BufferLength


    Dummy = API_GetClassName(clsHwnd, szBuffer, BufferLength)
    szClass = Left$(szBuffer, BufferLength)
    
    hwndDesk = API_GetParent(clsHwnd)
    Call API_GetWindowRect(clsHwnd, r)
    
    If Left$(szClass, 10) = "OFormPopup" Then
        Call API_GetWindowRect(hwndDesk, rDesk)
    Else
        Call API_GetClientRect(hwndDesk, rDesk)
    End If

    x = r.Right - r.Left
    y = r.Bottom - r.Top
    
    xDesk = rDesk.Right - rDesk.Left
    yDesk = rDesk.Bottom - rDesk.Top
    
    Call API_MoveWindow(clsHwnd, (xDesk - x) / 2, (yDesk - y) / 2, x, y, True)

    '
    ' Retrouve les coordonnées de la fenetre
    '
    API_GetWindowRect clsHwnd, clsRect

End Function
Public Function Show(lngFlags As Long)
    API_ShowWindow clsHwnd, lngFlags
End Function
Public Function SetPos(lngFlags As Long)
    API_SetWindowPos clsHwnd, lngFlags, 1, 1, 1, 1, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW
End Function
Public Function Find(clsName As String, strName As String) As Long
    Find = API_FindWindow(clsName, strName)
End Function
Public Function Create(Optional lngHwnd As Long)
    hwnd = lngHwnd
    If Not IsMissing(lngHwnd) Then
        API_GetWindowRect clsHwnd, clsRect
    End If
End Function
Public Function Destroy()
    API_Destroy clsHwnd

End Function

Private Sub Class_Initialize()
    clsCaption = ""
End Sub