Search code examples
vbams-access

How to check if a form in ms access vba is fully on screen/visible?

As some of our user tell us that they cant see all of some forms on their screens, we try to call a function for every form after opening which logs the forms which are too broad or too high. We focus on the bottom right corner of the form because this is the part our users are complaining about. This function looks like this (We changed the log functionality to a stop so its easier to read):

Private Sub CheckObFormVollstaendigSichtbar(ByVal par_form As Form)
  
  Dim formRight As Integer
  formRight = par_form.WindowLeft + par_form.WindowWidth
  
  Dim formBottom As Integer
  formBottom = par_form.WindowTop + par_form.WindowHeight

  With fn_getAccessClientRect
    
    If .BottomRight.x < formRight Then
      'Too broad
      Stop
    End If
    
    If .BottomRight.Y < formBottom Then
      'Too high
      Stop
    End If
    
  End With

  
End Sub

The supporting function look like this:

Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As Rect) As Long

Type Rect
    x1 As Long
    y1 As Long
    x2 As Long
    y2 As Long
End Type    

Public Function fn_getAccessClientRect() As ZRechteckClass

  Dim mdiRect As Rect

  Call GetClientRect(Application.hWndAccessApp, mdiRect)

  Set fn_getAccessClientRect = ZRechteck(fn_pixelsToTwips(mdiRect.x1, DIRECTION_HORIZONTAL), _
                                         fn_pixelsToTwips(mdiRect.y1, DIRECTION_VERTICAL), _
                                         fn_pixelsToTwips(mdiRect.x2, DIRECTION_HORIZONTAL), _
                                         fn_pixelsToTwips(mdiRect.y2, DIRECTION_VERTICAL))

End Function

Public Function fn_pixelsToTwips(lPixels As Long, lDirection As Long) As Long

  Dim lDeviceHandle As Long
  Dim lPixelsPerInch As Long

  lDeviceHandle = GetDC(0)

  If lDirection = DIRECTION_HORIZONTAL Then
    lPixelsPerInch = GetDeviceCaps(lDeviceHandle, LOGPIXELSX)
  Else
    lPixelsPerInch = GetDeviceCaps(lDeviceHandle, LOGPIXELSY)
  End If

  lDeviceHandle = ReleaseDC(0, lDeviceHandle)
  
  fn_pixelsToTwips = lPixels * 1440 / lPixelsPerInch

End Function

Unfortuatly the function seems to be bit off.

So in case of the following picture the stop is not reached: Why the stop is not triggered?

The stop is only triggerd around here: Here its triggered

This is the full form: Full form

Solution

  • Ok. I have to check which is the client rect of the parent of the form I use (Which is the form

    Private Sub CheckObFormVollstaendigSichtbar(ByVal par_form As Form)
  
  Dim formRight As Integer
  formRight = par_form.WindowLeft + par_form.WindowWidth
  
  Dim formBottom As Integer
  formBottom = par_form.WindowTop + par_form.WindowHeight

  With fn_getUsableClientRectForForm(par_Form)
    
    If .BottomRight.x < formRight Then
      'Too broad
      Stop
    End If
    
    If .BottomRight.Y < formBottom Then
      'Too high
      Stop
    End If
    
  End With

  
End Sub

    I use "fn_getUsableClientRectForForm" instead of "fn_getAccessClientRect" (from the question):

    Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long

Public Function fn_getUsableClientRectForForm(ByVal par_Form As Form) As ZRechteckClass

  Dim mdiRect As Rect

  Call GetClientRect(GetParent(par_Form.hWnd), mdiRect)

  Set fn_getUsableClientRectForForm = ZRechteck(fn_pixelsToTwips(mdiRect.x1, DIRECTION_HORIZONTAL), _
                                                fn_pixelsToTwips(mdiRect.y1, DIRECTION_VERTICAL), _
                                                fn_pixelsToTwips(mdiRect.x2, DIRECTION_HORIZONTAL), _
                                                fn_pixelsToTwips(mdiRect.y2, DIRECTION_VERTICAL))

End Function

    This answer is suboptimal because I have to open a form to get the usable client rect of access. I'm still searching for a way to get the rect !without! a form-opject.