[AccessD] Determine current page number of report in preview

Gustav Brock gustav at cactus.dk
Wed Sep 8 13:48:19 CDT 2004


Hi A.D.  (warning: long post)

Thanks for the hints and the demo.

It is certainly possible to pick the page number by SendKeys and paste
it into something else like a textbox.

However, the link to Stephen Lebans' site contained the gold nuggets
to achieve this via some API calls. It seems to work even when the
report is minimized (and when in design view it doesn't fail).

At the end, find the code for a complete module including the function

  SetCurrentReportPage()
  
which will both set and get the page number of the current page when a
report is displayed in preview. Also, two demo functions are included.

/gustav


> Gustav,

>     It is observed that events generated by a report opened in
> preview mode, get exhausted in the first forward pass through its
> pages.  

>     As a result, in case of any subsequent navigation through the
> pages already covered, there is no more firing of any event at all.
> Values pertaining to Page and CurrentRecord properties of the report
> remain stuck at the highest value touched (even if the page now
> being viewed is a lower one in the sequence).  

>     In view of the above, any attempt to obtain the current page
> number (in subsequent passes) from code within the report's module,
> gets vitiated on account of non-availability of any event that could
> activate such code. 

>     If your situation permits use of code attached to a form, a
> solution could be worked out, adopting either of the following
> approaches -

>     (a) Combination of SendKeys method along with API calls. It is
> based upon the feature that pressing F5 key in the report preview
> window selects the contents of page counter window at bottom left.

>     (b) Avoiding use of SendKeys by using additional API calls.

>     (In case of (a), the code involved is relatively simple, while
> (b) might need very bulky & tedious code) 

>     I can send you a sample db demonstrating a solution of type (a)
> above. Your eMail address to be used for this purpose, may please be
> advised.  

>     If you are keen to evolve a solution of type (b) above, you
> could get some working ideas from the function  fTurnPage()  at
> Stephan Leban's site.  

> Regards,
> A.D.Tejpal
> --------------

>   ----- Original Message ----- 

>   How do you catch the current page in preview?

>   Access caches pages while you are browsing forward.
>   Fine, but if the user moves (browses) backwards, the Page property stays on the highest number even though the preview displays the correct lower page number.

>   I guess the only chance would be to catch the current page number from the status line of the preview window but I don't know if that is possible.

This is the complete module for Access 97.
Should work for Access 2000+ as well but is not tested.

<code>

Option Compare Database
Option Explicit

' Original code by Stephen Lebans: http://www.lebans.com
' Visit: http://www.lebans.com/Report.htm
'
' 2004-09-08:
'   Modified by Gustav Brock, Cactus Data ApS, CPH.
'   Added functionality for retrieving the current page number.
'   Added simple demo.

' IMPORTANT: Call ResetReportHandles when opening the report!
' Copy this line and paste it into Report_Open:
'
'   Call ResetReportHandles
'
' ---

  Private Type RECTL
     Left   As Long
     Top    As Long
     Right  As Long
     Bottom As Long
  End Type
  
  Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _
    ByVal hWnd1 As Long, _
    ByVal hWnd2 As Long, _
    ByVal lpsz1 As String, _
    ByVal lpsz2 As String) _
    As Long
  
  Private Declare Function SetActiveWindow Lib "user32" ( _
    ByVal hWnd As Long) _
    As Long
  
  Private Declare Function GetWindow Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal wCmd As Long) _
    As Long
  
  Private Declare Function GetWindowRect Lib "user32" ( _
    ByVal hWnd As Long, _
    ByRef lpRect As RECTL) _
    As Long
  
  Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" ( _
    ByVal hWnd As Long, _
    ByVal lpString As String, _
    ByVal cch As Long) _
    As Long
  
  Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" ( _
    ByVal hWnd As Long) _
    As Long
  
  Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" ( _
    ByVal hWnd As Long, _
    ByVal lpString As String) _
    As Long
    
  Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByVal lParam As Long) _
    As Long
   
  Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
    ByVal hWnd As Long, _
    ByVal wMsg As Long, _
    ByVal wParam As Long, _
    ByRef lParam As Any) _
    As Long
    
  Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" ( _
    ByVal wCode As Long, _
    ByVal wMapType As Long) _
    As Long
    
  ' Window messages.
  Private Const WM_ACTIVATE = &H6
  Private Const WM_SETFOCUS = &H7
  Private Const WM_KILLFOCUS = &H8
  Private Const WM_ENABLE = &HA
  Private Const WM_SETREDRAW = &HB
  Private Const WM_SETTEXT = &HC
  Private Const WM_GETTEXT = &HD
  Private Const WM_GETTEXTLENGTH = &HE
  Private Const WM_PAINT = &HF
  Private Const WM_CLOSE = &H10
  Private Const WM_QUERYENDSESSION = &H11
  Private Const WM_QUIT = &H12
  Private Const WM_QUERYOPEN = &H13
  Private Const WM_ERASEBKGND = &H14
  Private Const WM_SYSCOLORCHANGE = &H15
  Private Const WM_ENDSESSION = &H16
  Private Const WM_SHOWWINDOW = &H18
  Private Const WM_WININICHANGE = &H1A
  Private Const WM_DEVMODECHANGE = &H1B
  Private Const WM_ACTIVATEAPP = &H1C
  Private Const WM_FONTCHANGE = &H1D
  Private Const WM_TIMECHANGE = &H1E
  Private Const WM_CANCELMODE = &H1F
  Private Const WM_SETCURSOR = &H20
  Private Const WM_MOUSEACTIVATE = &H21
  Private Const WM_CHILDACTIVATE = &H22
  Private Const WM_QUEUESYNC = &H23
  
  Private Const WM_KEYFIRST = &H100
  Private Const WM_KEYDOWN = &H100
  Private Const WM_KEYUP = &H101
  Private Const WM_CHAR = &H102
  Private Const WM_DEADCHAR = &H103
  Private Const WM_SYSKEYDOWN = &H104
  Private Const WM_SYSKEYUP = &H105
  Private Const WM_SYSCHAR = &H106
  Private Const WM_SYSDEADCHAR = &H107
  Private Const WM_KEYLAST = &H108
  Private Const WM_INITDIALOG = &H110
  Private Const WM_COMMAND = &H111
  Private Const WM_SYSCOMMAND = &H112
  Private Const WM_TIMER = &H113
  Private Const WM_HSCROLL = &H114
  Private Const WM_VSCROLL = &H115
  Private Const WM_INITMENU = &H116
  Private Const WM_INITMENUPOPUP = &H117
  Private Const WM_MENUSELECT = &H11F
  Private Const WM_MENUCHAR = &H120
  Private Const WM_ENTERIDLE = &H121
  
  Private Const WM_MOUSEFIRST = &H200
  Private Const WM_MOUSEMOVE = &H200
  Private Const WM_LBUTTONDOWN = &H201
  Private Const WM_LBUTTONUP = &H202
  Private Const WM_LBUTTONDBLCLK = &H203
  Private Const WM_RBUTTONDOWN = &H204
  Private Const WM_RBUTTONUP = &H205
  Private Const WM_RBUTTONDBLCLK = &H206
  Private Const WM_MBUTTONDOWN = &H207
  Private Const WM_MBUTTONUP = &H208
  Private Const WM_MBUTTONDBLCLK = &H209
  Private Const WM_MOUSELAST = &H209
    
  ' GetWindow() constants.
  Private Const GW_HWNDFIRST = 0
  Private Const GW_HWNDLAST = 1
  Private Const GW_HWNDNEXT = 2
  Private Const GW_HWNDPREV = 3
  Private Const GW_OWNER = 4
  Private Const GW_CHILD = 5
  Private Const GW_MAX = 5
  
  ' Other constants.
  Private Const HTCLIENT = 1
  
  ' Private variables.
  ' Can (and must) be reset externally by calling sub
  ' ResetReportHandles
  Private hWndChild  As Long
  Private hWndOSUI   As Long
  
