اصلاح اهتزاز عناصر تحكم النموذج برمجيا

[zahrah2016]

ما هو سبب ارتجاف واهتزاز عناصر التحكم في النموذج عند تحريك الماوس في النموذج لبعض قواعد البيانات وخاصة عند استخدام سمات او اسطح الويندوز XP ؟

قد يكون الحل يدويا على مستوى حقل او حقلين لايوجد به مشكلة ولكن هل من المعقول نقوم بحل هذه المشكلة يدويا لعدد 30 او اربعين مربع نص او عنصر تحكم على النموذج اذن يكون الحل برمجيا .

اولا لنعرف السبب .

ان الارتجاف او الاهتزاز هو ناتج عن فقد اقتران مربع التسمية بمربع النص التابع له لهذا يحدث ما يسمى بالـ Flicker with tab controls وتحدث هذه المشكلة عند حذف مربع التسمية الاصلي لمربع النص واستبداله بآخر غير مقترن او وضع زخرفات زائدة لمربع التسمية .

ولحل هذه المشكلة لديك عدة خيارات :

1. اما ان تجعل سمات الويندوز على وضع كلاسيكي وهذا حل غير عملي لانه سيستخدم هذه القاعدة غيرك لديهم سمات ويندوز XP نشطه .

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

3. والحل الاخير هو برمجيا

لهذا نتبع هذه الطريقة :

1. قم بإنشاء وحدة نمطية جديده .

2. قم بنسخ هذا الكود للوحدة النمطية ومن ثم قم بحفظها .

Function ConvertLabelOnTabPage(strFormName As String, _
       Optional bSaveAndClose As Boolean, Optional bHidden As Boolean)
'الغرض : تغيير التسميات الغير مرتبطة بمربعات النص في النموذج 
'لاصلاح مشكلة الاهتزاز في سمات الويندوز اكس بي    
   Dim frm As Form
   Dim ctl As Control
   Dim strName As String
   Dim strCaption As String
   Dim bytBackStyle As Byte
   Dim bChanged As Boolean
   Const strcQuote = """"
 'افتح النموذج في وضع التصميم  
       DoCmd.OpenForm strFormName, acDesign, _
       windowmode:=IIf(bHidden, acHidden, acWindowNormal)
   Set frm = Forms(strFormName)
   'البحث عن مربعات التسميات العائدة لمربعات النص
   'Find the labels whose parent is a tab page.
   For Each ctl In frm.Controls
       If ctl.ControlType = acLabel Then
           If ParentIsTabPage(ctl) Then
               bChanged = True
               strName = ctl.Name                      'اسم مربع النص الذي فقد التسمية
               strCaption = ctl.Caption              'تسمية مربع النص
               bytBackStyle = ctl.BackStyle    'برنامج الاكسيس لا يمكنه عمل هذا 
               Debug.Print strFormName & "." & strName
               'Convert it to a text box.
               ctl.ControlType = acTextBox
               'Set the text box properties.
               With frm.Controls(strName)          'اسماء مربعات النص لغير محدد
                   .ControlSource = "=" & strcQuote & _
                       Replace(strCaption, strcQuote, strcQuote & strcQuote) & strcQuote
                   .Enabled = False
                   .Locked = True
                   .BackStyle = bytBackStyle
               End With
           End If
       End If
   Next
   
   Set ctl = Nothing
   Set frm = Nothing
   If Not bChanged Then
       DoCmd.Close acForm, strFormName, acSaveNo
   ElseIf bSaveAndClose Then
       DoCmd.Close acForm, strFormName, acSaveYes
   End If
End Function

Private Function ParentIsTabPage(ctl As Control) As Boolean
   On Error Resume Next
   ParentIsTabPage = (ctl.Parent.ControlType = acPage)
End Function

Function FixAllForms()
   'الغرض : تشغيل تحويل مربعات التسميات جميعها في قاعدة البيانات
   'تحذير : قم بحفظ قاعدة البيانات قبل عمل هذا الاجراء
   Dim accobj As AccessObject
   For Each accobj In CurrentProject.AllForms
       Call ConvertLabelOnTabPage(accobj.Name, True, True)
   Next
End Function

3. لاجراء اختبار وانت داخل الوحدة النمطية من نافذة Immediate التي تستطيع الوصول لها بضغط المفاتيح Ctrl+G من لوحة المفاتيح وكنابة هذا الامر

? ConvertLabelOnTabPage("MyForm")

MyForm اسم النموذج الخاص بك ثم اضغط Enter 4. ستظهر لك في النافذة السفلية جميع مربعات التسميات التي تم تحويلها وارتباطها بمربعات النص . 5. لاصلاح جميع مربعات التسميات في جميع النماذج في قاعدة البيانات استخدم هذا الامر بدلا عن السابق

? FixAllForms()

ملاحظة : يجب اخذ نسخة احتياطية لقاعدة بياناتك قبل هذه العملية 6. لاصلاح مجموعة الخيار option groups لمربعات النص استبدل هذا الكود في دالة () ParentIsTabPage

Private Function ParentIsTabPage(ctl As Control) As Boolean
   On Error Resume Next
   ParentIsTabPage = ((ctl.Parent.ControlType = acPage) Or _
       (ctl.Parent.ControlType = acOptionGroup))
End Function

[walid7799]

6. لاصلاح مجموعة الخيار option groups لمربعات النص استبدل هذا الكود في دالة () ParentIsTabPage

ما هو option groups

وما هو () ParentIsTabPage

وكيف يتم استعداءه

تم تعديل ديسمبر 5, 2021 بواسطه walid7799