بسم الله الرحمن الرحيم
السلام عليكم ورحمة الله وبركاته
كما هو واضح من العنوان قمت بعدت محاولات حتى تمكنت من اخفاء شاشة الاكسس الرمادية (ليس اخفائها بمعنى الغائها بل تصغيرها وظهور نموذج شفاف تستطيع من خلاله رؤية سطح المكتب)
هكذا
هذا كود اخفاء الشاشة الرمادية
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 fAccessWindow(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
fAccessWindow = False
End If
If IsWindowVisible(hWndAccessApp) = 1 Then
fAccessWindow = True
End If
End If
End Functionوهذا الاستدعاء في حدث عند الفتح او التحميل لنموذج رئيسي نقوم بتعيينه ليكون هو اول من يظهر عند فتح القاعدة
Call fSetAccessWindow(0)
اما كود الشفافية فهو
Option Explicit
Option Compare Text
Dim hamad As Byte
'===================================================================================
Private Const conModuleName As String = "mdlFadeForm"
Private Const LWA_ALPHA = &H2
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
'===================================================================================
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 SetWindowOpacity Lib "user32" _
Alias "SetLayeredWindowAttributes" (ByVal hwnd As Long, _
ByVal crKey As Long, _
ByVal bAlpha As Byte, _
ByVal dwFlags As Long) As Long
'===================================================================================
Public Declare Sub Sleep Lib "kernel32" (ByVal lngMilliSeconds As Long)
Private Const conFadeForm As Boolean = True
Public Const conFadeSleep As Long = 50 'ÊÍÏíÏ ÏÞÉ ÇáÔÇÝíÉ ÚäÏ ÇáÇÛáÇÞ ÈÈØÆ
Public Const conOpacityStep As Long = 2 'ÊÍÏíÏ ÏÞÉ ÓÑÚÉ ÇáÔÇÝíÉ ÚäÏ ÇáÇÛáÇÞ ÈÈØÆ
Public blnFadingInProgress As Boolean
'===================================================================================
Public Sub FadeInOut(ByVal strFormName As String, _
ByVal lngSaturation As Long, _
ByVal strInOut As String)
Dim lngOpacity As Long
blnFadingInProgress = True
If (conFadeForm) Then
If FormIsLoaded(strFormName) Then
Select Case strInOut
Case "In"
For lngOpacity = 0 To lngSaturation Step conOpacityStep
FadeForm Forms(strFormName).hwnd, lngOpacity
Sleep conFadeSleep
DoEvents
Next lngOpacity
Case "Out"
For lngOpacity = lngSaturation To 0 Step -conOpacityStep
FadeForm Forms(strFormName).hwnd, lngOpacity
Sleep conFadeSleep
DoEvents
Next lngOpacity
End Select
End If
End If
ExitProcedure:
On Error Resume Next
blnFadingInProgress = False
Exit Sub
ErrorHandler:
Resume ExitProcedure
End Sub
Public Sub FadeForm(ByRef lhWnd As Long, _
ByVal bytOpacity As Byte)
Dim lngReturn As Long
If (conFadeForm) Then
lngReturn = GetWindowLong(lhWnd, GWL_EXSTYLE)
lngReturn = lngReturn Or WS_EX_LAYERED
SetWindowLong lhWnd, GWL_EXSTYLE, lngReturn
SetWindowOpacity lhWnd, 0, bytOpacity, LWA_ALPHA
End If
ExitProcedure:
Exit Sub
ErrorHandler:
Resume ExitProcedure
End Sub
Public Function FormIsLoaded(ByVal strFormName As String) As Boolean
If (SysCmd(acSysCmdGetObjectState, acForm, strFormName)) Then
If (Forms(strFormName).CurrentView) Then
FormIsLoaded = True
End If
End If
ExitProcedure:
Exit Function
ErrorHandler:
Resume ExitProcedure
End Functionاستدعائه
FadeForm Me.hwnd, 150
حيث ان 150 كما تعلمون للتحكم بمقدار الشفافية
كذلك يتعين علينا جعل النموذج يأخذ مساحة الشاشة كاملة بـ
DoCmd.Maximize
قمت كذلك باخفاء شريط الادوات المعروف بـ Ribbon
بـ
DoCmd.ShowToolbar "ribbon", acToolbarNo
بعض الاعدات التي عليك عملها هي في خيارات اكسس --- قاعدة البيانات الحالية --- اختر النموذج الذي تريده كخلفية اساسي عند فتح القاعدة (الذي طبقنا عليه الاعدادات)
في نفس الصفحة جعل النوافذ متراكمة
ازالة الصح عن عرض شريط المعلومات
و شريط علامة التبويب
النماذج لا بد ان تكون مشروط ومنبثق حتى تكون ظاهرة
كذلك اضافة في النموذج الاساسي استدعاء النموذج الذي تريد العمل عليه بـ
DoCmd.OpenForm "test", acNormal
حيث ان test اسم النموذج
يعيب هذه الطريقة
في حال كان استدعاء النموذج بـ
Call fSetAccessWindow(0)
1- ان نوافذ تكون مشروطة اي لا يمكنك الانتقال الى نموذج سابق مثلا الا باغلاق اخر نموذج
2- عند تصغير النموذج مثلا يذهب خلف النموذج الاساسي وبما ان النموذج مشروط فلن تسطيع تصغير النموذج الاساسي الشفاف :(
3- اختفاء ايقونة الاكسس من شريط المهام
في حال كان الاستدعاء بـ
Call fSetAccessWindow(2)
1- تظهر ايقونة الاكسس في شريط المهام لكن عند النقر عليها تظهر الخلفية الرمادية مرة اخرى خلف النموذج الشفاف وهذا مالا نريده
2- من الممكن الاستغناء عن شكلي و مشروط في النموذج لكن النموذج الذي نريد ان نعمل عليه عند فتح النموذج الرئيسي لا يظهر او يختفي خلف النموذج الشفاف فلا يمكنك الوصول اليه بسهوله
ما اود الوصول اليه هو التغلب على المشاكل التالية
1- اتاحة ايقونة اكسس في شريط المهام
2- في حال النقر على الايقونة من اجل استدعاء البرنامج بقاء خلفية الاكسس الرمادية مخفية او مصغرة كي لات ظهر خلف النموذج الرئيسي الشفاف
3- عند تصغير احد النماذج الاخرى لا يذهب خلف النموذج الشفاف وفي هذه الحالة لا يمكن للمستخدم استدعائه ولا يمكن تصغير النموذج الاساسي لان النمذوج المصغر شكلي ومشروط ولا يسمح لك باختيار نماذج اخرى الا باغلاقه
4- مع امر اخفاء او تصغير الخلفية الرمادية لا تظهر النماذج الا في حال كونها شكلي ومشروط وهي عقبة في حال اردنا اختيار نمذج اخر وجعل النموذج مفتوح
5- لو افترضنا ان تم الاستغناء عن شكلي ومشروط وتم النقر بالخطاء على النموذج الرئيسي الشفاف فان النماذج المفتوحة ستذهب خلف النموذج الشفاف ولا يمكن الوصول لها بسهولة
تجدون ايها السادة الكرام المثال بالمرفقات فهل من الممكن تجاوز هذه العقبات ؟