访问 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
Access 2010 VBA API TWIPS/PIXEL
提问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 GetCursorPos
returns screen coordinates and Form.Move
assumes 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
Long
values, i.e. 32 bit integers. However, Office 2010 finally introducedLongPtr
(why notPointer
I don't know!), which should be used for declaring pointers and handles going forward since it maps to a 64 bitLongLong
in 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
HDC
parameter shown as typed toHDC
like 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
BOOL
type remains 32 bits long, along with the C/C++int
.Not important because you included it anyway, but the
PtrSafe
attribute in aDeclare
statement is just a marker to tell Office that you know what you are doing and can confirm theDeclare
statement is 64 bit compatible.
Windows API 充满了指针(指针是对事物的简单引用,而不是事物本身)和“句柄”(它们只是不透明的指针)。当以 Win32 为目标时,指针值为 32 位宽;为 Win64 编译时,64 位宽。传统上,VBA 没有指针类型,这迫使人们硬编码指针和
Long
值的句柄,即 32 位整数。但是,Office 2010 终于推出了LongPtr
(为什么Pointer
我不知道!),它应该用于声明指针和句柄,因为它映射到LongLong
64 位版本的 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 LongPtr
for values that aren't pointers or handles, and occasionally you wrongly use Long
when LongPtr
should be used:
就我个人而言,我会像下面这样清理你的 API 声明 - 你(不一致的)标识符重命名有点毫无意义,偶尔你错误地使用LongPtr
不是指针或句柄的值,偶尔你错误地使用Long
when LongPtr
should 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 Move
are 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