1

我正在转换一些非常旧的 VBA 代码以在 AutoCAD 2014 上运行。到目前为止，我已经转换了所有内容，但表单存在问题（它们是无模式的，需要激活回调来修改窗口属性）。以下是VBA6源代码：

在表格中：

Private Sub UserForm_Activate()
#If ACAD2000 = 0 Then
    If Not bPopup Then
        Call EnumWindows(AddressOf EnumWindowsProc, vbNull)
        Call SubClass
        bPopup = True
    End If
#End If
End Sub

模块（命名为 modModeLessFormFocus）：

Option Explicit

Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private ThisHwnd As Long
Public Const GWL_STYLE = -16
Public Const WS_POPUP = &H80000000

Function EnumWindowsProc(ByVal hwnd As Long, ByVal lParam As Long) As Integer

    Dim title As String * 32
    Call GetWindowText(hwnd, ByVal title, 32)
    If InStr(title, "About") Then
        ThisHwnd = hwnd
        EnumWindowsProc = False
    ElseIf InStr(title, "Preferences") Then
        ThisHwnd = hwnd
        EnumWindowsProc = False
    ElseIf InStr(title, "Display Block Attributes") Then
        ThisHwnd = hwnd
        EnumWindowsProc = False
    Else
        EnumWindowsProc = True
    End If
End Function

Public Function SubClass() As Long
    Dim Flags As Long
    Flags = GetWindowLong(ThisHwnd, GWL_STYLE)
    Flags = Flags Xor WS_POPUP
    SetWindowLong ThisHwnd, GWL_STYLE, Flags
End Function

运行时出现的错误是“AddressOf EnumWindowsProc”上的 UserForm_Activate 中的“类型不匹配”。我尝试使用 PtrSafe 和 PtrLong 将其转换为 64 位，但不可避免地会失败并且程序崩溃。

如果有人足够聪明地转换这一点或指出我正确的方向，我将非常感激。

谢谢

4

1 回答 1

2

我在http://www.jkp-ads.com/articles/apideclarations.asp找到了 64 位 VBA7 的 API

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    #End If
    Private Declare PtrSafe Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
                                      (ByVal hWnd As LongPtr, ByVal lpString As String, _
                                       ByVal cch As LongPtr) As Long

#Else
    Private Declare Function GetWindowLongPtr Lib "USER32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long 
    Private Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" _
                                      (ByVal hWnd As Long, ByVal lpString As String, _
                                       ByVal cch As Long) As Long
#End If

您还可以查看http://msdn.microsoft.com/en-us/library/aa383663(VS.85).aspx以获取更新的 API

于 2014-09-08T02:29:27.940 回答