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 の「Type Mismatch」です。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

更新された API については、http://msdn.microsoft.com/en-us/library/aa383663 (VS.85).aspx を参照することもできます。

于 2014-09-08T02:29:27.940 に答える