Quantcast
Channel: Microsoft Access Forum
Viewing all articles
Browse latest Browse all 880

Typenunverträglichkeit bei Umstellung auf 64bit

$
0
0

Hallo

wir haben einen Access-Applikation die auf 32bit und 64bit Systemen laufen, bis auf eine Typenunverträglichkeit und ich weiß nicht, was ich da noch ändern könnte. Hier ist das Modul (die Fehlerzeile habe ich fett markiert, ziemlich weit unten).

Option Compare Database
Option Explicit

Private Const WM_COMMAND = &H111
Private Const WM_LBUTTONUP = &H202

Private Const MF_SEPARATOR = &H800&
Private Const MF_ENABLED = &H0&
Private Const MF_GRAYED = &H1&
Private Const MF_CHECKED = &H8&
Private Const MF_MENUBARBREAK = &H20&

Private Const TPM_LEFTALIGN = &H0&

'---API-Strukturen
'---API-Deklarationen
'--- 64bit Änderung


#If Win64 Then

Type tPoint
    lngX       As LongPtr
    lngY       As LongPtr
End Type

Type tRect
    lngLeft    As LongPtr
    lngTop     As LongPtr
    lngRight   As LongPtr
    lngBottom  As LongPtr
End Type

Type tMsg
    hWnd       As LongPtr
    lngMessage As LongPtr
    lngWParam  As LongPtr
    lngLParam  As LongPtr
    lngTime    As LongPtr
    tP         As tPoint
End Type

Declare PtrSafe Function CreatePopupMenu Lib "user32" () As LongPtr
Declare PtrSafe Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu _
        As LongPtr, ByVal wFlags As LongPtr, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As _
        String) As LongPtr
Declare PtrSafe Function DestroyMenu Lib "user32" (ByVal hMenu As LongPtr) As LongPtr
Declare PtrSafe Function TrackPopUpMenu Lib "user32" Alias "TrackPopupMenu" (ByVal _
        hMenu As LongPtr, ByVal wFlags As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr, _
        ByVal nReserved As LongPtr, ByVal hWnd As LongPtr, lprc As tRect) As LongPtr
Declare PtrSafe Function getMessage Lib "user32" Alias "GetMessageA" (lpMsg As tMsg, _
        ByVal hWnd As LongPtr, ByVal wMsgFilterMin As LongPtr, ByVal wMsgFilterMax As _
        LongPtr) As LongPtr
Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As tPoint) As LongPtr

#Else

Type tPoint
    lngX       As Long
    lngY       As Long
End Type

Type tRect
    lngLeft    As Long
    lngTop     As Long
    lngRight   As Long
    lngBottom  As Long
End Type

Type tMsg
    hWnd       As Long
    lngMessage As Long
    lngWParam  As Long
    lngLParam  As Long
    lngTime    As Long
    tP         As tPoint
End Type

Declare Function CreatePopupMenu Lib "user32" () As Long
Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu _
        As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As _
        String) As Long
Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Declare Function TrackPopUpMenu Lib "user32" Alias "TrackPopupMenu" (ByVal _
        hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, _
        ByVal nReserved As Long, ByVal hWnd As Long, lprc As tRect) As Long
Declare Function getMessage Lib "user32" Alias "GetMessageA" (lpMsg As tMsg, _
        ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As _
        Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As tPoint) As Long


#End If

Function DoPopup(strEntries As String, Optional bolOnForm As Boolean = _
         True) As Integer

    If HANDLE_ERRORS Then On Error GoTo DoPopup_Error
    PushCallStack "DoPopup"
    #If Win64 Then
        Dim lngMenu As LongPtr, hWnd As LongPtr, strX As String
    #Else
        Dim lngMenu As Long, hWnd As Long, strX As String
    #End If
        Dim intCnt As Integer
        Dim tCurrPos As tPoint, tRect As tRect, tMsg As tMsg
        Dim varResult As Variant
    intCnt = 1
    lngMenu = CreatePopupMenu()
    If Right$(strEntries, 1) <> "|" Then strEntries = strEntries + "|"
    While strEntries <> ""
        strX = Left$(strEntries, InStr(strEntries, "|") - 1)
        strEntries = Mid$(strEntries, InStr(strEntries, "|") + 1)
        If strX = "=" Then                        'Separator...
            varResult = AppendMenu(lngMenu, MF_SEPARATOR, 0, "")
        ElseIf Left$(strX, 1) = ">" Then          'Neue Spalte...
            strX = Mid$(strX, 2)
            varResult = AppendMenu(lngMenu, MF_MENUBARBREAK, intCnt, strX)
            intCnt = intCnt + 1
        ElseIf Left$(strX, 1) = "~" Then          'Deaktiviert...
            strX = Mid$(strX, 2)
            varResult = AppendMenu(lngMenu, MF_GRAYED, intCnt, strX)
            intCnt = intCnt + 1
        ElseIf Left$(strX, 1) = "+" Then          'Mit Häkchen...
            strX = Mid$(strX, 2)
            varResult = AppendMenu(lngMenu, MF_ENABLED + MF_CHECKED, intCnt, _
                        strX)
            intCnt = intCnt + 1
        Else                                      'Normaler Eintrag...
            varResult = AppendMenu(lngMenu, MF_ENABLED, intCnt, strX)
            intCnt = intCnt + 1
        End If
    Wend
    GetCursorPos tCurrPos                         ' Aktuelle Cursorposition
    If bolOnForm Then
        hWnd = Screen.ActiveForm.hWnd             'Handle auf das Formular
    Else
        hWnd = Application.hWndAccessApp
    End If
    varResult = TrackPopUpMenu(lngMenu, TPM_LEFTALIGN, tCurrPos.lngX, _
                tCurrPos.lngY, 0, hWnd, tRect)
    varResult = getMessage(tMsg, hWnd, WM_COMMAND, WM_LBUTTONUP)
    If tMsg.lngMessage = WM_COMMAND Then DoPopup = tMsg.lngWParam ' ------------------------------ Type-Fehler unverträglich bei bit64
    Else
        DoPopup = 0
    End If
    varResult = DestroyMenu(lngMenu)
ErrorHandlerDoPopupExit:
    PopCallStack
    Exit Function
DoPopup_Error:
    If Err.Number = 3146 Then
        OdbcErrHandler DBEngine.Errors(0), Err.description, "DoPopup", _"modPopup", True
    Else
        GlobalErrHandler Err.Number, Err.description, "DoPopup", "modPopup", _
                         True
    End If
    Resume ErrorHandlerDoPopupExit
End Function

und hier ist der Aufruf

Private Sub aufrufPopup_Click()

    Dim strPop As String

    #If Win64 Then        
        Dim lngRet As LongPtr
    #Else
        Dim lngRet As Long        
    #End If
 
    strPop = "test 1|test 2|test 3|..."
    ' Starte das Menü
    lngRet = DoPopup(strPop)
    Select Case lngRet
        Case 1
       [...]
        Case Else
            Exit Sub
End Select

Hat jemand Lust, mal darüber zu schauen?

Lieben Dank im voraus. 


Liebe Grüße, die Luzie!


Viewing all articles
Browse latest Browse all 880


<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>