Access 2010 VBA API TWIPS/PIXEL

Question

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 

양식 자체

내가 내 프로그래밍 기술이 특히 길고 longptr와 저글링 갖는, API 프로그래밍에 올 때 항복해야한다는 고백해야이

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 

처럼 열 수있다. 위의 코드는 다른 출처에서 수집 한 것입니다. 어떤 도움을 크게 당신이 계정에 GetCursorPos 반환 화면 좌표 Form.Move 메인 Access 창에 상대 좌표 가정 사실을 고려하지 않기 때문에 위치가 제대로 계산되지 않습니다 많은 감사

존

Answer 1

을

을 감사합니다 , 또는 더 정확하게는 해당 윈도우의 사용자 지정 (Windows 정의 아님) 클라이언트 영역입니다.

• 윈도우 API가와 '핸들'(단지 불투명 (포인터가 간단한 일을 참조하지 않는 것은 그 자체 인) 포인터의 가득 : 별도로, 코드는 LongPtr에 대한 혼란 비트도 포인터). Win32를 타겟팅 할 때 포인터 값은 32 비트입니다. 64 비트 폭의 Win64 용으로 컴파일 할 때. 전통적으로 VBA에는 포인터 유형이 없으므로 사람이 포인터를 하드 코드하여 Long 개의 값 즉 32 비트 정수로 처리해야했습니다. 그러나 Office 2010은 마침내 LongPtr을 도입했으며 (이는 Pointer을 알지 못합니다!) 64 비트 버전의 Office에서 64 비트 LongLong에 매핑되므로 포인터를 선언하고 앞으로 처리하는 데 사용해야합니다.

• 불행하게도 형식 정의/유형 별칭은 하지 그래도 추가, 그래서 당신처럼 HDC에 입력으로도 VBA의 최신 버전에서 그냥 (말) 표시되는 HDC 매개 변수를 다양한 API 유형을 선언 할 수 없습니다했다 C, C++ 또는 Delphi에서 사용합니다.

• 또 다른 사실은 Win32를 타겟팅 할 때 32 비트 너비가 모든 API 유형이 Win64를 타겟팅 할 때 64 비트가되지 않는다는 것입니다. 특히, BOOL 유형은 C/C++ int과 함께 32 비트 길이로 유지됩니다.

• 중요하지 않음 어쨌든 그것을 포함하지만, Declare 문에서 PtrSafe 속성은 당신이 무엇을하는지 아는와 Declare 문이 64 비트 호환 확인 할 수있는 사무실을 말할 그냥 마커이기 때문이다.때때로 당신이 잘못 포인터 나 핸들하지 않은 값 LongPtr를 사용 식별자의 당신 (일관성) 이름 변경이 조금 무의미하고, 가끔 -

개인적으로 나는 다음과 같이 당신의 API 선언을 정리할 것 잘못 LongPtr 사용해야하는 경우 Long를 사용

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 

을 이제 우리는 적절한 코드에 도착; 나는 이런 식으로 뭔가를 건의 할 것입니다 :

까다로운 일이 정확히 Move에 전달 된 좌표가 상대적 있어야 무엇 파악된다

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 

- 그냥 액세스 윈도우의 '클라이언트 영역'이 아니다의 API의 관점에서 보기 때문에 Access의 엉뚱한 용어로 양식의 현재 위치를보고 API 수준에서의 위치와 비교하여 문제를 파악해야합니다. 이것으로부터 우리는 새로운 위치를 적용 할 때 사용하는 오프셋을 얻습니다. 사용하려면

는로드 이벤트 핸들러는이 작업을 수행 할 필요가 : 이것에 대한

Private Sub Form_Load() 
    MoveFormToCursorPos Me 
End Sub