Forum

Αναζήτηση στο ms-office.gr

Πάμε!
ms-office.gr > Forum > Microsoft Access > Access - Ερωτήσεις / Απαντήσεις > [ Συναρτήσεις ] Κώδικας που δεν τρέχει σε 64bit περιβάλλον

Access - Ερωτήσεις / Απαντήσεις Access + VBA... Εδώ δεν υπάρχουν όρια!

Κλειστό Θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 25-10-19, 18:11
Όνομα: ΣΑΚΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 24-02-2013
Μηνύματα: 259
Προεπιλογή Κώδικας που δεν τρέχει σε 64bit περιβάλλον

Χρησιμοποιώ αυτό τον κώδικα για αρχική splash screen με κωδικό που έχει δημιουργήσει ο Τάσος.Όμως αναβάθμισα την access σε 2010 από 2007 και από τότε μου βγάζει μήνυμα ότι δεν λειτουργεί σε συστήματα 64bit.Υπάρχει λύση;

Option Compare Database
Option Explicit
Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SPI_GETWORKAREA = 48
Private Type Rect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

'Private Declare Function SystemParametersInfo Lib "user32" Alias _
"SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, _
ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As Rect) As Long

Private Declare Function Movewindow Lib "user32" Alias "MoveWindow" (ByVal hWnd As Long, _
ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long



Public Sub CenterForm(wHandle&)
Dim oRect As Rect, scrnW&, scrnH&, Vwidth&, Vheight&, Vleft&, Vtop&
If wHandle <> 0 Then
SystemParametersInfo SPI_GETWORKAREA, 0, oRect, 0
scrnW = Abs(oRect.Right - oRect.Left)
scrnH = Abs(oRect.Top - oRect.Bottom)
GetWindowRect wHandle, oRect
Vwidth = Abs(oRect.Right - oRect.Left)
Vheight = Abs(oRect.Top - oRect.Bottom)
Vleft = (scrnW - Vwidth) / 2
Vtop = (scrnH - Vheight) / 2
Movewindow wHandle, Vleft, Vtop, Vwidth, Vheight, True
End If
End Sub

και επίσης

Option Compare Database
Option Explicit
Public Const IDC_ARROW = 32512&
Public Const IDC_SIZEALL = 32646&
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const WS_EX_TRANSPARENT = &H20&
Public Const LWA_ALPHA = &H2&
Public Const SW_Hide = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_SHOWMAXIMIZED = 3
Public IsRunning As Boolean
Public Declare Function ShowAccHwnd Lib "user32" Alias "ShowWindow" _
(ByVal hWnd As Long, ByVal nCmdShow As Long) As Long

Public Declare Function LoadCursorBynum Lib "user32" Alias "LoadCursorA" _
(ByVal hInstance As Long, ByVal lpCursorName As Long) As Long

Public Declare Function LoadCursorFromFile Lib "user32" Alias _
"LoadCursorFromFileA" (ByVal lpFileName As String) As Long

Public Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Declare Function SetLayeredWindowAttributes Lib "user32" _
(ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long

Public Sub FadeMe(frmhWnd&, F_In As Boolean, iVal%, Optional FinalOpacity As Integer = 255)
Dim LStyle&, i%
LStyle = GetWindowLong(frmhWnd, GWL_EXSTYLE)
SetWindowLong frmhWnd, GWL_EXSTYLE, LStyle Or WS_EX_LAYERED
Select Case F_In
Case True
For i = 0 To FinalOpacity Step 5
SetLayeredWindowAttributes frmhWnd, 0, CByte(i), LWA_ALPHA
DoEvents
Sleep iVal
Next
Case 0
If iVal = 0 Then
SetLayeredWindowAttributes frmhWnd, 0, CByte(0), LWA_ALPHA
Else
For i = FinalOpacity To 0 Step -5
SetLayeredWindowAttributes frmhWnd&, 0, CByte(i), LWA_ALPHA
DoEvents
Sleep iVal
Next
End If
End Select
End Sub

Public Function MouseCursor(CursorType As Long)
Dim lngRet As Long
lngRet = LoadCursorBynum(0&, CursorType)
lngRet = SetCursor(lngRet)
End Function

Public Function PointM(strPathToCursor As String)
Dim lngRet As Long
lngRet = LoadCursorFromFile(strPathToCursor)
lngRet = SetCursor(lngRet)
End Function

'Code From Microsoft help with some changes
Public Function ChangeProperty(strPropName As String, _
varPropType As Variant, _
varPropValue As Variant) As Integer

Dim dbs As Object, prp As Variant
Const conPropNotFoundError = 3270

Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = varPropValue

Change_Bye:
Exit Function

Change_Err:
If Err = conPropNotFoundError Then ' Property not found.
Set prp = dbs.CreateProperty(strPropName, _
varPropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
ChangeProperty = 2
Resume Change_Bye
End If
End Function

Public Function OpenForm()
Dim wh&, frmName$
frmName = "frmSplash"
DoCmd.OpenForm frmName, , , , , acHidden
End Function
  #2  
Παλιά 25-10-19, 21:21
Super Moderator
Όνομα: ΓΙΩΡΓΟΣ
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 14-01-2014
Μηνύματα: 193
Προεπιλογή

Καλησπέρα Σάκη,

Στις δηλώσεις σου χρησιμοποίησε το PtrSafe.

Για παράδειγμα

Public Declare PtrSafe Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As LongPtr

Ευχαριστώ.
__________________
Βραχνάκης Γιώργος
vrahnakisg@gmail.com
  #3  
Παλιά 29-10-19, 19:43
Όνομα: ΣΑΚΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 24-02-2013
Μηνύματα: 259
Προεπιλογή

Έκανα τις αλλαγές και τώρα μου χτυπάει εδώ ....... type mismatch

Public Sub FadeMe(frmhWnd&, F_In As Boolean, iVal%, Optional FinalOpacity As Integer = 255)
Dim LStyle&, i%
LStyle = GetWindowLong(frmhWnd, GWL_EXSTYLE)
SetWindowLong frmhWnd, GWL_EXSTYLE, LStyle Or WS_EX_LAYERED
Select Case F_In
Case True
For i = 0 To FinalOpacity Step 5
SetLayeredWindowAttributes frmhWnd, 0, CByte(i), LWA_ALPHA
DoEvents
Sleep iVal
Next
Case 0
If iVal = 0 Then
SetLayeredWindowAttributes frmhWnd, 0, CByte(0), LWA_ALPHA
Else
For i = FinalOpacity To 0 Step -5
SetLayeredWindowAttributes frmhWnd&, 0, CByte(i), LWA_ALPHA
DoEvents
Sleep iVal
Next
End If
End Select
End Sub
  #4  
Παλιά 30-10-19, 09:41
Super Moderator
Όνομα: ΓΙΩΡΓΟΣ
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 2013, Ms-Office 2016, Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 14-01-2014
Μηνύματα: 193
Προεπιλογή

Καλήμερα,

Άλλαξε τον τύπο της μεταβλητής LStyle σε LongPtr.

Ευχαριστώ.
__________________
Βραχνάκης Γιώργος
vrahnakisg@gmail.com
  #5  
Παλιά 30-10-19, 18:34
Όνομα: ΣΑΚΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 24-02-2013
Μηνύματα: 259
Προεπιλογή

Δεν την δέχεται, χτυπάει.
  #6  
Παλιά 04-12-19, 18:33
Όνομα: ΣΑΚΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 24-02-2013
Μηνύματα: 259
Προεπιλογή

Καλησπέρα, επανέρχομαι γιατί ότι και να δοκίμασα δεν βρήκα λύση....άλλαξα και την Lstyle σε LongPtr αλλά δεν δουλεύει.

Public Sub FadeMe(frmhWnd&, F_In As Boolean, iVal%, Optional FinalOpacity As Integer = 255)
Dim Lstyle&, i%
Lstyle = GetWindowLong(frmhWnd, GWL_EXSTYLE)
SetWindowLong frmhWnd, GWL_EXSTYLE, Lstyle Or WS_EX_LAYERED
Select Case F_In
Case True
For i = 0 To FinalOpacity Step 5
SetLayeredWindowAttributes frmhWnd, 0, CByte(i), LWA_ALPHA
DoEvents
Sleep iVal
Next
Case 0
If iVal = 0 Then
SetLayeredWindowAttributes frmhWnd, 0, CByte(0), LWA_ALPHA
Else
For i = FinalOpacity To 0 Step -5
SetLayeredWindowAttributes frmhWnd&, 0, CByte(i), LWA_ALPHA
DoEvents
Sleep iVal
Next
End If
End Select
End Sub
  #7  
Παλιά 04-12-19, 19:24
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.139
Προεπιλογή

Καλησπέρα σε όλους!

Σάκη οι συναρτήσεις που χρησιμοποιείς πρέπει να έχουν αυτή τη μορφή:
Κώδικας:
'Παραδειγματικές συναρτήσεις:

Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" ( _
        ByVal hwnd As LongPtr, ByVal nIndex As Long) As LongPtr

Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" ( _
        ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr

Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" ( _
        ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As Any, ByVal fuWinIni As Long) As Long

Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long

Declare PtrSafe Function MoveWindow Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal x As Long, ByVal y As Long, _
        ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long

Declare PtrSafe Function SetWindowPos Lib "user32" ( _
        ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr, ByVal x As Long, _
        ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Μπορείς κάνοντας αναζήτηση (CTRL + F στον περιηγητή σου ) στο μήνυμα: http://www.ms-office.gr/forum/access...html#post30363 να βρεις και να πάρεις οποιαδήποτε συνάρτηση στην κατάλληλη μορφή.

Δε θα συνιστούσα τη χρήση Office 64 σε συνδυασμό με αυτοματισμούς αυτού του είδους.

Καλή συνέχεια!

Με εκτίμηση

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών σε VB.Net, Access, Excel, Outlook, Word

Τελευταία επεξεργασία από το χρήστη Tasos : 05-12-19 στις 20:29.
  #8  
Παλιά 04-12-19, 19:50
Όνομα: ΣΑΚΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 24-02-2013
Μηνύματα: 259
Προεπιλογή

Τάσο ευχαριστώ για τις συμβουλές.Ότι και να δοκίμασα, ότι αλλαγές έκανα δεν βοήθησαν.
Ακόμη μου βγάζει σφάλμα.
  #9  
Παλιά 04-12-19, 21:29
Το avatar του χρήστη Tasos
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 2007, Ms-Office 2010, Ms-Office 2013, Ms-Office 2016
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.139
Προεπιλογή

Επισυνάπτω ένα αρχείο που δυστυχώς δεν μπορώ να το δοκιμάσω σε περιβάλλον 64bit.

Δοκίμασε και πες μας τι έγινε.

Τάσος
Συνημμένα Αρχεία
Τύπος Αρχείου: accdb TestDB.accdb (748,0 KB, 9 εμφανίσεις)
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών σε VB.Net, Access, Excel, Outlook, Word
  #10  
Παλιά 05-12-19, 16:00
Όνομα: ΣΑΚΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 24-02-2013
Μηνύματα: 259
Προεπιλογή

Καλησπέρα,μετακινείται αλλά δεν αλλάζει μέγεθος
Κλειστό Θέμα

Εργαλεία Θεμάτων
Τρόποι εμφάνισης

Δικαιώματα - Επιλογές
Δε μπορείτε να δημοσιεύσετε νέα μηνύματα
Δε μπορείτε να δημοσιεύσετε απαντήσεις
Δεν μπορείτε να επισυνάψετε αρχεία
Δεν μπορείτε να επεξεργαστείτε τα μηνύματα σας

Ο κώδικας ΒΒ είναι σε λειτουργία
Τα Smilies είναι σε λειτουργία
Ο κώδικας [IMG] είναι σε λειτουργία
Ο κώδικας HTML είναι εκτός λειτουργίας
Trackbacks are εκτός λειτουργίας
Pingbacks are εκτός λειτουργίας
Refbacks are εκτός λειτουργίας


Παρόμοια Θέματα

Θέμα Δημιουργός Forum Απαντήσεις Τελευταίο Μήνυμα
[Γενικά] Excel 365 64bit DatePicker jockey17 Excel - Ερωτήσεις / Απαντήσεις 5 21-12-18 12:47
Κεντράρισμα φορμών και σε 64bit και σε 32bit lefterisg Access - Ερωτήσεις / Απαντήσεις 0 15-11-17 10:34
Access 64bit? γιώργοςΚ Access - Ερωτήσεις / Απαντήσεις 5 12-11-16 13:06
[Συναρτήσεις] Ερώτηση για συνάρτηση-περιβάλλον aristarchosel Excel - Ερωτήσεις / Απαντήσεις 1 12-10-14 02:11
Τερματισμός βάσης που τρέχει στο παρασκήνιο dimitrisp Access - Ερωτήσεις / Απαντήσεις 0 02-10-14 23:58


Η ώρα είναι 12:35.