Private Function MakeDWord( _
  ByVal loword As Integer, _
  ByVal hiword As Integer) _
  As Long

  MakeDWord = (hiword * &H10000) Or (loword And &HFFFF&)
  
End Function

Public Sub ResetReportHandles()

' Reset Window handles.
' NB: Call this sub when opening the report!
  
  hWndOSUI = 0
  hWndChild = 0

End Sub

Public Function GetTextFromWindow( _
  ByVal hWnd As Long) _
  As String

' Retrieve text from a window identified by its handle.

  Dim strWindow As String
  Dim lngReturn As Long
  
  ' Create a buffer.
  strWindow = String(GetWindowTextLength(hWnd) + 1, vbNullChar)
  ' Get the window's text.
  lngReturn = GetWindowText(hWnd, strWindow, Len(strWindow))
  strWindow = Left(strWindow, Len(strWindow) - 1)
  
  GetTextFromWindow = strWindow

End Function

Public Function SetCurrentReportPage( _
  ByVal strReport As String, _
  ByRef intPageNumber As Integer) _
  As Boolean

' This function sets or retrieves the current page number of
' the Report Print Preview window.
'
' If intPageNumber is > 0, the preview page is moved to this number
' or the last page of the report if this is smaller.
' In any case, the currently displayed page number is returned in
' intPageNumber.
' If success, the function returns True.

' **** APP NOTES by Stephen Lebans ****
' I did try the standard method to Find a Window by
' ClassName or Caption.
' Unfortunately the TextBox "OKttbx" that displays
' the Current Report Page number is part of
' a lightweight Control. It is drawn as required and
' appears as required and dissappears when it is not required.
' The only reliable method was this hack. It works by
' simulating a physical clicking in the Page number Window.

  On Error GoTo Err_SetCurrentReportPage
  
  Static lngWindowLocation  As Long
  
  ' Hold our OSUI Window dimensions.
  Dim RC                    As RECTL
  Dim intPosx               As Integer
  
  Dim lngTemp1              As Long
  Dim lngTemp2              As Long
  Dim lngReturn             As Long
  Dim lnghWnd               As Long
  Dim strPageNumber         As String
  Dim booSuccess            As Boolean
  
  lnghWnd = Access.Reports.Item(strReport).hWnd
  
  ' Ensure this window is the Active Window.
  ' Make sure the report is the currently selected object.
  lngReturn = SetActiveWindow(lnghWnd)
  
  ' If we have already determined the location of
  ' the Page Number Window then skip our probe.
  ' Else find the Page Navigation Window located at
  ' the bottom of the Report Print Preview window.
  If hWndChild = 0 Then
    hWndOSUI = FindWindowEx(lnghWnd, 0&, "OSUI", vbNullString)
    ' Get Window extents.
    lngReturn = GetWindowRect(hWndOSUI, RC)
    ' We need to go hunting for the Page Number Window.
    ' We know it is at the bottom of this Window.
    ' Let's check from Left to Right and along the
    ' middle of the height of the Window.
    ' Simulate Mouse Click with the Left button to activate the window.
    ' Stephen tried to do this the proper way but it was not reliable.
    ' This hack seems to work.
    ' Start 20 pixels in.
    intPosx = 20
    Do While intPosx < RC.Right
      lngTemp1 = MakeDWord(intPosx, (RC.Bottom - RC.Top) / 2)
      lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngTemp1)
      lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngTemp1)
      lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngTemp1)
      lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngTemp1)
      DoEvents
      hWndChild = GetWindow(hWndOSUI, GW_CHILD)
      If hWndChild <> 0 Then
        ' Store location for a next run of the function.
        lngWindowLocation = lngTemp1
        Exit Do
      End If
      ' Let's keep moving 4 more pixels to the right.
      intPosx = intPosx + 4
      DoEvents
    Loop
  End If
  
  If hWndChild = 0 Or lngWindowLocation = 0 Then
    ' Somehow we failed.
    ' Return undefined page number.
    intPageNumber = 0
  Else
    ' Create the lParam.
    lngTemp1 = MakeDWord(HTCLIENT, WM_LBUTTONDOWN)
    ' Send the Mouse Activate message.
    lngReturn = SendMessage(hWndOSUI, WM_MOUSEACTIVATE, Application.hWndAccessApp, ByVal lngTemp1)
    ' Send the Left Mouse Button Down message.
    lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngWindowLocation)
    lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngWindowLocation)
    ' Ensure messages are processed.
    DoEvents
    
    ' If intPageNumber is zero or negative we only wish to retrieve the current page number.
    If intPageNumber > 0 Then
      ' Copy our desired page number into the Page Number TextBox.
      strPageNumber = intPageNumber
      lngReturn = SetWindowText(hWndChild, strPageNumber)
      ' Allow Windows to catch up.
      DoEvents
      ' Generate Enter key press to force Access to update display.
      lngTemp1 = MapVirtualKey(vbKeyReturn, 0&)
      lngTemp2 = MakeDWord(1, CInt(lngTemp1))
      lngReturn = PostMessage(hWndChild, WM_KEYDOWN, 13, lngTemp2)
      lngReturn = PostMessage(hWndChild, WM_CHAR, 13, lngTemp2)
      ' Ensure messages are processed.
      DoEvents
      
      ' Create a new mouse click to read the displayed page number.
      ' Otherwise we will only retrieve the Enter key press.
      ' Create the lParam.
      lngTemp1 = MakeDWord(HTCLIENT, WM_LBUTTONDOWN)
      ' Send the Mouse Activate message.
      lngReturn = SendMessage(hWndOSUI, WM_MOUSEACTIVATE, Application.hWndAccessApp, ByVal lngTemp1)
      ' Send the Left Mouse Button Down message.
      lngReturn = PostMessage(hWndOSUI, WM_LBUTTONDOWN, 1&, lngWindowLocation)
      lngReturn = PostMessage(hWndOSUI, WM_LBUTTONUP, 1&, lngWindowLocation)
      ' Ensure messages are processed.
      DoEvents
    End If
    
    ' Retrieve and return current page number.
    strPageNumber = GetTextFromWindow(hWndChild)
    intPageNumber = CInt(strPageNumber)
    ' Signal success.
    booSuccess = True
  End If
  
  SetCurrentReportPage = booSuccess

