Results 1 to 5 of 5

Thread: Restrict resize to vertical

  1. #1

    Thread Starter
    Lively Member
    Join Date
    Jul 2000
    Posts
    94

    Question

    Is there a way that I can allow vertical resizing only? I have seen solutions involving timers and whatnot, but they are not what I am looking for. I don't want them to resize horizontal at all. Any ideas?

  2. #2
    Guest
    No need for timers.

    Try this:

    Code:
    Dim iWidth As Integer
    
    Private Sub Form_Load()
    iWidth = Me.Width
    End Sub
    
    Private Sub Form_Resize()
    On Error Resume Next
    Me.Width = iWidth
    End Sub

  3. #3
    Guest
    This is a bit more advanced:

    Code:
    Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
    Dim LockWindow As Boolean
    Dim iWidth As Integer
    
    Private Sub Form_Load()
    iWidth = Me.Width
    End Sub
    
    Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
        LockWindowUpdate 0&
    End Sub
    
    Private Sub Form_Resize()
    On Error Resume Next
        Static FirstLoad
        
        'If this is the First time the Window is loading then don't lock it
        If FirstLoad = False Then
            FirstLoad = True
            LockWindow = True
            Exit Sub
        End If
        
        'Lock the Window when the User tries to resize it
        If LockWindow = True Then
            'Restore the dimensions
            Me.Width = iWidth
            LockWindowUpdate Me.hWnd
        End If
    
    End Sub

  4. #4

    Thread Starter
    Lively Member
    Join Date
    Jul 2000
    Posts
    94

    Angry

    Thanks for your help, but this is not exactly what I am looking for. I would like to keep them from even dragging it in the horizontal direction at all. I have seen this done a lot.
    BTW, the second example is buggy. It doesn't allow the form to be repainted consistently, and on a windows 2000 system it doesn't show at all.

  5. #5

    Thread Starter
    Lively Member
    Join Date
    Jul 2000
    Posts
    94

    Lightbulb

    I found it finally. So for anyone else interested here is the code to restric the resize.

    In a module:
    Code:
    Option Explicit
    
    Public defWindowProc As Long
    Public minX As Long
    Public minY As Long
    Public maxX As Long
    Public maxY As Long
    
    Public Const GWL_WNDPROC As Long = (-4)
    Public Const WM_GETMINMAXINFO As Long = &H24
    
    Public Type POINTAPI
        x As Long
        y As Long
    End Type
    
    Type MINMAXINFO
        ptReserved As POINTAPI
        ptMaxSize As POINTAPI
        ptMaxPosition As POINTAPI
        ptMinTrackSize As POINTAPI
        ptMaxTrackSize As POINTAPI
    End Type
    
    Public Declare Function SetWindowLong Lib "user32" _
        Alias "SetWindowLongA" _
       (ByVal hwnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
       
    Public Declare Function CallWindowProc Lib "user32" _
        Alias "CallWindowProcA" _
       (ByVal lpPrevWndFunc As Long, _
        ByVal hwnd As Long, _
        ByVal uMsg As Long, _
        ByVal wParam As Long, _
        ByVal lParam As Long) As Long
    
    Public Declare Sub CopyMemory Lib "kernel32" _
       Alias "RtlMoveMemory" _
       (hpvDest As Any, _
        hpvSource As Any, _
        ByVal cbCopy As Long)
    
    
    Public Sub SubClass(hwnd As Long)
    
       On Error Resume Next
       defWindowProc = SetWindowLong(hwnd, _
                                     GWL_WNDPROC, _
                                     AddressOf WindowProc)
       
    End Sub
    
    
    Public Sub UnSubClass(hwnd As Long)
    
       If defWindowProc Then
          SetWindowLong hwnd, GWL_WNDPROC, defWindowProc
          defWindowProc = 0
       End If
       
    End Sub
    
    
    Public Function WindowProc(ByVal hwnd As Long, _
                               ByVal uMsg As Long, _
                               ByVal wParam As Long, _
                               ByVal lParam As Long) As Long
    
    
       On Error Resume Next
      
       Select Case hwnd
    
          Case frmMain.hwnd
             
             On Error Resume Next
    
             Select Case uMsg
                
                Case WM_GETMINMAXINFO
                     
                      Dim MMI As MINMAXINFO
                      
                      CopyMemory MMI, ByVal lParam, LenB(MMI)
    
                       With MMI
                          .ptMinTrackSize.x = minX
                          .ptMinTrackSize.y = minY
                          .ptMaxTrackSize.x = maxX
                          .ptMaxTrackSize.y = maxY
                      End With
          
                      CopyMemory ByVal lParam, MMI, LenB(MMI)
                     
                      WindowProc = 0
                        
                  Case Else
                  
                       WindowProc = CallWindowProc(defWindowProc, _
                                                   hwnd, _
                                                   uMsg, _
                                                   wParam, _
                                                   lParam)
                      
              End Select
       
       End Select
       
    End Function
    In the Form Code
    Code:
    Option Explicit
    
    Private TwipsX As Integer
    Private TwipsY As Integer
    
    
    
    Private Sub Form_Load()
    
       TwipsX = Screen.TwipsPerPixelX
       TwipsY = Screen.TwipsPerPixelY
        
       maxX = Me.Width \ TwipsX
       minX = Me.Width \ TwipsX
       minY = 0
       maxY = 600
       Call SubClass(frmMain.hwnd)
        
    End Sub
    
    
    Private Sub Form_Unload(Cancel As Integer)
    
        Call UnSubClass(Me.hwnd)
    
    End Sub

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width