Блог

В настоящее время я создаю окно WPF, которое сохраняет его соотношение сторон при изменении размера.

Моей первой идеей было обработать сообщение WM_SIZE и установить там размер, но это вызвало раздражающее мерцание. Итак, я попытался изменить параметр lParam для WM_Size, который вызвал исключения AccessViolationExceptions. То же самое произошло с манипулированием lParam в WM_SIZING.

AspectWindow.vb

 Imports System.Runtime.InteropServices
Imports System.Windows.Interop


Public Class AspectWindow
    Inherits Window

    Private AspectRatio As Double
    Private ResizeDirection As Direction

    Enum Direction
        Horizontal
        Vertical
    End Enum

    Enum WM
        WM_SIZE = amp;H5
        WM_SIZING = amp;H214
        WM_EXITSIZEMOVE = amp;H232
        WM_NCCALCSIZE = amp;H83
    End Enum

    Enum WMSZ
        WMSZ_BOTTOM = amp;H6
        WMSZ_BOTTOMLEFT = amp;H7
        WMSZ_BOTTOMRIGHT = amp;H8
        WMSZ_LEFT = amp;H1
        WMSZ_RIGHT = amp;H2
        WMSZ_TOP = amp;H3
        WMSZ_TOPLEFT = amp;H4
        WMSZ_TOPRIGHT = amp;H5
    End Enum

    Enum WVR
        WVR_VALIDRECTS = amp;H400
    End Enum

    Enum IntPtrBool
        [True] = 1
        [False] = 0
    End Enum

    <StructLayout(LayoutKind.Sequential)>
    Friend Structure RECT
        Public left As Long
        Public top As Long
        Public right As Long
        Public bottom As Long
    End Structure

    Protected Overrides Sub OnSourceInitialized(e As EventArgs)
        AspectRatio = Me.ActualWidth / Me.ActualHeight
        MyBase.OnSourceInitialized(e)
        Dim source As HwndSource = TryCast(HwndSource.FromVisual(Me), HwndSource)
        If source IsNot Nothing Then
            source.AddHook(New HwndSourceHook(AddressOf WinProc))
        End If
    End Sub

    Private Function WinProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
        Select Case msg
            Case WM.WM_SIZING
                Select Case wParam
                    Case WMSZ.WMSZ_BOTTOM, WMSZ.WMSZ_TOP
                        ResizeDirection = Direction.Vertical
                        Exit Select
                    Case WMSZ.WMSZ_LEFT, WMSZ.WMSZ_RIGHT
                        ResizeDirection = Direction.Horizontal
                        Exit Select

                End Select

                If Not lParam = Nothing Then

                    Dim Rect As RECT = Marshal.PtrToStructure(Of RECT)(lParam)

                    If ResizeDirection = Direction.Horizontal Then
                        Rect.bottom = Rect.top
                    Else
                        Rect.right = Rect.top
                    End If

                    'Manipulating Resize Rectangle
                    Rect.top = 1
                    Rect.bottom = 2
                    Rect.left = 3
                    Rect.right = 4 

                    Marshal.StructureToPtr(Of RECT)(Rect, lParam, False)

                End If

                Return IntPtrBool.True
        End Select

        Return IntPtr.Zero
    End Function


End Class
 

Решаемая проблема с обработкой WM_WINDOWPOSCHANGING:

 Imports System.Runtime.InteropServices
Imports System.Windows.Interop


Public Class AspectWindow
    Inherits Window

    Private AspectRatio As Double
    Private ResizeDirection As WMSZ

    Enum WM
        WM_SIZING = amp;H214
        WM_WINDOWPOSCHANGING = amp;H46
    End Enum

    Enum WMSZ
        WMSZ_BOTTOM = amp;H6
        WMSZ_BOTTOMLEFT = amp;H7
        WMSZ_BOTTOMRIGHT = amp;H8
        WMSZ_LEFT = amp;H1
        WMSZ_RIGHT = amp;H2
        WMSZ_TOP = amp;H3
        WMSZ_TOPLEFT = amp;H4
        WMSZ_TOPRIGHT = amp;H5
    End Enum

    Enum IntPtrBool
        [True] = 1
        [False] = 0
    End Enum

    <StructLayout(LayoutKind.Sequential)>
    Friend Structure WINDOWPOS
        Public hwnd As IntPtr
        Public hwndInsertAfter As IntPtr
        Public x As Integer
        Public y As Integer
        Public cx As Integer
        Public cy As Integer
        Public flags As Integer
    End Structure

    Protected Overrides Sub OnSourceInitialized(e As EventArgs)
        AspectRatio = Me.ActualWidth / Me.ActualHeight
        MyBase.OnSourceInitialized(e)
        Dim source As HwndSource = TryCast(HwndSource.FromVisual(Me), HwndSource)
        If source IsNot Nothing Then
            source.AddHook(New HwndSourceHook(AddressOf WinProc))
        End If
    End Sub

    Private Function WinProc(hwnd As IntPtr, msg As Integer, wParam As IntPtr, lParam As IntPtr, ByRef handled As Boolean) As IntPtr
        Select Case msg
            Case WM.WM_SIZING
                ResizeDirection = wParam

                Return IntPtrBool.True

            Case WM.WM_WINDOWPOSCHANGING
                Dim Pos = Marshal.PtrToStructure(Of WINDOWPOS)(lParam)

                Dim Last = Pos

                If Not ResizeDirection = WMSZ.WMSZ_TOP AndAlso Not ResizeDirection = WMSZ.WMSZ_BOTTOM Then
                    Pos.cy = Pos.cx / AspectRatio
                End If
                If Not ResizeDirection = WMSZ.WMSZ_RIGHT AndAlso Not ResizeDirection = WMSZ.WMSZ_LEFT Then
                    Pos.cx = Pos.cy * AspectRatio
                End If
                If ResizeDirection = WMSZ.WMSZ_TOPRIGHT OrElse ResizeDirection = WMSZ.WMSZ_TOPLEFT Then
                    Pos.y  = Last.cy - Pos.cy
                End If


                Marshal.StructureToPtr(Of WINDOWPOS)(Pos, lParam, True)


        End Select
    End Function

End Class