How can I make this 32bit Function runs in both 32bit and 64bit? (1 Viewer)

E

ebbsamsung

Registered User.
Local time
Today, 02:34
Joined
May 22, 2014
Messages
19
Sir,

Here I am again for this problem, I adapted a code running in 32bit MS Access but now I faced this problem if possible to make this code runs in both 32bit and 64bit when they use this database. Is is possible like this?
If 64bit run this code else32bit run this code. How can I make it proper if its possible? Could you please help me?:eek:

Thank you in advance!

Here is the code:
Code: 
Option Compare Database
Option Explicit

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long

Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
Dim lIcon As Long
Dim lResult As Long
Dim X As Long, Y As Long

X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)

End Function
 
isladogs

isladogs

MVP / VIP
Local time
Today, 10:34
Joined
Jan 14, 2017
Messages
18,209
You need to do conditional compiling which will detect the 'bitness' and use the appropriate code.
You will need to modify the three declaration lines & possibly the hwnd As Long argument in your function
I'm typing this on a tablet so can't modify your code easily.

However there's a very good guide to conditional compilation at Phillip Stiefel's website: http://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit

The site is in both German & English & has many very informative articles - well worth a read
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 17:34
Joined
May 7, 2009
Messages
19,232
This is possible if your form is pop up
Code: 
Option Compare Database
Option Explicit


Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    #Else
        Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    #End If
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
#If Win64 Then
    Public Function SetFormIcon(hWnd As LongPtr, strIconPath As String) As Boolean
    Dim lIcon As LongPtr
    Dim lResult As LongPtr
#Else
    Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
    Dim lIcon As Long
    Dim lResult As Long
#End If
Dim X As Long, Y As Long

X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)

End Function
 
isladogs

isladogs

MVP / VIP
Local time
Today, 10:34
Joined
Jan 14, 2017
Messages
18,209
Is the purpose of this code to set a specific icon for your forms?
If so, it can be done without code from Access Options ... Current Database
 
E

ebbsamsung

Registered User.
Local time
Today, 02:34
Joined
May 22, 2014
Messages
19
Sir Arnelgp,

I used the code but during compiling it marked red this part but no error occur. Please check sir arnel for me whats wrong.

Code: 
Option Compare Database
Option Explicit


Private Const WM_SETICON = &H80
Private Const IMAGE_ICON = 1
Private Const LR_LOADFROMFILE = &H10
Private Const SM_CXSMICON As Long = 49
Private Const SM_CYSMICON As Long = 50

#If VBA7 Then
    #If Win64 Then
        Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As LongPtr, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As LongPtr
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    #Else
        Private Declare PtrSafe Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
        Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    #End If
    Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
    Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
#End If
#If Win64 Then
    Public Function SetFormIcon(hWnd As LongPtr, strIconPath As String) As Boolean
    Dim lIcon As LongPtr
    Dim lResult As LongPtr
#Else
    Public Function SetFormIcon(hWnd As Long, strIconPath As String) As Boolean
    Dim lIcon As Long
    Dim lResult As Long
#End If
Dim X As Long, Y As Long

X = GetSystemMetrics(SM_CXSMICON)
Y = GetSystemMetrics(SM_CYSMICON)
lIcon = LoadImage(0, strIconPath, 1, X, Y, LR_LOADFROMFILE)
lResult = SendMessage(hWnd, WM_SETICON, 0, ByVal lIcon)

End Function

Red Mark but no error line:

Code: 
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
    Private Declare Function LoadImage Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal un1 As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal un2 As Long) As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 17:34
Joined
May 7, 2009
Messages
19,232
Dont worry about the red ones it is ok since you are using x64 office.
 
E

ebbsamsung

Registered User.
Local time
Today, 02:34
Joined
May 22, 2014
Messages
19
Sir Arnelgp,

Thank you very much.....Actually, I am already finished simple db using 32bit Office and not considering the 64bit Office users. Then suddenly I was bumped into this when i try to run in another pc or laptop, then there it happened that they were using 64bit.

I have 3 modules affected by this 64 bit and I am planning to post it here all hoping the AWF admin and other experts here allow me and they will give me solution like yours since I am really a novice for this.

Sorry AWF admin and experts for my post, I am only looking some help by experts.

Thank you in advance experts!

Here are the functions affected by 64bit:

1)
Code: 
Private Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
Dim dwReturn As Long

Const SW_HIDE = 0
Const SW_SHOWNORMAL = 1
Const SW_SHOWMINIMIZED = 2
Const SW_SHOWMAXIMIZED = 3

Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, _
     ByVal nCmdShow As Long) As Long
     
Public Function fSetAccessWindow(Optional Procedure As String, Optional SwitchStatus As Boolean, Optional StatusCheck As Boolean) As Boolean
If Procedure = "Hide" Then
    dwReturn = ShowWindow(Application.hWndAccessApp, SW_HIDE)