Exit_SetCurrentReportPage:
  Exit Function

Err_SetCurrentReportPage:
  MsgBox "Error: " & Err.Number & "." & vbCrLf & Err.Description, vbCritical + vbOKOnly, Err.Source
  Resume Exit_SetCurrentReportPage

End Function

Public Function DemoGetReportPage() _
  As Integer

  Dim rpt           As Access.Report
  
  Dim strReport     As String
  Dim booSuccess    As Boolean
  Dim intReportPage As Integer

  If Access.Reports.Count > 0 Then
    Set rpt = Access.Reports(0)
    strReport = rpt.Name
    
    booSuccess = SetCurrentReportPage(strReport, intReportPage)
  
    Set rpt = Nothing
  End If
  
  DemoGetReportPage = intReportPage
  
End Function

Public Function DemoSetReportPage( _
  ByVal intReportPage As Integer) _
  As Integer

  Dim rpt           As Access.Report
  
  Dim strReport     As String
  Dim booSuccess    As Boolean
  
  If Access.Reports.Count = 0 Then
    intReportPage = 0
  Else
    Set rpt = Access.Reports(0)
    strReport = rpt.Name
    
    booSuccess = SetCurrentReportPage(strReport, intReportPage)
  
    Set rpt = Nothing
  End If
  
  DemoSetReportPage = intReportPage
  
End Function

</code>

Have fun!

/gustav




More information about the AccessD mailing list