Rabu, 27 Agustus 2014

RE: [MS_AccessPros] widths and heights

 

Hi Stuart

That's odd.  What version of Access?  For me (A2010/64 or A2013/32) GetRibbonHeight returns 2595, or 1305 if the ribbon is collapsed.

Can you set a breakpoint on the line "Public Function GetRibbonHeight() As Long" and step through the code to see what path it is taking?  Specifically, check that hWnd is never assigned a value of zero, and that TwipsPerPixelY is not returning zero (it should be 15 or thereabouts).

Cheers,
Graham

 

From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Thursday, 28 August 2014 05:21
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights

 

 

Graham, this version is returning 0 for ribbon.   navpane looks good.....

 

Stuart

 

On Wednesday, August 27, 2014 8:15 AM, "Crystal strive4peace2008@yahoo.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:

 

 

Hi Graham,  right away, I see this:

#If VBA7 Then
   ' use LongPtr
#Else
   'As Long
#End if

what are other changes that you make?

thanks!

 

 

Warm Regards,

Crystal

 

Contacts database in Access

Contacts_070604 ... being updated ~ hopefully post something new in a few months

 

 

image

 

 

 

 

 

MS Access Professionals

SPAM-FREE advice and knowledge pool for beginners through advanced users of Microsoft Access and databases in general. Please Note: New Members will have thei...

Preview by Yahoo

 

 

 *

   (: have an awesome day :)

 *

 

 

On Wednesday, August 27, 2014 5:58 AM, "Crystal strive4peace2008@yahoo.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:

 

 

thanks for explaining, Graham ~ this is a great example for using conditional compilation for 32 and 64-bit

 

Warm Regards,

Crystal

 

Graph with Access!

How to create a chart:and how to change it with VBA

 *

   (: have an awesome day :)

 *

 

 

On Tuesday, August 26, 2014 9:26 PM, "'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:

 

 

Hi Crystal

That's because most of it is API declarations, and each of them requires two forms – one for VBA7 and one for earlier versions.

Strictly speaking, the pre-VBA7 forms are not required in this case, because there would be neither a ribbon nor a nav pane, but it's good practice to declare them properly :-)

Cheers, G.

 

From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, 27 August 2014 14:03
To:
MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights

 

 

thanks, Graham. The code lines seem to have about doubled ... I've saved this and am sure I will be studying it sometime down the road ...

 

Warm Regards,
Crystal

 

 

 

image

 

 

 

 

 

The Code Documenter analyzes ACCDB and MDB files. Watch for updates. Access 2007+ version Crystals_CodeDocumenter_120204_2p_BETA_ACCDE_TXT.zip

Preview by Yahoo

 



Through sharing, we will all get better

~  have an awesome day ~

 

 

On Tuesday, August 26, 2014 6:44 PM, "'Graham Mandeno' graham@mandeno.com [MS_Access_Professionals]" <MS_Access_Professionals@yahoogroups.com> wrote:

 

 

