访问 2010 VBA API TWIPS/PIXEL

声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow 原文地址: http://stackoverflow.com/questions/23042374/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me): StackOverFlow

提示:将鼠标放在中文语句上可以显示对应的英文。显示中英文
时间:2020-09-12 02:45:21  来源:igfitidea点击:

Access 2010 VBA API TWIPS/PIXEL

apivbams-accesspointers

提问by JonBlumfeld

a question regarding API calls and the TWIPS/pixel problem working for 32- and 64-bit systems. I want a popup-form to show up at the mouse pointer's position. My solution kind of works (at least without crashing) but doesn't seem to calculate the correct position.

关于适用于 32 位和 64 位系统的 API 调用和 TWIPS/像素问题的问题。我想要一个弹出窗体显示在鼠标指针的位置。我的解决方案有效(至少不会崩溃),但似乎没有计算出正确的位置。

'API Calls
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPtr

Private Declare PtrSafe Function apiGetWindowRect Lib "user32" Alias "GetWindowRect" (ByVal hWnd As Long, lpRect As RECT_Type) As LongPtr

Private Declare PtrSafe Function apiGetDC Lib "user32" Alias "GetDC" (ByVal hWnd As Long) As LongPtr

Private Declare PtrSafe Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" (ByVal hDC As LongPtr, ByVal nIndex As Long) As LongPtr

Private Declare PtrSafe Function apiReleaseDC Lib "user32" Alias "ReleaseDC" (ByVal hWnd As Long, ByVal hDC As LongPtr) As LongPtr

Private Const TWIPSPERINCH = 1440
Private Const WU_LOGPIXELSX = 88
Private Const WU_LOGPIXELSY = 90

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Type RECT_Type
    left As Long
    top As Long
    right As Long
    bottom As Long
 End Type

Public Function GetXCursorPos() As Long
    Dim pt As POINTAPI
    GetCursorPos pt
    GetXCursorPos = CLng(pt.X)
End Function

Public Function GetYCursorPos() As Long
    Dim pt As POINTAPI
    GetCursorPos pt
    GetYCursorPos = pt.Y
End Function

Public Function ConvertPIXELSToTWIPS(lPixel As Long, _
                                 lDirection As Long) As Long

    Dim hDC As LongPtr
    Dim hWnd As Long
    Dim RetVal As LongPtr
    Dim PIXELSPERINCH

    hDC = apiGetDC(0)

    ' Horizontal
    If (lDirection = 0) Then
        PIXELSPERINCH = apiGetDeviceCaps(hDC, WU_LOGPIXELSX)
    ' Vertical
    Else
        PIXELSPERINCH = apiGetDeviceCaps(hDC, WU_LOGPIXELSY)
    End If

    RetVal = apiReleaseDC(0, hDC)

    ConvertPIXELSToTWIPS = (lPixel / PIXELSPERINCH) * TWIPSPERINCH

End Function

Function ConvertTwipsToPixels(lTwips As Long, _
                          lDirection As Long) As Long

    Dim lDC As LongPtr
    Dim lPixelsPerInch As LongPtr

    lDC = apiGetDC(0)

    ' Horizontal
    If (lDirection = 0) Then
        lPixelsPerInch = apiGetDeviceCaps(lDC, WU_LOGPIXELSX)
    ' Vertical
    Else
        lPixelsPerInch = apiGetDeviceCaps(lDC, WU_LOGPIXELSY)
    End If

    lDC = apiReleaseDC(0, lDC)

    ConvertTwipsToPixels = (lTwips / TWIPSPERINCH) * lPixelsPerInch

End Function

The form itself would be opened like this

表单本身会像这样打开

Private Sub Form_Load()
    Dim lWidthPixel As Long
    Dim lHeightPixel As Long

    Dim lWidthTwips As Long
    Dim lHeightTwips As Long

    lWidthPixel = modAPI.GetXCursorPos
    lHeightPixel = modAPI.GetYCursorPos

    lWidthTwips = ConvertPIXELSToTWIPS(lWidthPixel, 0)
    lHeightTwips = ConvertPIXELSToTWIPS(lHeightPixel, 1)
    Me.Move left:=lWidthTwips, top:=lHeightTwips
 End Sub

