|
|
Title | Make a form with a fixed aspect ratio in VB .NET |
Description | This example shows how to make a form with a fixed aspect ratio in VB .NET. It overrides the form's WndProc subroutine and looks for WM_SIZING messages. |
Keywords | application icon, icon, VB .NET |
Categories | VB.NET, Controls |
|
|
The program overrides the form's WndProc subroutine to look for Windows messages. When it sees a WM_SIZING message, it uses Marshal.PtrToStructure to convert the LParam parameter into a Rect structure containing information about the resizing.
The first time the code sees this message, it saves the form's aspect ratio (height/width). In subsequent runs, it resets the form's width or height so it has the same aspect ratio. It then adjusts the Rect structure to use the new width and height while not moving the form's left or top edges.
The program then uses Marshal.StructureToPtr to copy the Rect structure back into the LParam parameter.
Finally, WndProc calls the parent's class's version of WndProc to process the message whether it is WM_SIZING or something else.
|
|
Imports System.Runtime.InteropServices
...
Public Structure Rect
Public left As Integer
Public top As Integer
Public right As Integer
Public bottom As Integer
End Structure
Protected Overrides Sub WndProc(ByRef m As _
System.Windows.Forms.Message)
Static first_time As Boolean = True
Static aspect_ratio As Double
Const WM_SIZING As Long = &H214
Const WMSZ_LEFT As Integer = 1
Const WMSZ_RIGHT As Integer = 2
Const WMSZ_TOP As Integer = 3
Const WMSZ_TOPLEFT As Integer = 4
Const WMSZ_TOPRIGHT As Integer = 5
Const WMSZ_BOTTOM As Integer = 6
Const WMSZ_BOTTOMLEFT As Integer = 7
Const WMSZ_BOTTOMRIGHT As Integer = 8
If m.Msg = WM_SIZING And m.HWnd.Equals(Me.Handle) Then
' Turn the message's lParam into a Rect.
Dim r As Rect
r = DirectCast( _
Marshal.PtrToStructure(m.LParam, _
GetType(Rect)), _
Rect)
' The first time, save the form's aspect ratio.
If first_time Then
first_time = False
aspect_ratio = (r.bottom - r.top) / (r.right - _
r.left)
End If
' Get the current dimensions.
Dim wid As Double = r.right - r.left
Dim hgt As Double = r.bottom - r.top
' Enlarge if necessary to preserve the aspect ratio.
If hgt / wid > aspect_ratio Then
' It's too tall and thin. Make it wider.
wid = hgt / aspect_ratio
Else
' It's too short and wide. Make it taller.
hgt = wid * aspect_ratio
End If
' See if the user is dragging the top edge.
If m.WParam.ToInt32 = WMSZ_TOP Or _
m.WParam.ToInt32 = WMSZ_TOPLEFT Or _
m.WParam.ToInt32 = WMSZ_TOPRIGHT _
Then
' Reset the top.
r.top = r.bottom - CInt(hgt)
Else
' Reset the height to the saved value.
r.bottom = r.top + CInt(hgt)
End If
' See if the user is dragging the left edge.
If m.WParam.ToInt32 = WMSZ_LEFT Or _
m.WParam.ToInt32 = WMSZ_TOPLEFT Or _
m.WParam.ToInt32 = WMSZ_BOTTOMLEFT _
Then
' Reset the left.
r.left = r.right - CInt(wid)
Else
' Reset the width to the saved value.
r.right = r.left + CInt(wid)
End If
' Update the Message object's LParam field.
Marshal.StructureToPtr(r, m.LParam, True)
End If
MyBase.WndProc(m)
End Sub
|
|
|
|
|
|