Fatal编程技术网
  • api/
  • Access 2010 VBA API TWIPS/像素

Access 2010 VBA API TWIPS/像素

api vba ms-access pointers

Access 2010 VBA API TWIPS/像素,api,vba,ms-access,pointers,Api,Vba,Ms Access,Pointers,关于API调用和32位和64位系统的TWIPS/像素问题的问题。 我想在鼠标指针的位置显示一个弹出窗体。我的解决方案是可行的（至少不会崩溃），但似乎无法计算正确的位置 'API Calls Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPtr Private Declare PtrSafe Function apiGetWindowRect Lib "user32"

关于API调用和32位和64位系统的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
表单本身将像这样打开

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
我必须承认，当涉及到API编程时，我的编程技能不得不放弃，特别是在必须处理long和longptr的情况下。上面的代码是从不同的来源收集的。非常感谢您的帮助

非常感谢

Jon

位置计算不正确，因为您没有考虑
GetCursorPos
返回屏幕坐标和
表单的事实。Move
假设坐标相对于主访问窗口，或者更准确地说，相对于该窗口的自定义（未定义窗口）客户端区域。另外，您的代码对
LongPtr
也有点困惑：

  • windowsapi中充满了指针（指针是对事物的简单引用，而不是事物本身）和“句柄”（它们只是不透明的指针）。以Win32为目标时，指针值为32位宽；为Win64编译时，64位宽。传统上，VBA没有指针类型，这迫使人们对
    Long
    值（即32位整数）的指针和句柄进行硬编码。然而，Office 2010最终引入了
    LongPtr
    （为什么不
    Pointer
    我不知道！），它应该用于声明指针和句柄，因为它映射到64位版本的Office中的64位
    LongPtr

    • >P>不幸的是，没有添加类型别名/类型别名，所以即使在最新版本的VBA中，也不能仅仅声明各种API类型，并表示（如）<代码> HDC < /C>参数，如“C代码”>“HDC”/代码>，如C、C++或Delphi中所示。p>
  • 另一件需要记住的事情是，并非每一种在以Win32为目标时为32位宽的API类型在以Win32为目标时都变为64位宽。特别是，
    BOOL
    类型与C/C++
    int
    保持32位的长度

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

就个人而言，我会像下面这样清理您的API声明-您（不一致）的标识符重命名有点毫无意义，有时您会错误地使用
LongPtr
来表示不是指针或句柄的值，有时您会错误地使用
Long
来表示应该使用
LongPtr
：

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
现在我们来看看代码本身；我建议这样做：

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
棘手的事情是弄清楚传递给
Move
的coords到底应该是相对于什么的-从API的角度来看，这不仅仅是访问窗口的“客户端区域”，因此，我们必须通过查看表单在Access古怪的backy术语中的当前位置，并将其与API级别的位置进行比较来解决问题。由此我们得到一个偏移量，我们在应用新位置时使用该偏移量

'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
要使用，加载事件处理程序只需执行以下操作：

Private Sub Form_Load()
  MoveFormToCursorPos Me
End Sub
位置计算不正确，因为您没有考虑到
GetCursorPos
返回屏幕坐标和
表单的事实。Move
假设坐标相对于主访问窗口，或者更准确地说，相对于该窗口的自定义（未定义窗口）客户端区域。另外，您的代码对
LongPtr
也有点困惑：

  • windowsapi中充满了指针（指针是对事物的简单引用，而不是事物本身）和“句柄”（它们只是不透明的指针）。以Win32为目标时，指针值为32位宽；为Win64编译时，64位宽。传统上，VBA没有指针类型，这迫使人们对
    Long
    值（即32位整数）的指针和句柄进行硬编码。然而，Office 2010最终引入了
    LongPtr
    （为什么不
    Pointer
    我不知道！），它应该用于声明指针和句柄，因为它映射到64位版本的Office中的64位
    LongPtr

    • >P>不幸的是，没有添加类型别名/类型别名，所以即使在最新版本的VBA中，也不能仅仅声明各种API类型，并表示（如）<代码> HDC < /C>参数，如“C代码”>“HDC”/代码>，如C、C++或Delphi中所示。p>
  • 另一件需要记住的事情是，并非每一种在以Win32为目标时为32位宽的API类型在以Win32为目标时都变为64位宽。特别是，
    BOOL
    类型与C/C++
    int
    保持32位的长度

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

就个人而言，我会像下面这样清理您的API声明-您（不一致）的标识符重命名有点毫无意义，有时您会错误地使用
LongPtr
来表示不是指针或句柄的值，有时您会错误地使用
Long
来表示应该使用
LongPtr
：

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
现在我们来看看代码本身；我建议这样做：

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
棘手的事情是要弄清楚传递给
Move
的coords到底应该是相对于什么的-从API的角度来看，它不仅仅是访问窗口的“客户端区域”，所以我们必须通过查看表单在Access“古怪的backy术语”中的当前位置并将其与API l中的位置进行比较来弄清楚