טופס שקוף באקסס

[אבי]

לכל חובבי ושונאי אקסס היקרים
ישנה אפשרות ליצור שקיפות לטופס באקסס, ניתן לשחק עם הצבע של הרקע ורמת השקיפות. שימושי בכמה וכמה מקרים.
הנה הקוד למודול

Option Compare Database

#If Win64 And VBA7 Then
    Private Declare PtrSafe Function GetWindowLong Lib "User32" Alias "GetWindowLongA" _
      (ByVal hwnd As Long, _
       ByVal nIndex As Long) As Long
     
    Private Declare PtrSafe Function SetWindowLong Lib "User32" Alias "SetWindowLongA" _
      (ByVal hwnd As Long, _
       ByVal nIndex As Long, _
       ByVal dwNewLong As Long) As Long
     
    Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "User32" _
      (ByVal hwnd As Long, _
       ByVal crKey As Long, _
       ByVal bAlpha As Byte, _
       ByVal dwFlags As Long) As Long
#Else
    Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" _
      (ByVal hwnd As Long, _
       ByVal nIndex As Long) As Long
     
    Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" _
      (ByVal hwnd As Long, _
       ByVal nIndex As Long, _
       ByVal dwNewLong As Long) As Long
     
    Private Declare Function SetLayeredWindowAttributes Lib "User32" _
      (ByVal hwnd As Long, _
       ByVal crKey As Long, _
       ByVal bAlpha As Byte, _
       ByVal dwFlags As Long) As Long
#End If
 
Private Const LWA_ALPHA     As Long = &H2
Private Const GWL_EXSTYLE   As Long = -20
Private Const WS_EX_LAYERED As Long = &H80000
 
Public Sub SetFormOpacity(frm As Form, sngOpacity As Single, TColor As Long)
    Dim lngStyle As Long

    ' get the current window style, then set transparency
    lngStyle = GetWindowLong(frm.hwnd, GWL_EXSTYLE)
    SetWindowLong frm.hwnd, GWL_EXSTYLE, lngStyle Or WS_EX_LAYERED
    SetLayeredWindowAttributes frm.hwnd, TColor, (sngOpacity * 255), LWA_ALPHA
End Sub

וזה בפתיחת הטופס

Private Sub Form_Load()
    Dim transp As Long
    transp = RGB(0, 0, 0) 'This is the color you want your background to be 
    Me.Detail.BackColor = transp

    Me.Painting = False
    SetFormOpacity Me, 0.3, transp
    Me.Painting = True
End Sub

וכאן אני מבקש את עזרת המומחים
אחרי כמה בדיקות הגעתי למסקנה מעניינת. על טופס ראשי זה עובד בכל מערכת הפעלה, ואילו על טופס משנה זה עובד רק בווינדוס 10, ואני לא יודע איך לבדוק או לחפש את המקור ל'בעיה' הזו, כי כשאני פותח את הקובץ במערכת הפעלה קודמת ל 10 במקום שקיפות נהיה שחור...
אודה מאוד לכל עזרה ופתרון

פורסם במקור בפורום CODE613 ב21/12/2017 13:49 (+02:00)

[clickone]

transp = RGB(0, 0, 0) 
נראה לי זה שווה לשחור.

SetLayeredWindowAttributes frm.hwnd, TColor, (sngOpacity * 255), LWA_ALPHA

אני חושב שבגלל שווינדוס לפני 10 לא מוצא את ערך הHWND של הטופס משנה שזה המזהה של האובייקט בתוך כלל המערכת.
בגדול לכל פקד יש מזהה HWND. וכנראה שהוא מזהה את טופס המשנה לא כפקד סטנדרטי.

תנסה להוסיף אולי כאן:

Me.Painting = False
    SetFormOpacity Me, 0.3, transp
' תוסיף את השורה הבאה: 
'תשנה את
' SubFrm
' לשם הטופס משנה
   SetFormOpacity Me!SubFrm, 0.3, transp

    Me.Painting = True

לא בדקתי את הקוד שלך. אני כותב את זה מהשערה.

פורסם במקור בפורום CODE613 ב21/12/2017 15:42 (+02:00)

[אבי]

@ClickOne

נראה לי זה שווה לשחור.

נכון, וזה אמור להיות חצי שקוף - אפור, אך היות והוא לא עושה אותו שקוף הוא מוצג כשחור.

@ClickOne

אני חושב שבגלל שווינדוס לפני 10 לא מוצא את ערך הHWND של הטופס משנה שזה המזהה של האובייקט בתוך כלל המערכת.
בגדול לכל פקד יש מזהה HWND. וכנראה שהוא מזהה את טופס המשנה לא כפקד סטנדרטי.

השאלה היא למה?

@ClickOne

תנסה להוסיף אולי כאן:

ניסיתי.
ניסיתי גם לכתוב לו במפורש את המזהה של הטופס משנה וגם לא עבד.

תודה

פורסם במקור בפורום CODE613 ב21/12/2017 18:25 (+02:00)

[אבי]

ClickOne היקר
מצ"ב דוגמא דוגמא.accdb
אשמח אם תוכל לעבור על זה בזמנך הפנוי.

תודה מראש

פורסם במקור בפורום CODE613 ב23/12/2017 18:26 (+02:00)

[clickone]

הסתכלתי.
לא ישבתי יותר מדאי על זה.
מחיפוש זריז באינטרנט נראה שהבעייה ידועה, אחת התשובות המעניינות שראיתי זה לעשות את זה כטופס מוקפץ במקום המדוייק שבו צריך להיות הטופס משנה.
כמובן שזו תשובה מצחיקה.... (לא הייתי מעיז לעולם לענות כזו תשובה) אבל היא נכונה... כטופס מוקפץ זה מראה שקוף.
לדעתי אמור להיות לזה פיתרון יותר נכון.
אשתל בל"נ ובעז"ה יותר מאוחר לבדוק שוב.

פורסם במקור בפורום CODE613 ב23/12/2017 19:50 (+02:00)