Hi Stuart and Crystal (and anyone else who's interested),

Here is an all-version-friendly update.  I've tested it on A2003, A2010-64, and A2013-32.  (Of course, both functions return zero on A2003 because it has neither ribbon nor nav pane).

Cheers,
Graham

=============== start code ================
Option Compare Database
Option Explicit

Private Const LOGPIXELSX    As Long = 88
Private Const LOGPIXELSY    As Long = 90

Private Const nTwipsPerInch As Long = 1440

Private dTwipsPerPixelX     As Double
Private dTwipsPerPixelY     As Double

Private Type winRECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

#If VBA7 Then
  Private Declare PtrSafe Function GetDC _
    Lib "user32" ( _
      ByVal hWnd As LongPtr _
    ) As LongPtr
#Else
  Private Declare Function GetDC _
    Lib "user32" ( _
      ByVal hWnd As Long _
    ) As Long
#End If

#If VBA7 Then
  Private Declare PtrSafe Function ReleaseDC _
    Lib "user32" ( _
      ByVal hWnd As LongPtr _
    , ByVal hdc As LongPtr _
    ) As Long
#Else
  Private Declare Function ReleaseDC _
    Lib "user32" ( _
      ByVal hWnd As Long _
    , ByVal hdc As Long _
    ) As Long
#End If

#If VBA7 Then
  Private Declare PtrSafe Function GetDeviceCaps _
    Lib "gdi32" ( _
      ByVal hdc As LongPtr _
    , ByVal nIndex As Long _
    ) As Long
#Else
  Private Declare Function GetDeviceCaps _
    Lib "gdi32" ( _
      ByVal hdc As Long _
    , ByVal nIndex As Long _
    ) As Long
#End If
 
#If VBA7 Then
  Private Declare PtrSafe Function GetWindowRect _
    Lib "user32" ( _
      ByVal hWnd As LongPtr _
    , lpRect As winRECT _
    ) As Long
#Else
  Private Declare Function GetWindowRect _
    Lib "user32" ( _
      ByVal hWnd As Long _
    , lpRect As winRECT _
    ) As Long
#End If

#If VBA7 Then
  Private Declare PtrSafe Function FindWindowEx _
    Lib "user32" _
    Alias "FindWindowExA" ( _
      ByVal hWndParent As LongPtr _
    , ByVal hwndChildAfter As LongPtr _
    , ByVal lpszClass As String _
    , ByVal lpszWindow As String _
    ) As LongPtr
#Else
  Private Declare Function FindWindowEx _
    Lib "user32" _
    Alias "FindWindowExA" ( _
      ByVal hWndParent As Long _
    , ByVal hwndChildAfter As Long _
    , ByVal lpszClass As String _
    , ByVal lpszWindow As String _
    ) As Long
#End If

Private Function TwipsPerPixelX() As Double
  If dTwipsPerPixelX = 0 Then GetScreenMetrics
  TwipsPerPixelX = dTwipsPerPixelX
End Function

Private Function TwipsPerPixelY() As Double
  If dTwipsPerPixelY = 0 Then GetScreenMetrics
  TwipsPerPixelY = dTwipsPerPixelY
End Function

Private Sub GetScreenMetrics()
#If VBA7 Then
  Dim hdc As LongPtr
#Else
  Dim hdc As Long
#End If
  hdc = GetDC(0)
  dTwipsPerPixelX = nTwipsPerInch / GetDeviceCaps(hdc, LOGPIXELSX)
  dTwipsPerPixelY = nTwipsPerInch / GetDeviceCaps(hdc, LOGPIXELSY)
  Call ReleaseDC(0, hdc)
End Sub

Public Function GetRibbonHeight() As Long
' Return height of the Ribbon in twips
' Note that the result includes the QAT and the application title bar
#If VBA7 Then
  Dim hWnd As LongPtr
  Dim xRect As winRECT
  hWnd = FindWindowEx(hWndAccessApp, 0, "MsoCommandBarDock", "MsoDockTop")
  If hWnd <> 0 Then
    hWnd = FindWindowEx(hWnd, 0, "MsoCommandBar", "Ribbon")
  End If
  If hWnd = 0 Then
    MsgBox "Ribbon not found"
  Else
    If GetWindowRect(hWnd, xRect) = 0 Then
      MsgBox "Cannot determine Ribbon dimensions"
    Else
      With xRect
        GetRibbonHeight = (.Bottom - .Top) * TwipsPerPixelY
      End With
    End If
  End If
#Else
  ' pre-Access2007 - return 0
  GetRibbonHeight = 0
#End If
End Function

Public Function GetNavPaneWidth() As Long
' Return width of the Nav Pane in twips
#If VBA7 Then
  Dim hWnd As LongPtr
  Dim xRect As winRECT
  hWnd = FindWindowEx(hWndAccessApp, 0, "NetUINativeHWNDHost", "Navigation Pane Host")
  If hWnd = 0 Then
    MsgBox "Nav Pane not found"
  Else
    If GetWindowRect(hWnd, xRect) = 0 Then
      MsgBox "Cannot determine Nav Pane dimensions"
    Else
      With xRect
        GetNavPaneWidth = (.Right - .Left) * TwipsPerPixelX
      End With
    End If
  End If
#Else
  ' pre-Access2007 - return 0
  GetNavPaneWidth = 0
#End If
End Function
===================== end code =================================

From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, 27 August 2014 08:04
To:
MS_Access_Professionals@yahoogroups.com
Subject: RE: [MS_AccessPros] widths and heights

 

 

So glad you finally got it :-)

It's easy enough to change the API Declares to be 64-bit compatible.  I'll do that and post later.  Keep an eye on that spam folder :-)

Cheers,
Graham

 

From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Wednesday, 27 August 2014 07:28
To:
MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] widths and heights

It works, it works perfectly!

But I just had a bad thought.   A couple of the users are using 64 bit office, and I think you are using the 32 bit stuff.....

 

 

 

 

 

 

 

__._,_.___

Posted by: "Graham Mandeno" <graham@mandeno.com>
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (37)

.

__,_._,___

Tidak ada komentar:

Posting Komentar