End If
If Procedure = "Show" Then
    dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMAXIMIZED)
End If
If Procedure = "Minimize" Then
    dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMINIMIZED)
End If
If SwitchStatus = True Then
    If IsWindowVisible(hWndAccessApp) = 1 Then
        dwReturn = ShowWindow(Application.hWndAccessApp, SW_HIDE)
    Else
        dwReturn = ShowWindow(Application.hWndAccessApp, SW_SHOWMAXIMIZED)
    End If
End If
If StatusCheck = True Then
    If IsWindowVisible(hWndAccessApp) = 0 Then
        fSetAccessWindow = False
    End If
    If IsWindowVisible(hWndAccessApp) = 1 Then
        fSetAccessWindow = True
    End If
End If
End Function

2)
Code: 
Option Compare Database
Option Explicit

Dim fso As Object

 Private Declare Function apiShellExecute Lib "shell32.dll" _
        Alias "ShellExecuteA" _
        (ByVal hWnd As Long, _
        ByVal lpOperation As String, _
        ByVal lpFile As String, _
        ByVal lpParameters As String, _
        ByVal lpDirectory As String, _
        ByVal nShowCmd As Long) _
        As Long

Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 2            'Open Maximized
Public Const WIN_MIN = 3            'Open Minimized

Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&


'---------------------------------------------------

Function fHandleFile(stFile As String, lShowHow As Long)

On Error GoTo Err_Handler

Dim lRet As Long, varTaskID As Variant
Dim stRet As String
    'First try ShellExecute
    lRet = apiShellExecute(hWndAccessApp, vbNullString, _
            stFile, vbNullString, vbNullString, lShowHow)
            
    If lRet > ERROR_SUCCESS Then
        stRet = vbNullString
        lRet = -1
    Else
        Select Case lRet
            Case ERROR_NO_ASSOC:
                'Try the OpenWith dialog
                varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _
                        & stFile, WIN_NORMAL)
                lRet = (varTaskID <> 0)
            Case ERROR_OUT_OF_MEM:
                stRet = "Error: Out of Memory/Resources. Couldn't Execute!"
            Case ERROR_FILE_NOT_FOUND:
                stRet = "Error: File not found.  Couldn't Execute!"
            Case ERROR_PATH_NOT_FOUND:
                stRet = "Error: Path not found. Couldn't Execute!"
            Case ERROR_BAD_FORMAT:
                stRet = "Error:  Bad File Format. Couldn't Execute!"
            Case Else:
        End Select
    End If
    
    fHandleFile = lRet & _
                IIf(stRet = "", vbNullString, ", " & stRet)
                
Exit_Handler:
    Exit Function
    
Err_Handler:
    MsgBox "Error " & Err.Number & " in fHandleFile procedure : " & Err.Description, vbOKOnly + vbCritical
    Resume Exit_Handler

End Function
 
isladogs

isladogs

MVP / VIP
Local time
Today, 10:34
Joined
Jan 14, 2017
Messages
18,209
Please study the information Phillip Stiefel's website using the link that I gave in post #2
That way you can learn how to solve issues with 64-bit compatibility for yourself

Also did you notice my question in post #4
 
E

ebbsamsung

Registered User.
Local time
Today, 02:34
Joined
May 22, 2014
Messages
19
Sir Ridders,

Thank you so much sir for your reply, I will definitely study when i leave this company by the end of the month. I am very sorry, I was in hurry to finished the simple db to be given to my boss before leaving.

Have a nice day!
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 17:34
Joined
May 7, 2009
Messages
19,232
This is the conversion
 

Attachments

  • Converted.zip
    23.3 KB · Views: 182
E

ebbsamsung

Registered User.
Local time
Today, 02:34
Joined
May 22, 2014
Messages
19
Sir Arnelgp,

A million thanks sir arnelgp, it helps me alot....I can now sleep well tonight.:):):). I can now relax for few days before I leave the company.

To sir ridders and the other experts in this forum, THANK YOU SO MUCH:):)
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 17:34
Joined
May 7, 2009
Messages
19,232
Always remember, better to have no sleep than no wake up. Goodluckand see you more.
 
You must log in or register to reply here.

Similar threads

S
Solved MS Access Navigationform moveable
Replies
1
Views
274
isladogs
isladogs
M
Getting pop-up form to center on monitor
2
Replies
23
Views
1,273
InstructionWhich7142
I
G
Password masked inputbox
Replies
3
Views
656
isladogs
isladogs
G
Struggle with Migrating to 64bit
Replies
14
Views
1,054
GaP42
G
AOB
Solved Making an old 32-bit MDB file 64-bit-compilable
Replies
5
Views
1,025
sonic8
S

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom