Forum

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

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

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

Απάντηση στο θέμα

 

Εργαλεία Θεμάτων Τρόποι εμφάνισης
  #1  
Παλιά 25-10-19, 19:11
Όνομα: ΣΑΚΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 24-02-2013
Μηνύματα: 250
Προεπιλογή Κώδικας που δεν τρέχει σε 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, 22:21
Όνομα: ΓΙΩΡΓΟΣ
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 14-01-2014
Μηνύματα: 154
Προεπιλογή

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

Στις δηλώσεις σου χρησιμοποίησε το 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, 20:43
Όνομα: ΣΑΚΗΣ
Έκδοση λογισμικού Office: Ms-Office 2007
Γλώσσα λογισμικού Office: Ελληνική
 
Εγγραφή: 24-02-2013
Μηνύματα: 250
Προεπιλογή

Έκανα τις αλλαγές και τώρα μου χτυπάει εδώ ....... 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, 10:41
Όνομα: ΓΙΩΡΓΟΣ
Έκδοση λογισμικού Office: Ms-Office 2010, Ms-Office 2013
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική
 
Εγγραφή: 14-01-2014
Μηνύματα: 154
Προεπιλογή

Καλήμερα,

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

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

Δεν την δέχεται, χτυπάει.
Απάντηση με παράθεση
Απάντηση στο θέμα

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

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

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


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

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


Η ώρα είναι 18:29.