Tipp 0416 Fenstergröße begrenzen
Autor/Einsender:
Datum:
  Jürgen Beil
12.09.2004
Entwicklungsumgebung:   VB 6
In manchen Fällen soll der Anwender das Programmfenster nur bis zu einer bestimmten Größe verkleinern und/oder vergrößern dürfen. Diese Funktionalität kann natürlich im Resize-Ereignis der Form implementiert werden, was jedoch eine recht flackernde Angelegenheit ist und oft nicht den gewünschten Effekt erzielt.
Bei diesem Tipp wird die Fenstergröße mit Hilfe von API-Funktionen und Subclassing eingeschränkt.
Wichtiger Hinweis
Im Tipp wird Subclassing verwendet. Das Programm sollte nicht mit dem Beenden-Button der Entwicklungsumgebung (IDE) beendet werden, da dies nahezu immer zum Absturz der IDE führt.
Alle nicht gespeicherten Daten gehen damit verloren!!!
Code im Codebereich des Moduls
 
Option Explicit

Private Const WM_GETMINMAXINFO = &H24&
Private Const GWL_WNDPROC = (-4)

Private Type POINTAPI
  X As Long
  Y As Long
End Type

Private Type MINMAXINFO
  ptReserved      As POINTAPI
  ptMaxSize       As POINTAPI
  ptMaxPosition   As POINTAPI
  ptMinTrackSize  As POINTAPI
  ptMaxTrackSize  As POINTAPI
End Type

Private Declare Function SetWindowLong Lib "user32" Alias _
      "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex _
      As Long, ByVal dwNewLong As Long) As Long

Private Declare Sub CopyMemory Lib "kernel32" Alias _
      "RtlMoveMemory" (ByRef lDestination As Any, ByRef _
      pSource As Any, ByVal Length As Long)

Private 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

Private m_PrevWindowProc As Long

Private m_MinWidth  As Long
Private m_MinHeight As Long
Private m_MaxWidth  As Long
Private m_MaxHeight As Long

Public Sub LimitWindowSize(ByRef Frm As Form, _
      ByVal MinWidth As Long, ByVal MinHeight As Long, _
      ByVal MaxWidth As Long, ByVal MaxHeight As Long)

  If m_PrevWindowProc <> 0 Then
    ReleaseWindowSize Frm
  End If

  m_MinWidth = MinWidth
  m_MinHeight = MinHeight
  m_MaxWidth = MaxWidth
  m_MaxHeight = MaxHeight

  m_PrevWindowProc = SetWindowLong(Frm.hWnd, GWL_WNDPROC, _
             AddressOf WindowProc)
End Sub

Public Sub ReleaseWindowSize(ByVal Frm As Form)
  If m_PrevWindowProc <> 0 Then
    SetWindowLong Frm.hWnd, GWL_WNDPROC, m_PrevWindowProc
    m_PrevWindowProc = 0
  End If
End Sub

Private Function WindowProc(ByVal hWnd As Long, ByVal uMsg As _
    Long, ByVal wParam As Long, ByVal lParam As Long) As Long

   Dim MMI As MINMAXINFO

   Select Case uMsg
      Case WM_GETMINMAXINFO
        CopyMemory MMI, ByVal lParam, Len(MMI)

        With MMI
          .ptMinTrackSize.X = m_MinWidth
          .ptMinTrackSize.Y = m_MinHeight
          .ptMaxTrackSize.X = m_MaxWidth
          .ptMaxTrackSize.Y = m_MaxHeight
        End With

        CopyMemory ByVal lParam, MMI, Len(MMI)
        WindowProc = 0

      Case Else
        WindowProc = CallWindowProc(m_PrevWindowProc, _
                hWnd, uMsg, wParam, lParam)
   End Select
End Function
 
Code im Codebereich der Form
 
Option Explicit

Private m_FrmWidth  As Long
Private m_FrmHeight As Long

Private Sub Form_Load()
  m_FrmWidth = Me.Width
  m_FrmHeight = Me.Height
End Sub

Private Sub cmdLimitWindowSize_Click()
  Dim lngMinHeight As Long
  Dim lngMinWidth  As Long
  Dim lngMaxHeight As Long
  Dim lngMaxWidth  As Long

  lngMinWidth = Val(txtMinWidth.Text)
  If lngMinWidth <= 0 Then
    lngMinWidth = m_FrmWidth
  End If

  lngMinHeight = Val(txtMinHeight.Text)
  If lngMinHeight <= 0 Then
    lngMinHeight = m_FrmHeight
  End If

  lngMaxWidth = Val(txtMaxWidth.Text)
  If lngMaxWidth <= 0 Then
    lngMaxWidth = Screen.Width / Screen.TwipsPerPixelX
  Else
    If lngMaxWidth < lngMinWidth Then
      lngMaxWidth = lngMinWidth
    End If
  End If

  lngMaxHeight = Val(txtMaxHeight.Text)
  If lngMaxHeight <= 0 Then
    lngMaxHeight = Screen.Height / Screen.TwipsPerPixelY
  Else
    If lngMaxHeight < lngMinHeight Then
      lngMaxHeight = lngMinHeight
    End If
  End If

  Call LimitWindowSize(Me, lngMinWidth, lngMinHeight, _
            lngMaxWidth, lngMaxHeight)
End Sub

Private Sub cmdReleaseWindowSize_Click()
  ReleaseWindowSize Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
  ReleaseWindowSize Me
End Sub
 

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (4,5 kB) Downloads bisher: [ 790 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Freitag, 12. August 2011