PROSAGA码农传奇-visio-获取Visio应用程序的窗口位置

<div class =“post-text”itemprop =“text”>
  
    由于我假设在许多其他项目中使用它，我创建了一个包含所有代码的类。该类现在以32位工作，主要是因为我找不到从Visio应用程序对象获取64位句柄的方法。
  
  
    由于使用了代码本身是64位准备
     <code>
 LongPtr
 </code>
     类型。更多信息：
    <a href="https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit" rel="nofollow noreferrer">
      https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit
    </A>
     
    
声明应该可以工作，因为它们是在64位环境中重新创建的。
  
  
    该类公开了13个属性，其中12个是窗口位置和大小，一个是句柄，这允许用户定位不同的窗口而不是应用程序。这可以用于相对于在“Main”应用程序内打开的窗口定位Userform。
  
  
    Office UserForms（出于某种原因）使用Points而不是Pixels将自己定位在屏幕上，为此我也建立了一个转换为类。
  
  
    还有一些我想要改变的东西，比如添加正确的错误处理，并且可能给类一个默认的实例，但是现在这是可用的。
  
  <HR />
  
    的
      资源
    </强>
  
  
    <a href="http://officeoneonline.com/vba/positioning_using_pixels.html" rel="nofollow noreferrer">
      http://officeoneonline.com/vba/positioning_using_pixels.html
    </A>
  
  
    <a href="http://www.vbforums.com/showthread.php?436888-Get-Set-Window-Size-Position" rel="nofollow noreferrer">
      http://www.vbforums.com/showthread.php?436888-Get-Set-Window-Size-Position
    </A>
  
  <HR />
  
    的
      说明
    </强>
  
  
    这个模块/类会发生什么？
  
  <UL>
    <LI>
      该类处理与Windows API的交互
    </LI>
    <LI>
      它创造了一个
       <code>
 Private Type Rect
 </code>
      ，使用的
       <code>
 GetWindowRect
 </code>
       功能。
    </LI>
    <LI>
      它宣布了
       <code>
 GetWindowRect
 </code>
       函数，取窗口的窗口句柄（显然）并返回“大纲”的位置
      的
        像素
      </强>
    </LI>
    <LI>
      初始化对象时，它会自动存储调用它的应用程序的窗口句柄
       <code>
 this.Handle
 </code>
    </LI>
    <LI>
      当得到其中一个
       <code>
 px__
 </code>
       属性它只是更新窗口位置
       <code>
 this.rc
 </code>
       并返回所需的值。
    </LI>
    <LI>
      上车的时候
       <code>
 pt__
 </code>
       属性它更新窗口位置并计算点的等效值，这是有用的，因为VBA Userforms实际上使用点进行定位。描述了转换
      <a href="http://officeoneonline.com/vba/positioning_using_pixels.html" rel="nofollow noreferrer">
        这里
      </A>
      。
    </LI>
    <LI>
      可以通过设置来更改窗口句柄
       <code>
 Handle
 </code>
       属性，这提供了一些更大的灵活性，例如当打开同一应用程序的多个窗口时。
    </LI>
  </UL>
  <HR />
  
    的
      码
    </强>
  
  
    a模块（模块）
  
   <pre>
 <code>
 Sub openFooUserForm()

Dim winPo As WindowPositioner
    Set winPo = New WindowPositioner

Dim fooUF As FooUserForm
    Set fooUF = New FooUserForm

fooUF.StartUpPosition = 0
    fooUF.Top = winPo.ptTop + 100
    fooUF.Left = winPo.ptLeft + 50

fooUF.Show

Set fooUF = Nothing

End Sub

</code>
 </pre>
  
    WindowPositioner（类）
  
   <pre>
 <code>
 Option Explicit

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

Private Type TWindowPositioner
    Handle As LongPtr
    rc As RECT
End Type

Private this As TWindowPositioner

Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const TWIPSPERINCH = 1440

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long

Private Sub Class_Initialize()
#If WIN64 THEN
   'this.Handle = 'Method to get the 64-bit Handle of the Application Object
#Else
    this.Handle = ThisDocument.Application.WindowHandle32
#End If
    this.rc.Left = 0
    this.rc.Top = 0
    this.rc.Right = 0
    this.rc.Bottom = 0
End Sub

Public Property Get Handle() As LongPtr
    Handle = this.Handle
End Property

Public Property Let Handle(val As LongPtr)
    this.Handle = val
End Property

Public Property Get pxTop() As Long
    UpdatePosition
    pxTop = this.rc.Top
End Property

Public Property Get pxLeft() As Long
    UpdatePosition
    pxLeft = this.rc.Left
End Property

Public Property Get pxBottom() As Long
    UpdatePosition
    pxBottom = this.rc.Bottom
End Property

Public Property Get pxRight() As Long
    UpdatePosition
    pxRight = this.rc.Right
End Property

Public Property Get pxHeight() As Long
    UpdatePosition
    pxHeight = this.rc.Bottom - this.rc.Top
End Property

Public Property Get pxWidth() As Long
    UpdatePosition
    pxWidth = this.rc.Left - this.rc.Right
End Property

Public Property Get ptTop() As Long
    ptTop = CPxToPtY(pxTop)
End Property

Public Property Get ptLeft() As Long
    ptLeft = CPxToPtX(pxLeft)
End Property

Public Property Get ptBottom() As Long
    ptBottom = CPxToPtY(pxBottom)
End Property

Public Property Get ptRight() As Long
    ptRight = CPxToPtX(pxRight)
End Property

Public Property Get ptHeight() As Long
    ptHeight = CPxToPtY(pxBottom) - CPxToPtY(pxTop)
End Property

Public Property Get ptWidth() As Long
    ptWidth = CPxToPtX(pxRight) - CPxToPtX(pxLeft)
End Property

Private Sub UpdatePosition()
    GetWindowRect this.Handle, this.rc
End Sub

Private Function CPxToPtX(ByRef val As Long) As Long
    Dim hDC As LongPtr
    Dim RetVal As Long
    Dim XPixelsPerInch As Long

hDC = GetDC(0)
    XPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
    RetVal = ReleaseDC(0, hDC)

CPxToPtX = CLng(val * TWIPSPERINCH / 20 / XPixelsPerInch)
End Function

Private Function CPxToPtY(ByRef val As Long) As Long
    Dim hDC As LongPtr
    Dim RetVal As Long
    Dim YPixelsPerInch As Long

hDC = GetDC(0)
    YPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY)
    RetVal = ReleaseDC(0, hDC)

CPxToPtY = CLng(val * TWIPSPERINCH / 20 / YPixelsPerInch)
End Function

</code>
 </pre>
</DIV>