vbAccelerator - Contents of code file: frmMain.frm

VERSION 5.00
Begin VB.Form frmMain 
   Caption         =   "Controlled Resize Demo"
   ClientHeight    =   3000
   ClientLeft      =   7515
   ClientTop       =   2805
   ClientWidth     =   5145
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3000
   ScaleWidth      =   5145
   Begin VB.ListBox lstDemo 
      Height          =   2595
      Left            =   60
      TabIndex        =   0
      Top             =   120
      Width           =   4995
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type
Private Const LB_GETITEMRECT = &H198
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
 hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const SPI_GETWORKAREA = 48
Private Declare Function SystemParametersInfo Lib "user32" Alias
 "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam
 As Any, ByVal fuWinIni As Long) As Long

Private m_lItemHeight As Long

Private WithEvents m_c As cSizeMoveHelper
Attribute m_c.VB_VarHelpID = -1

Private Sub NewToolWindow()
Dim fD As New frmToolWindow
   fD.Show , Me
   fD.ParentForm = Me
End Sub

Private Sub Form_Load()
   
   ' Add the
   Set m_c = New cSizeMoveHelper
   m_c.Attach Me.hwnd
   lstDemo.AddItem "vbAccelerator Controlled Resize Demo"
   lstDemo.AddItem ""
   lstDemo.AddItem "This form demonstrates various form position controls:"
   lstDemo.AddItem "  * Height snaps to integral ListBox size"
   lstDemo.AddItem "  * Width/Height cannot be made too small"
   lstDemo.AddItem "  * No part of form can be moved out of view"
   lstDemo.AddItem ""
   
   ' Get the integral height for a ListBox item
   ' (nb: changes with font):
   Dim tR As RECT
   SendMessage lstDemo.hwnd, LB_GETITEMRECT, 0, tR
   m_lItemHeight = tR.Bottom - tR.Top
   
   ' Use the resizing calc to evaluate the initial height:
   Dim lHeight As Long
   lHeight = Me.ScaleHeight \ Screen.TwipsPerPixelY
   m_c_Sizing 0, 0, Me.ScaleWidth \ Screen.TwipsPerPixelX, lHeight
   Me.Height = lHeight * Screen.TwipsPerPixelY
   
   ' Create a demo window which never Shows its contents
   ' when sizing or moving:
   NewToolWindow
   
End Sub

Private Sub m_c_Activate(ByVal bByMouse As Boolean)
   lstDemo.AddItem "Form Activate"
End Sub

Private Sub m_c_Deactivate()
   lstDemo.AddItem "Form Deactivate"
End Sub

Private Sub m_c_EnterSizeMove()
   lstDemo.AddItem "EnterSizeMove"
End Sub

Private Sub m_c_ExitSizeMove()
   lstDemo.AddItem "ExitSizeMove"
End Sub

Private Sub m_c_Moving(lLeft As Long, lTop As Long, lWidth As Long, lHeight As
 Long)
Dim tR As RECT
   ' Form can't go off screen:
   SystemParametersInfo SPI_GETWORKAREA, 0, tR, 0
   If lLeft < 0 Then
      lLeft = 0
   End If
   If lTop < 0 Then
      lTop = 0
   End If
   If lLeft + lWidth > tR.Right Then
      lLeft = tR.Right - lWidth
   End If
   If lTop + lHeight > tR.Bottom Then
      lTop = tR.Bottom - lHeight
   End If
End Sub

Private Sub m_c_Sizing(lLeft As Long, lTop As Long, lWidth As Long, lHeight As
 Long)
   ' Ensure size can only be set to an integral
   ' height to match the listbox)
   Dim lFormExtra As Long
   Dim lIntegral As Long
   
   ' The height of the form and border around the listbox:
   lFormExtra = (lstDemo.Top * 2 + Me.Height - Me.ScaleHeight) \
    Screen.TwipsPerPixelX + 4
   
   ' Get the closest matching height which will hold an integral sized ListBox:
   lIntegral = ((lHeight - lFormExtra) \ m_lItemHeight) * m_lItemHeight
   ' Ensure at least four items:
   If lIntegral < m_lItemHeight * 4 Then lIntegral = m_lItemHeight * 4
   
   ' If the listbox height is going to change then do it:
   lstDemo.Move lstDemo.Left, lstDemo.Top, Me.ScaleWidth - lstDemo.Left * 2,
    (lIntegral + 4) * Screen.TwipsPerPixelY
   
   ' Modify the height the class passed on so the form only
   ' gets resized in steps matching the integral size:
   lHeight = lIntegral + lFormExtra
   
   ' Don't allow the width smaller than the height of a listbox item
   ' + the borders:
   If lWidth < 2 * lstDemo.Left \ Screen.TwipsPerPixelX + 4 + m_lItemHeight Then
      lWidth = 2 * lstDemo.Left \ Screen.TwipsPerPixelX + 4 + m_lItemHeight
   End If
      
End Sub