I must confess that my programming skill have to surrender when it comes to API programming, especially with having to juggle with long and longptr. The code above is gathered from different sources. Any help is greatly appreciated

我必须承认,当涉及到 API 编程时,我的编程技巧不得不放弃,尤其是在处理 long 和 longptr 时。上面的代码是从不同来源收集的。任何帮助是极大的赞赏

Many thanks

非常感谢

Jon

乔恩

回答by Chris Rolliston

The position isn't calculated correctly because you are not taking into account the fact GetCursorPosreturns screen coordinates and Form.Moveassumes coordinates relative to the main Access window, or more exactly, a custom (not Windows-defined) client area of that window. Separately, your code is also a bit confused about LongPtr:

位置计算不正确,因为您没有考虑GetCursorPos返回屏幕坐标的事实,并Form.Move假设相对于主 Access 窗口的坐标,或者更准确地说,是该窗口的自定义(非 Windows 定义)客户区。另外,您的代码也有点困惑LongPtr

  • The Windows API is full of pointers (a pointer being a simple reference to a thing not the thing itself) and 'handles' (which are just opaque pointers). When targeting Win32, pointer values are 32 bits wide; when compiling for Win64, 64 bits wide. Traditionally VBA did not have a pointer type, which forced people to hardcode pointers and handles to Longvalues, i.e. 32 bit integers. However, Office 2010 finally introduced LongPtr(why not PointerI don't know!), which should be used for declaring pointers and handles going forward since it maps to a 64 bit LongLongin a 64 bit version of Office.

  • Unfortunately typedefs/type aliases were notadded though, so even in the latest versions of VBA you can't just declare the various API types and have (say) a HDCparameter shown as typed to HDClike you would in C, C++ or Delphi.

  • Another thing to keep in mind is that not every API type that is 32 bits wide when targeting Win32 becomes 64 bits wide when targeting Win64. In particular, the BOOLtype remains 32 bits long, along with the C/C++ int.

  • Not important because you included it anyway, but the PtrSafeattribute in a Declarestatement is just a marker to tell Office that you know what you are doing and can confirm the Declarestatement is 64 bit compatible.

  • Windows API 充满了指针(指针是对事物的简单引用,而不是事物本身)和“句柄”(它们只是不透明的指针)。当以 Win32 为目标时,指针值为 32 位宽;为 Win64 编译时,64 位宽。传统上,VBA 没有指针类型,这迫使人们硬编码指针和Long值的句柄,即 32 位整数。但是,Office 2010 终于推出了LongPtr(为什么Pointer我不知道!),它应该用于声明指针和句柄,因为它映射到LongLong64 位版本的 Office 中的 64 位。

  • 不幸的是,虽然没有添加typedefs/type 别名,所以即使在最新版本的 VBA 中,您也不能只声明各种 API 类型,并且(比如说)一个HDC参数显示为类型,HDC就像在 C、C++ 或 Delphi 中一样。

  • 要记住的另一件事是,并非所有面向 Win32 时 32 位宽的 API 类型在面向 Win64 时都变成 64 位宽。特别是,该BOOL类型与 C/C++ 一起保持 32 位长int

  • 并不重要,因为您无论如何都包含了它,但是语句中的PtrSafe属性Declare只是一个标记,用于告诉 Office 您知道自己在做什么并且可以确认该Declare语句与 64 位兼容。

Personally I'd clean your API declarations up like the following - your (inconsistent) renaming of identifiers is a bit pointless, occasionally you wrongly use LongPtrfor values that aren't pointers or handles, and occasionally you wrongly use Longwhen LongPtrshould be used:

就我个人而言,我会像下面这样清理你的 API 声明 - 你(不一致的)标识符重命名有点毫无意义,偶尔你错误地使用LongPtr不是指针或句柄的值,偶尔你错误地使用Longwhen LongPtrshould be used:

Private Declare PtrSafe Function GetCursorPos Lib "user32" ( _
  ByRef lpPoint As POINT) As Long ' returns a BOOL

Private Declare PtrSafe Function GetWindowRect Lib "user32" ( _
  ByVal hWnd As LongPtr, ByRef lpRect As RECT) As Long ' returns a BOOL

Private Declare PtrSafe Function GetDC Lib "user32" ( _
  ByVal hWnd As LongPtr) As LongPtr ' returns a HDC - Handle to a Device Context

Private Declare PtrSafe Function GetDeviceCaps Lib "gdi32" ( _
  ByVal hDC As LongPtr, ByVal nIndex As Long) As Long ' returns a C/C++ int

Private Declare PtrSafe Function ReleaseDC Lib "user32" ( _
  ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long ' also returns an int

Private Const LOGPIXELSX = 88 ' sticking to the original names is less confusing IMO
Private Const LOGPIXELSY = 90 ' ditto

Private Const TwipsPerInch = 1440

Type POINT
  X As Long
  Y As Long
End Type

Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type

Now we get to the code proper; I'd suggest something like this:

现在我们进入正确的代码;我会建议这样的事情:

Function PixelsToTwips(ByVal X As Long, ByVal Y As Long) As POINT
  Dim ScreenDC As LongPtr
  ScreenDC = GetDC(0)
  PixelsToTwips.X = X / GetDeviceCaps(ScreenDC, LOGPIXELSX) * TwipsPerInch
  PixelsToTwips.Y = Y / GetDeviceCaps(ScreenDC, LOGPIXELSY) * TwipsPerInch
  ReleaseDC 0, ScreenDC
End Function

Function TwipsToPixels(ByVal X As Long, ByVal Y As Long) As POINT
  Dim ScreenDC As LongPtr
  ScreenDC = GetDC(0)
  TwipsToPixels.X = X / TwipsPerInch * GetDeviceCaps(ScreenDC, LOGPIXELSX)
  TwipsToPixels.Y = Y / TwipsPerInch * GetDeviceCaps(ScreenDC, LOGPIXELSY)
  ReleaseDC 0, ScreenDC
End Function

Sub MoveFormToScreenPixelPos(Form As Access.Form, PixelX As Long, PixelY As Long)
  Dim FormWR As RECT, AccessWR As RECT, Offset As POINT, NewPos As POINT
  ' firstly need to calculate what the coords passed to Move are relative to
  GetWindowRect Application.hWndAccessApp, AccessWR
  GetWindowRect Form.hWnd, FormWR
  Offset = PixelsToTwips(FormWR.Left - AccessWR.Left, FormWR.Top - AccessWR.Top)
  Offset.X = Offset.X - Form.WindowLeft
  Offset.Y = Offset.Y - Form.WindowTop
  ' next convert our desired position to twips and set it
  NewPos = PixelsToTwips(PixelX - AccessWR.Left, PixelY - AccessWR.Top)
  Form.Move NewPos.X - Offset.X, NewPos.Y - Offset.Y
End Sub

Sub MoveFormToCursorPos(Form As Access.Form)
  Dim Pos As POINT
  GetCursorPos Pos
  MoveFormToScreenPixelPos Form, Pos.X, Pos.Y
End Sub

The tricky thing is figuring out what exactly the coords passed to Moveare supposed to be relative to - it's not just the Access window's 'client area' from the API's point of view, so we have to figure things out by looking at the form's current position in Access' wacky-backy terms and comparing it with its position at the API level. From this we get an offset which we use when applying the new position.

棘手的事情是弄清楚传递给的坐标Move应该是相对于什么的——从 API 的角度来看,这不仅仅是访问窗口的“客户区”,所以我们必须通过查看表单的当前位置来弄清楚在 Access 的古怪术语中,并将其与其在 API 级别的位置进行比较。由此我们得到一个偏移量,我们在应用新位置时使用该偏移量。

To use, the Load event handler just needs to do this:

要使用,Load 事件处理程序只需要执行以下操作:

Private Sub Form_Load()
  MoveFormToCursorPos Me
End Sub