• 0
نجوم الكون

محاولتي لاخفاء الخلفية الرمادية واستخدام نموذج شفاف بديل

سؤال

بسم الله الرحمن الرحيم


 


السلام عليكم ورحمة الله وبركاته


 


كما هو واضح من العنوان قمت بعدت محاولات حتى تمكنت من اخفاء شاشة الاكسس الرمادية (ليس اخفائها بمعنى الغائها بل تصغيرها وظهور نموذج شفاف تستطيع من خلاله رؤية سطح المكتب)


 


هكذا


 


7d85e1412e53e71.jpg


 


 


هذا كود اخفاء الشاشة الرمادية



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


 


ribbon1.gif


 


بـ



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- لو افترضنا ان تم الاستغناء عن شكلي ومشروط وتم النقر بالخطاء على النموذج الرئيسي الشفاف فان النماذج المفتوحة ستذهب خلف النموذج الشفاف ولا يمكن الوصول لها بسهولة


 


 


تجدون ايها السادة الكرام المثال بالمرفقات فهل من الممكن تجاوز هذه العقبات ؟


 


 


 


important .zip

1

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

4 إجابة على هذا السؤال .

  • 0

اعجبني والله ما قمتي به .. ما هذا 

 

اشهد بانه ابداع 

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

اشكر لكم ردكم الكريم بارك الله فيكم لكن مازال العمل يحتاج بعض التعديلات ولا نستغني عن الخبراء

 

ثم اني اخ لكم ولست اخت .... ربما علي تغيير المعرف ههههههههههه

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

ياقوم اريد عند تصغير نموذج او تقرير لا يذهب خلف النموذج main اي الرئيسي الذي وضعته خلفية فهل هذا ممكن

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه
  • 0

بارك الله في مجهودك وشرحك

 

وأتمنى أن تجد حلا لمشكلتك

 

 

للرفع

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .