- 0
سجل دخول لمتابعه هذا
متابعين
0

تعلم كيف تصنع أداة ال ActiveX بنفسك من الألف إلى الياء
بواسطة
Sniper.ps,
-
يستعرض القسم حالياً 0 members
لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .
بواسطة
Sniper.ps,
لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .
تم النشر منذ
بسم الله الرحمن الرحيم
تعلم كيف تصنع أداة ال ActiveX بنفسك من الألف إلى الياء
قبل البدأ في الدرس أو أن ألفت إنتباهكم بأن هذا المقال من إعدادي وتأليفي بحمد الله وفضله عليّ بعد أن بدأت في برمجة الأدوات أقدم لكم هذا الدرس أتمنى أن ينال إعجابكم
في هذا الدرس سأقوم بشرح كيفية تصميم Text خاص بك وإضافة العديد من المزايا له.
في البداية ما هي ال ActiveX
بكل بساطة هي عبارة عن أداة مثل الأدوات القياسية في الفيجوال بيسك كمربع النص و زر الأمر ..إلخ, يقوم المبرمج ببرمجتها لتلبّي احتياجاته البرمجية.
لنبدأ الآن في الدرس
افتح مشروع جديد StanderdExE كما في الصورة التالية
بعد فتح مشروعك قم بإضافة مشروع آخر من نوع ActiveX Control كما في الصورة التالي
الهدف من إنشاء مشروعين هو
1)القدرة على تجربة الأداة أثناء التصميم
2)لتتمكن من تحويل الأداة الى ملف OCX
بعد إضافتك للمشروعين إضغط DblClick على الأداة الموجودة في الصورة التالية
ستظهر لك الأداة كما في الصورة التالية
يمكنك ضبط اسم الأداة من نافذة الخصائص فلنقم بتسميتها فرضاً باسم MyText كما في الصورة التالية
هناك العديد من الخصائص لأداة الUserControl ما يهمنا هي الخصائص التالية:
InvisibleAtRuntime : لرؤية أو عدم رؤية الأداة أثناء زمن التنفيذ
PropertyPages : وهي لاختيار صفحات ال PropertyPages التي سأتحدث عنها لاحقاً
ToolBoxBitmap : وهي للإيقونة التي تظهر في صندوق الأدوات
نعود الآن للأداة ضع أداة Text على أداة الUserControl كما في الصورة التالية
قم بتسميتها بإسم TxT
اضبط خاصية
وخاصية
وخاصية
الآن افتح نافذة الكود واكتب الكود التالي حيث يقوم هذا الكود برسم الخطوط الأربعة التي تحيط بمربع النص
UserControl.AutoRedraw = True
UserControl.DrawWidth = 1
UserControl.Line (0, 0)-(UserControl.Width, 0), LineColor
UserControl.Line (0, 0)-(0, UserControl.Height), LineColor
UserControl.Line (UserControl.Width - 15, 0)-(UserControl.Width - 15, UserControl.Height), LineColor
UserControl.Line (0, UserControl.Height - 15)-(UserControl.Width, UserControl.Height - 15), LineColor
End Sub
حيث أن
لتفعيل خاصية إعادة الرسم
و
لسمك الخط المرسوم
و
لرسم خط بين نقطتين وتحديد لون الخط كالتالي
في حدث Resize لأداة ال UserControl
Private Sub UserControl_Resize()
On Error Resume Next
With UserControl
TxT.Width = .Width - 25
TxT.Height = .Height - 25
TxT.left = 10
TxT.Top = 10
End With
DrawLine vbRed
End Sub
حيث
TxT.Height = .Height – 25
لجعل مربع النص بحجم تقريبي لأداة ال UserControl وقمنا بتقليل الحجم قليلا لتظهر الخطوط التي سنرسمها من الناحية اليمنى والناحية السفلى
و
TxT.Top = 10
الخطوط التي سنرسمها من الناحية اليسرى والناحية العليا
و
لاستدعاء اجراء رسم الخطوط باللون الأحمر
إذهب الى الفورم بعد إغلاق نافذة الأداة وقم برسمها على الفورم ستظهر لك الاداة على الفروم كما في الصورة التالية
أليست رائعة
حمل المثال من هنا
لو نظرت الى خصائص الأداة ستجدها كما في الصورة التالية
لن تجد العديد من الخصائص التي نعرفها لخصائص مربع النص القياسي مثل خاصية Text
لذا المهمة التالية ستكون لكيفية انشاء هذه الخصائص
نعود الآن لنبدأ بكتابة الأكواد التي تعطي لمربع النص خصائصه لإضافة خاصية Text نذهب على قائمة Tools كما في ثم نختار Add Procedure كما في الصورة التالية
ستظهر لنا النافذة التالية
حيث ان Name هي اسم الخاصية ونقوم بإختيار نوع الخاصية وهي Property ونظغط Ok سيظهر لنا الحدثين التاليين في نافذة الأكواد
End Property
Public Property Let Text(ByVal New_Text As Variant)
End Property
حدث Get : ونوع هذا الإجراء هو (Function) حيث أنه يقوم بإرجاع القيمة التي تم حفظها.
حدث Let: ونوع هذا الإجراء هو (Sub) حيث أنه تقبل الباراميترات وقيمتها تساوي قيمة جديدة وتقوم بإرسال قيمة الخاصية المضافة إلى الأداة المراد تغيير قيمتها من خلال صندوق الخصائص ليتم حفظها لحين استدعائها.
ملاحظة هامة : انتبه الى أن نوع البيانات لخاصية Text هي Variant حيث أنها القيمة الإفتراضية التي يقوم برنامج الفيجوال بيسك بإعطائها للخاصية لكننا نستبدلها بنوع البيانات للخاصية المستخدمة فمثلاً في خاصية Text نستبدلها ب String وفي خاصية Enabled نستبدلها ب Boolean وعند استخدام Enum نستبدلها باسم ال Enum المستخدم سنتعرف لاحقاً ما هو ال Enum
ولكي نعطي خاصية Text قيمة نقوم بتعديل الكود السابق كما يلي
Text = TxT.Text
End Property
حيث
أخذ قيمة Text من TxT.Text
وحدث Let ليصبح كما يلي
TxT.Text() = New_Text
PropertyChanged "Text"
End Property
حيث
إنشاء خاصية تأخذ قيمة جديدة
و
إرسال أمر للنظام بحدوث تغيير في خاصية Text
ولكي نحفظ قيمة الText عند تغييرها من الخصائص يلزمنا حدثي ReadProperties و WriteProperties
كما في الاكواد التالية
Call PropBag.WriteProperty("Text", Text, Ambient.DisplayName)
End Sub
حفظ قيمة ال Text في حافظة الخصائص
حيث يتم فتح حافظة الخصائص وحفظ اسم الخاصية وقيمتها والقيمة الإفتراضية حيث أن
هي قيمة الText الإفتراضية وتساوي اسم الأداة
Text = PropBag.ReadProperty("Text", Ambient.DisplayName)
End Sub
استدعاء قيمة ال Text من حافظة الخصائص
وفي حدث InitProperties وهو حدث لإعطاء القيمة الأولية للأداة
Text = Ambient.DisplayName
End Sub
حمل المثال من هنا
وبنفس الطريقة يمكن كتابة باقي الخصائص كما في الاكواد التالية
خاصية Enabled
Enabled = TxT.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
TxT.Enabled() = New_Enabled
PropertyChanged "Enabled"
End Property
خاصية Font
Public Property Get Font() As Font
Set Font = TxT.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
Set TxT.Font = New_Font
PropertyChanged "Font"
End Property
خاصية Locked
Public Property Get Locked() As Boolean
Locked = TxT.Locked
End Property
Public Property Let Locked(ByVal New_Locked As Boolean)
TxT.Locked() = New_Locked
PropertyChanged "Locked"
End Property
خاصية MaxLength
Public Property Get MaxLength() As Long
MaxLength = TxT.MaxLength
End Property
Public Property Let MaxLength(ByVal New_MaxLength As Long)
TxT.MaxLength() = New_MaxLength
PropertyChanged "MaxLength"
End Property
خاصية PasswordChar
Public Property Get PasswordChar() As String
PasswordChar = TxT.PasswordChar
End Property
Public Property Let PasswordChar(ByVal New_PasswordChar As String)
TxT.PasswordChar() = New_PasswordChar
PropertyChanged "PasswordChar"
End Property
خاصية SelStart
Public Property Get SelStart() As Long
SelStart = TxT.SelStart
End Property
Public Property Let SelStart(ByVal New_SelStart As Long)
TxT.SelStart() = New_SelStart
PropertyChanged "SelStart"
End Property
خاصية SelText
Public Property Get SelText() As String
SelText = TxT.SelText
End Property
Public Property Let SelText(ByVal New_SelText As String)
TxT.SelText() = New_SelText
PropertyChanged "SelText"
End Property
خاصية SelLength
Public Property Get SelLength() As Long
SelLength = TxT.SelLength
End Property
Public Property Let SelLength(ByVal New_SelLength As Long)
TxT.SelLength() = New_SelLength
PropertyChanged "SelLength"
End Property
خاصية ToolTip
Public Property Get ToolTip() As String
ToolTip = TxT.ToolTipText
End Property
Public Property Let ToolTip(ByVal New_ToolTip As String)
TxT.ToolTipText = New_ToolTip
PropertyChanged "ToolTip"
End Property
وفي حدثي ReadProperties و WriteProperties يصبحان كالتالي
Enabled = PropBag.ReadProperty("Enabled", True)
Set Font = PropBag.ReadProperty("Font", Ambient.Font)
PasswordChar = PropBag.ReadProperty("PasswordChar", "")
Text = PropBag.ReadProperty("Text", Ambient.DisplayName)
Locked = PropBag.ReadProperty("Locked", False)
MaxLength = PropBag.ReadProperty("MaxLength", 0)
SelStart = PropBag.ReadProperty("SelStart", 0)
SelText = PropBag.ReadProperty("SelText", "")
SelLength = PropBag.ReadProperty("SelLength", 0)
ToolTip = PropBag.ReadProperty("ToolTip", "")
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("Enabled", Enabled, True)
Call PropBag.WriteProperty("Font", Font, Ambient.Font)
Call PropBag.WriteProperty("PasswordChar", PasswordChar, "")
Call PropBag.WriteProperty("Text", Text, Ambient.DisplayName)
Call PropBag.WriteProperty("Locked", Locked, False)
Call PropBag.WriteProperty("MaxLength", MaxLength, 0)
Call PropBag.WriteProperty("SelStart", SelStart, 0)
Call PropBag.WriteProperty("SelText", SelText, "")
Call PropBag.WriteProperty("SelLength", SelLength, 0)
Call PropBag.WriteProperty("ToolTip", ToolTip, "")
End Sub
حمل المثال من هنا
إذهب إلى الفورم وإنظر إلى صندوق الخصائص ستجد العديد من الخصائص التي تم إضافتها إنظر الى الصور التالية
هناك خصائص لم أقم بإضافتها مثل خاصية Alignment و DragMode و OLEDragMode و ScrollBars و ForeColor و BackColor ما السبب ؟؟؟؟؟؟؟؟؟ تابع لتعرف
لو قمت مثلا بتعيين خاصية Alignment كما في الخصائص السابقة لن تظهر لك الخيارات الموجودة في ال Text القياسية كما في الشكل التالي
بل ستظهر كما في الشكل التالي
إذن ما الحل هنا يأتي دور Enum
ما هي Enum وما هي فائدتها
: ( Enum ) أن تسمي كل رقم بإسم الحالة التي تريد ثم تساويه لرقم الحالة ،وعلى هذا تقوم بإستدعاء الدالة وتعطيها أسم الحالة وهي ستقوم : بقراءة هذا الأسم على أنه رقم وتعطيك الدالة نتيجة تنفيذ الدالة لحالة ذاك الرقم
فمثلاً خاصية Alignment باستخدام Enum نكتبها هكذا في ال General
Public Enum sAlignment
Alignleft = 0
AlignRight = 1
AlignCenter = 2
End Enum
وفي خاصية Alignment تكتب هكذا
Alignment = TxT.Alignment
End Property
Public Property Let Alignment(ByVal New_Alignment As sAlignment)
TxT.Alignment() = New_Alignment
PropertyChanged "Alignment"
End Property
لاحظ اننا قمنا بأخذ قيمة ال Alignment من ال Enum الخاص بها
وبنفس الطريقة يمكن كتابة Enum لكل من DragMode و OLEDragMode و ScrollBars
كما يلي
vbManual = 0
vbAutomatic = 1
End Enum
Public Enum sOLEDragMode
vbManual = 0
vbAutomatic = 1
End Enum
Public Enum sScrollBars
None = 0
Horiziontal = 1
Vertical = 2
Both = 3
End Enum
والخواص تصبح كالتالي
DragMode = TxT.DragMode
End Property
Public Property Let DragMode(ByVal New_DragMode As sDragMode)
TxT.DragMode() = New_DragMode
PropertyChanged "DragMode"
End Property
Public Property Get OLEDragMode() As sOLEDragMode
OLEDragMode = TxT.OLEDragMode
End Property
Public Property Let OLEDragMode(ByVal New_OLEDragMode As sOLEDragMode)
TxT.OLEDragMode() = New_OLEDragMode
PropertyChanged "OLEDragMode"
End Property
لاحظ بأني لم أكتب خاصية ScrollBars وذلك لأنها خاصية للقراءة فقط ولا يمكن استدعائها كالخواص السابقة لذلك هناك حل باستخدام دوال ال Api اكتب دالة ال Api التالية مع ثوابتها في ال General
Private Declare Function ShowScrollBar Lib "user32" (ByVal hwnd As Long, ByVal wBar As Long, ByVal bShow As Long) As Long
Private Const SB_HORZ = 0
Private Const SB_VERT = 1
Private Const SB_BOTH = 3
ونقوم بتعريف المتغير التالي في ال General
ونقوم بإنشاء الإجراء التالي بإسم DrawScroll
ونقوم ببرمجة هذا الإجراء ليتم استخدامه في خاصية ScrollBars فيما بعد كالتالي
Select Case m_ScrollBars
Case None
ShowScrollBar TxT.hwnd, SB_BOTH, False
Case Horiziontal
ShowScrollBar TxT.hwnd, SB_HORZ, True
ShowScrollBar TxT.hwnd, SB_VERT, False
Case Vertical
ShowScrollBar TxT.hwnd, SB_VERT, True
ShowScrollBar TxT.hwnd, SB_HORZ, False
Case Both
ShowScrollBar TxT.hwnd, SB_BOTH, True
End Select
End Sub
حيث استخدمنا جملة SelectCase لإنشاء ال ScrollBars بناء على قيمة m_ScrollBars فإذا كانت قيمتها تساوي
None (0) فإننا لن نظهر أي شريط تمرير
وفي حالة Horiziontal (1) فإننا نظهر شريط التمرير الأفقي ونخفي شريط التمرير العمودي في حالة وجوده
وفي حالة Vertical (2) فإننا نظهر شريط التمرير العمودي ونخفي شريط التمرير الأفقي في حالة وجوده
وفي حالة Both (3) فإننا نظهر شريط التمرير العمودي و شريط التمرير الأفقي
نذهب الآن وننشأ خاصية ScrollBars كما في الكود التالي
ScrollBars = m_ScrollBars
DrawScroll
End Property
Public Property Let ScrollBars(ByVal New_ScrollBars As sScrollBars)
m_ScrollBars = New_ScrollBars
DrawScroll
PropertyChanged "ScrollBars"
End Property
وفي حدث Show لأداة ال UserControl نقوم بكتابة الكود التالي لإظهار أشرطة التمرير أثناء زمن التنفيذ
ScrollBars = m_ScrollBars
End Sub
الآن سيصبح حدث ReadProperties كالتالي
Alignment = PropBag.ReadProperty("Alignment", 0)
DragMode = PropBag.ReadProperty("DragMode", 0)
OLEDragMode = PropBag.ReadProperty("OLEDragMode", 0)
Enabled = PropBag.ReadProperty("Enabled", True)
Set Font = PropBag.ReadProperty("Font", Ambient.Font)
PasswordChar = PropBag.ReadProperty("PasswordChar", "")
Text = PropBag.ReadProperty("Text", Ambient.DisplayName)
Locked = PropBag.ReadProperty("Locked", False)
MaxLength = PropBag.ReadProperty("MaxLength", 0)
SelStart = PropBag.ReadProperty("SelStart", 0)
SelText = PropBag.ReadProperty("SelText", "")
SelLength = PropBag.ReadProperty("SelLength", 0)
ToolTip = PropBag.ReadProperty("ToolTip", "")
m_ScrollBars = PropBag.ReadProperty("ScrollBars", 0)
End Sub
وحدث WriteProperties كالتالي
Call PropBag.WriteProperty("Alignment", Alignment, 0)
Call PropBag.WriteProperty("DragMode", DragMode, 0)
Call PropBag.WriteProperty("OLEDragMode", OLEDragMode, 0)
Call PropBag.WriteProperty("Enabled", Enabled, True)
Call PropBag.WriteProperty("Font", Font, Ambient.Font)
Call PropBag.WriteProperty("PasswordChar", PasswordChar, "")
Call PropBag.WriteProperty("Text", Text, Ambient.DisplayName)
Call PropBag.WriteProperty("Locked", Locked, False)
Call PropBag.WriteProperty("MaxLength", MaxLength, 0)
Call PropBag.WriteProperty("SelStart", SelStart, 0)
Call PropBag.WriteProperty("SelText", SelText, "")
Call PropBag.WriteProperty("SelLength", SelLength, 0)
Call PropBag.WriteProperty("ToolTip", ToolTip, "")
Call PropBag.WriteProperty("ScrollBars", m_ScrollBars, 0)
End Sub
حمل المثال من هنا
سنبدأ عملية إنشاء خصائص غير موجودة أصلاً بال Text القياسي
لكن قبل ذلك دعونا نتعرف على كيفية انشاء الأحداث للأداة مثال حدث Change و KeyPress ... إلخ
اكتب الكود التالي في ال General
Public Event Change()
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event Click()
Public Event DblClick()
حيث أنه من الواضح أنها أحداث التي يتم استخدامها عادة بأداة الText
ولإنشاء حدث Change مثلاً نذهب الى أداة ال Text التي وضعناها على ال UserControl وننقر نقرتين عليها سيظهر لنا حدث Change لأداة ال Text كما يلي
End Sub
ولإنشاء الحدث نقوم بتعديل الكود كالتالي
RaiseEvent Change
End Sub
حيث أن الدالة RaiseEvent تقوم بربط الأحداث مع الأدوات الموجودة داخل ActiveX
ويمكن كتابة باقي الأحداث كالتالي
RaiseEvent Change
End Sub
Private Sub TxT_Click()
RaiseEvent Click
End Sub
Private Sub TxT_DblClick()
RaiseEvent DblClick
End Sub
Private Sub TxT_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
End Sub
Private Sub TxT_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
End Sub
Private Sub TxT_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub TxT_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
RaiseEvent MouseDown(Button, Shift, x, y)
End Sub
Private Sub TxT_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
RaiseEvent MouseMove(Button, Shift, x, y)
End Sub
Private Sub TxT_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
RaiseEvent MouseUp(Button, Shift, x, y)
End Sub
نعود الآن لإنشاء الخصائص الغير موجودة في ال Text القياسي
قبل البدأ بإنشاء هذه الخصائص دعونا نضع قائمة باسم هذه الخصائص ووظيفتها
ActiveBackGround : لون خلفية الText في حالة التركيز
InactiveBackGround : لون خلفية ال Text في حالة إزالة التركيز
ActiveForeGround : لون الخط في ال Text في حالة التركيز
InactiveForeGround : لون الخط في ال Text في حالة إزالة التركيز
ActiveFrame : لون الإطار في حالة التركيز
InactiveFrame : : لون الإطار في حالة إزالة التركيز
InputType : نوع المدخلات في ال Text وهي إما أرقام وحروف معاً أو حروف فقط أو أرقام فقط
SelectCase : وهي لنوع خط اللغة الإنجليزية وهي إما أحرف كبيرة وصغية معاً أو أحرف كبيرة فقط أو أحرف صغيرة فقط
UseSpace : وهي لاستخدام الفراغ في ال Text او عدمه وهي قيمة منطقية إما True أو False
أول خطوة نقوم بكتابة ال Enum لكل من InputType و SelectCase كما يلي في ال General
Public Enum sSelectCase
Mixedcase = 0
LowerCase = 1
UpperCase = 2
End Enum
Public Enum sInputType
AlfaNum = 0
Alfa = 1
Num = 2
End Enum
ونقوم بتعريف المتغيرات التالية في ال General أيضاً
Dim m_InactiveFrame As OLE_COLOR
Dim m_ActiveForeGround As OLE_COLOR
Dim m_ActiveBackGround As OLE_COLOR
Dim m_InactiveForeGround As OLE_COLOR
Dim m_InactiveBackGround As OLE_COLOR
حيث OLE_COLOR لجلب ألوان النظام
نبدأ بخصائص الألوان أولاً
نقوم بإنشاء خاصية ActiveBackGround كما يلي
ActiveBackGround = m_ActiveBackGround
End Property
Public Property Let ActiveBackGround(ByVal New_ActiveBackGround As OLE_COLOR)
m_ActiveBackGround = New_ActiveBackGround
PropertyChanged "ActiveBackGround"
End Property
وكذلك باقي خصائص الألوان كما يلي
ActiveForeGround = m_ActiveForeGround
End Property
Public Property Let ActiveForeGround(ByVal New_ActiveForeGround As OLE_COLOR)
m_ActiveForeGround = New_ActiveForeGround
PropertyChanged "ActiveForeGround"
End Property
Public Property Get InactiveForeGround() As OLE_COLOR
InactiveForeGround = m_InactiveForeGround
End Property
Public Property Let InactiveForeGround(ByVal New_InactiveForeGround As OLE_COLOR)
m_InactiveForeGround = New_InactiveForeGround
PropertyChanged "InactiveForeGround"
End Property
Public Property Get InactiveBackGround() As OLE_COLOR
InactiveBackGround = m_InactiveBackGround
End Property
Public Property Let InactiveBackGround(ByVal New_InactiveBackGround As OLE_COLOR)
m_InactiveBackGround = New_InactiveBackGround
PropertyChanged "InactiveBackGround"
End Property
Public Property Get ActiveFrame() As OLE_COLOR
ActiveFrame = m_ActiveFrame
End Property
Public Property Let ActiveFrame(ByVal New_ActiveFrame As OLE_COLOR)
m_ActiveFrame = New_ActiveFrame
PropertyChanged "ActiveFrame"
End Property
Public Property Get InactiveFrame() As OLE_COLOR
InactiveFrame = m_InactiveFrame
End Property
Public Property Let InactiveFrame(ByVal New_InactiveFrame As OLE_COLOR)
m_InactiveFrame = New_InactiveFrame
PropertyChanged "InactiveFrame"
End Property
قمنا بإنشاء هذه الخصائص لكن كيف يمكن الإستفادة منها
الجواب : باستخدام حدثي GotFocus و LostFocus حيث نقوم بتعديل هذين الحدثين كما يلي
DrawLine m_ActiveFrame
TxT.BackColor = m_ActiveBackGround
TxT.ForeColor = m_ActiveForeGround
End Sub
حيث أنه في حالة التركيز نقوم باستدعاء الإجراء DrawLine حيث يأخذ لون الإطار من المتغير m_ActiveFrame وفي السطريين التاليين يأخذ ال Text لون خلفيته من المتغير m_ActiveBackGround ولون الخط من المتغير m_ActiveForeGround
Private Sub TxT_LostFocus()
DrawLine m_InactiveFrame
TxT.BackColor = m_InactiveBackGround
TxT.ForeColor = m_InactiveForeGround
End Sub
حيث أنه في حالة إزالة التركيز نقوم باستدعاء الإجراء DrawLine حيث يأخذ لون الإطار من المتغير m_InactiveFrame وفي السطريين التاليين يأخذ ال Text لون خلفيته من المتغير m_InactiveBackGround ولون الخط من المتغير m_InactiveForeGround
نقوم بتعريف الثوابت التالية في ال General وهي لإعطاء قيم افتراضية عند إنشاء الأداة على الفورم
Const m_def_InactiveFrame = &HB99D7F
Const m_def_ActiveForeGround = &H80000008
Const m_def_ActiveBackGround = &H80000005
Const m_def_InactiveForeGround = &H80000008
Const m_def_InactiveBackGround = &H80000005
نقوم بتعديل حدث ReadProperties ليصبح هكذا
m_ActiveFrame = PropBag.ReadProperty("ActiveFrame", m_def_ActiveFrame)
m_InactiveFrame = PropBag.ReadProperty("InactiveFrame", m_def_InactiveFrame)
Alignment = PropBag.ReadProperty("Alignment", 0)
DragMode = PropBag.ReadProperty("DragMode", 0)
OLEDragMode = PropBag.ReadProperty("OLEDragMode", 0)
Enabled = PropBag.ReadProperty("Enabled", True)
Set Font = PropBag.ReadProperty("Font", Ambient.Font)
PasswordChar = PropBag.ReadProperty("PasswordChar", "")
Text = PropBag.ReadProperty("Text", Ambient.DisplayName)
Locked = PropBag.ReadProperty("Locked", False)
MaxLength = PropBag.ReadProperty("MaxLength", 0)
SelStart = PropBag.ReadProperty("SelStart", 0)
SelText = PropBag.ReadProperty("SelText", "")
SelLength = PropBag.ReadProperty("SelLength", 0)
ToolTip = PropBag.ReadProperty("ToolTip", "")
m_ScrollBars = PropBag.ReadProperty("ScrollBars", 0)
m_ActiveForeGround = PropBag.ReadProperty("ActiveForeGround", m_def_ActiveForeGround)
m_ActiveBackGround = PropBag.ReadProperty("ActiveBackGround", m_def_ActiveBackGround)
m_InactiveForeGround = PropBag.ReadProperty("InactiveForeGround", m_def_InactiveForeGround)
m_InactiveBackGround = PropBag.ReadProperty("InactiveBackGround", m_def_InactiveBackGround)
End Sub
وحدث WriteProperties ليصبح كما يلي
Call PropBag.WriteProperty("ActiveFrame", m_ActiveFrame, m_def_ActiveFrame)
Call PropBag.WriteProperty("InactiveFrame", m_InactiveFrame, m_def_InactiveFrame)
Call PropBag.WriteProperty("Alignment", Alignment, 0)
Call PropBag.WriteProperty("DragMode", DragMode, 0)
Call PropBag.WriteProperty("OLEDragMode", OLEDragMode, 0)
Call PropBag.WriteProperty("Enabled", Enabled, True)
Call PropBag.WriteProperty("Font", Font, Ambient.Font)
Call PropBag.WriteProperty("PasswordChar", PasswordChar, "")
Call PropBag.WriteProperty("Text", Text, Ambient.DisplayName)
Call PropBag.WriteProperty("Locked", Locked, False)
Call PropBag.WriteProperty("MaxLength", MaxLength, 0)
Call PropBag.WriteProperty("SelStart", SelStart, 0)
Call PropBag.WriteProperty("SelText", SelText, "")
Call PropBag.WriteProperty("SelLength", SelLength, 0)
Call PropBag.WriteProperty("ToolTip", ToolTip, "")
Call PropBag.WriteProperty("ScrollBars", m_ScrollBars, 0)
Call PropBag.WriteProperty("ActiveForeGround", m_ActiveForeGround, m_def_ActiveForeGround)
Call PropBag.WriteProperty("ActiveBackGround", m_ActiveBackGround, m_def_ActiveBackGround)
Call PropBag.WriteProperty("InactiveForeGround", m_InactiveForeGround, m_def_InactiveForeGround)
Call PropBag.WriteProperty("InactiveBackGround", m_InactiveBackGround, m_def_InactiveBackGround)
End Sub
وحدث InitProperties ليصبح كما يلي
Text = Ambient.DisplayName
m_ActiveFrame = m_def_ActiveFrame
m_InactiveFrame = m_def_InactiveFrame
m_ActiveForeGround = m_def_ActiveForeGround
m_ActiveBackGround = m_def_ActiveBackGround
m_InactiveForeGround = m_def_InactiveForeGround
m_InactiveBackGround = m_def_InactiveBackGround
End Sub
وحدث Show ليصبح كما يلي
DrawLine m_InactiveFrame
Text = Ambient.DisplayName
ScrollBars = m_ScrollBars
End Sub
وحدث Resize ليصبح كالتالي
On Error Resume Next
With UserControl
TxT.Width = .Width - 25
TxT.Height = .Height - 25
TxT.left = 10
TxT.Top = 10
End With
DrawLine m_InactiveFrame
End Sub
حمل المثال من هنا
الآن بقي خاصية SelectCase و InputType و UseSpace
يلزمنا في هذا دالتي Api وثوابتهما وهما التاليتين
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const ES_UPPERCASE = &H8
Private Const ES_LOWERCASE = &H10
نقوم بتعريف المتغيرات التالي في ال General
Dim m_InputType As sInputType
Dim m_UseSpace As Boolean
Dim m_SelectCase As sSelectCase
لنبدأ بخاصية SelectCase أولا نقوم بإنشاء إجراء فلنسميه GetCase ونبرمجه كما يلي
Dim Upper As Long
Dim Lower As Long
Select Case m_SelectCase
Case Mixedcase
Exit Sub
Case LowerCase
Lower = GetWindowLong(TxT.hwnd, GWL_STYLE)
Lower = Lower Or ES_LOWERCASE
SetWindowLong TxT.hwnd, GWL_STYLE, Lower
Case UpperCase
Upper = GetWindowLong(TxT.hwnd, GWL_STYLE)
Upper = Upper Or ES_UPPERCASE
SetWindowLong TxT.hwnd, GWL_STYLE, Upper
End Select
End Sub
نقوم الآن بإنشاء خاصية SelectCase كما يلي
SelectCase = m_SelectCase
GetCase
End Property
Public Property Let SelectCase(ByVal New_SelectCase As sSelectCase)
m_SelectCase = New_SelectCase
GetCase
PropertyChanged "SelectCase"
End Property
الآن انتهينا من خاصية SelectCase
والآن خاصية InputType كما في الخصائص السابقة نقوم بإنشاء خاصية InputType ونبرمجها لتصبح كما في الشكل التالي
InputType = m_InputType
End Property
Public Property Let InputType(ByVal New_InputType As sInputType)
m_InputType = New_InputType
PropertyChanged "InputType"
End Property
الآن بعد كتابة خاصية InputType كيف يمكن الإستفادة منها
الجواب باستخدام حدث KeyPress الخاص بالText وبحيث يصبح حدث KeyPress كما يلي
Private Sub TxT_KeyPress(KeyAscii As Integer)
If InputType = Num Then
Select Case KeyAscii
Case 48 To 58
Case 8, 13, 27, 44, 46
Case 45
If Len(Trim$(TxT.Text)) > 0 Then
KeyAscii = 0
Exit Sub
End If
Case 24, 3
Case 22
If Not IsNumeric(Clipboard.GetText) Then Clipboard.Clear
Case Else
KeyAscii = 0
End Select
ElseIf InputType = Alfa Then
Select Case KeyAscii
Case 48 To 58
KeyAscii = 0
Case 8, 13, 27, 44, 46
End Select
End If
RaiseEvent KeyPress(KeyAscii)
End Sub
حيث أنه في حالة اختيار أرقام فقط فإن المفاتيح التي ستبقى تعمل هي
الأرقام من 0 إلى 9 ومفتاح BackSpace وEnter و Esc و الفاصلة العشرية واختصارات النسخ واللصق والقص
وفي حالة اختيار حروف فقط فإنه عند الضغط على فإنه سيمنع كتابة الأرقام
الآن نأتي لآخر خاصية وهي خاصية UseSpace نقوم بإنشاء خاصية UseSpace كالتالي
UseSpace = m_UseSpace
End Property
Public Property Let UseSpace(ByVal New_UseSpace As Boolean)
m_UseSpace = New_UseSpace
PropertyChanged "UseSpace"
End Property
وهذه الخاصية أيضاً باستخدام حدث KeyPress حيث نقوم بتعديل حدث KeyPress ليصبح كالتالي
If InputType = Num Then
Select Case KeyAscii
Case 48 To 58
Case 8, 13, 27, 44, 46
Case 45
If Len(Trim$(TxT.Text)) > 0 Then
KeyAscii = 0
Exit Sub
End If
Case 24, 3
Case 22
If IsNumeric(Clipboard.GetText) = False Then Clipboard.Clear 'if not numeric
Case Else
KeyAscii = 0
End Select
ElseIf InputType = Alfa Then
Select Case KeyAscii
Case 48 To 58
KeyAscii = 0
Case 8, 13, 27, 44, 46
End Select
End If
If m_UseSpace = True Then
Exit Sub
ElseIf m_UseSpace = False Then
If KeyAscii = 32 Then
KeyAscii = 0
End If
End If
RaiseEvent KeyPress(KeyAscii)
End Sub
حيث أنه في حالة اختيار القيمة True للخاصية فإنه سيخرج من الإجراء دون تغيير شيء أما في حالة اختيار القيمة False للخاصية فإنه سيمنع المستخدم من استخدام مفتاح ال BackSpace
نقوم بتعديل حدث Show للUsercontrol كما يلي
DrawLine m_InactiveFrame
Text = Ambient.DisplayName
ScrollBars = m_ScrollBars
SelectCase = m_SelectCase
End Sub
وحدث ReadProperties كما يلي
m_ActiveFrame = PropBag.ReadProperty("ActiveFrame", m_def_ActiveFrame)
m_InactiveFrame = PropBag.ReadProperty("InactiveFrame", m_def_InactiveFrame)
Enabled = PropBag.ReadProperty("Enabled", True)
Set Font = PropBag.ReadProperty("Font", Ambient.Font)
PasswordChar = PropBag.ReadProperty("PasswordChar", "")
Text = PropBag.ReadProperty("Text", Mid(Ambient.DisplayName, 1))
Alignment = PropBag.ReadProperty("Alignment", 0)
Locked = PropBag.ReadProperty("Locked", False)
MaxLength = PropBag.ReadProperty("MaxLength", 0)
SelStart = PropBag.ReadProperty("SelStart", 0)
SelText = PropBag.ReadProperty("SelText", "")
SelLength = PropBag.ReadProperty("SelLength", 0)
DragMode = PropBag.ReadProperty("DragMode", 0)
ToolTip = PropBag.ReadProperty("ToolTip", "")
m_InputType = PropBag.ReadProperty("InputType", 0)
m_ScrollBars = PropBag.ReadProperty("ScrollBars", 0)
m_SelectCase = PropBag.ReadProperty("SelectCase", 0)
m_UseSpace = PropBag.ReadProperty("UseSpace", True)
m_ActiveForeGround = PropBag.ReadProperty("ActiveForeGround", m_def_ActiveForeGround)
m_ActiveBackGround = PropBag.ReadProperty("ActiveBackGround", m_def_ActiveBackGround)
m_InactiveForeGround = PropBag.ReadProperty("InactiveForeGround", m_def_InactiveForeGround)
m_InactiveBackGround = PropBag.ReadProperty("InactiveBackGround", m_def_InactiveBackGround)
End Sub
وحدث WriteProperties كما يلي
Call PropBag.WriteProperty("ActiveFrame", m_ActiveFrame, m_def_ActiveFrame)
Call PropBag.WriteProperty("InactiveFrame", m_InactiveFrame, m_def_InactiveFrame)
Call PropBag.WriteProperty("Enabled", Enabled, True)
Call PropBag.WriteProperty("Font", Font, Ambient.Font)
Call PropBag.WriteProperty("PasswordChar", PasswordChar, "")
Call PropBag.WriteProperty("Text", Text, Mid(Ambient.DisplayName, 1))
Call PropBag.WriteProperty("Alignment", Alignment, 0)
Call PropBag.WriteProperty("Locked", Locked, False)
Call PropBag.WriteProperty("MaxLength", MaxLength, 0)
Call PropBag.WriteProperty("SelStart", SelStart, 0)
Call PropBag.WriteProperty("SelText", SelText, "")
Call PropBag.WriteProperty("SelLength", SelLength, 0)
Call PropBag.WriteProperty("DragMode", DragMode, 0)
Call PropBag.WriteProperty("ToolTip", ToolTip, "")
Call PropBag.WriteProperty("InputType", m_InputType, 0)
Call PropBag.WriteProperty("ScrollBars", m_ScrollBars, 0)
Call PropBag.WriteProperty("SelectCase", m_SelectCase, 0)
Call PropBag.WriteProperty("UseSpace", m_UseSpace, True)
Call PropBag.WriteProperty("ActiveForeGround", m_ActiveForeGround, m_def_ActiveForeGround)
Call PropBag.WriteProperty("ActiveBackGround", m_ActiveBackGround, m_def_ActiveBackGround)
Call PropBag.WriteProperty("InactiveForeGround", m_InactiveForeGround, m_def_InactiveForeGround)
Call PropBag.WriteProperty("InactiveBackGround", m_InactiveBackGround, m_def_InactiveBackGround)
End Sub
بهذا نكون قد انتهينا من تصميم الأداة لكن أحياناً مصمم الأداة يريد أن يحفظ حقوق الأداة بوضع خانة About في صندوق الخصائص كما في الصورة التالية
كيف يمكن جلب هذه الخانة
الجواب كالتالي قم بإنشاء إجراء وقم بتسميته بإسم About مثلاً واكتب به اكتب به الكود الذي تريده كأن تظهر MsgBox او أن تستدعي Form هنا سأقوم بإظهار Form فيصبح الإجراء كالتالي طبعاً Sniper هو اسم الفورم الذي قمت بإنشائه
Sniper.Show 1, Me
End Sub
لكن لو نظرت الى صندوق الخصائص فالخانة لم تظهر بعد إذن ما العمل ؟؟؟؟؟؟
خطوات إظهار خانة About كالتالي إذهب الى قائمة Tools اختر منها Procedure Attributes ستظهر لنا نافذة من خيار Name نختار الإجراء الذي أنشأناه وهو إجراء About ثم نضغط على زر Advanced من خيار Procedure ID نختار AboutBox ثم نضغط OK سوف تلاحظ ظهور خاصية About في خصائص الأداة.
بذلك نكون قد انتهينا من برمجة الأداة
حمل المثال من هنا
ال PageProperty
أحيانا قد يحتاج المبرمج لوضع خانة Custom كما في الصورة التالية
حيث أن هذه الخانة تسخدم لإظهار صفحات الخصائص كما في الصورة التالية والتي تسهّل على المستخدم ضبط الخصائص
لكن الذي يجب أن تعرفه أن هنالك PropertyPage قياسية تأتي ضمن برنامج الفيجوال بيسك وهناك PropertyPage يقوم المبرمج بتصميمها ونحن سنقوم باستخدام PropertyPage قياسية وهي الموجودة في الأعلى لحجم ونوع الخط وسنقوم بتصميم PropertyPage خاصة بنا لأداة ال Text
بدأ التصميم
لإضافة PropertyPage جديدة إذهب إلى قائمة Project واختر منها الخيار التالي كما في الصورة
ثم
ثم اضغط Ok ولنقم بتسميتها باسم Setting
سنحتاج في هذه PropertyPage أداة CommonDialog و 10 Label و 4 ComboBox و3 CheckBox و 6 Command و 6 PictureBox و 2 Frame
اضبط خاصية
وقم بإعادة تسمية أدوات ال ComboBox كما يلي
Combo1 : xSelectCase
Combo2 : xInputType
Combo3: xAlignment
Combo4 : xScrollBars
ورتب الأدوات على ال PropertyPage لتصبح كما في الصورة التالية
أهم خصائص وأحداث PropertyPage
خاصية Changed (قيمة منطقية) ووظيفتها تحديد إذا ما أراد المستخدم تغيير الخاصية من خلال ال PropertyPage أم لا
حدث ApplyChanges ويتم تشغيل هذا الحدث عندما ينقر المستخدم على زر موافق أو بتبديل علامات التبويب في PropertyPage التي تتألف من عدة صفحات حيث أن هذا الحدث يقوم بإعطاء خصائص ال Text قيمها من القيم الموجودة في الPropertyPage
حدث SelectionChanged ويتم تشغيل هذا الحدث عند النقر على خانة Custom حيث يتم إعطاء الأداة المربوطة بخاصية معينة قيمتها من تلك الخاصية
حدث Initialize وهو يعمل عند تشغيل الPropertyPage فمثلا سنستخدمه لملئ صناديق الComboBox بالخيارات
كما في الكود التالي
xSelectCase.AddItem "MixedCase"
xSelectCase.AddItem "LowerCase"
xSelectCase.AddItem "UpperCase"
xInputType.AddItem "AlfaNum"
xInputType.AddItem "Alfa"
xInputType.AddItem "Num"
xAlignment.AddItem "Alignleft"
xAlignment.AddItem "AlignRight"
xAlignment.AddItem "AlignCenter"
xScrollBars.AddItem "None"
xScrollBars.AddItem "Horiziontal"
xScrollBars.AddItem "Vertical"
xScrollBars.AddItem "Both"
End Sub
لنبدأ الآن ببرمجة ال PropertyPage
فمثلا لتبديل خاصية SelectCase نضغط DblClick على الCombo الخاص بهذه الخاصية ولأننا نريد تغيير الخاصية من خلال ال PropertyPage فإننا نضع قيمة الخاصية Changed = True في حدث Click للأداة فيصبح الكود كالتالي
Changed = True
End Sub
ولإعطاء قيمة ال Combo للخاصية المرتبط بها نضع الكود التالي في حدث ApplyChanges كما يلي
SelectedControls(0).SelectCase = xSelectCase.ListIndex
End Sub
ولإعطاء ال ComboBox قيمته من الخاصية الخاصة به عند فتح ال PropertyPage نضع الكود التالي في حدث SelectionChanged كما يلي
xSelectCase.ListIndex = SelectedControls(0).SelectCase
End Sub
وباقي الأدوات بنفس الطريقة كما يلي
Changed = True
End Sub
Private Sub Check2_Click()
Changed = True
End Sub
Private Sub Check3_Click()
Changed = True
End Sub
Private Sub Check4_Click()
Changed = True
End Sub
Private Sub xAlignment_Click()
Changed = True
End Sub
Private Sub xInputType_Click()
Changed = True
End Sub
Private Sub xScrollBars_Click()
Changed = True
End Sub
Private Sub xSelectCase_Click()
Changed = True
End Sub
لكن يبقى كيفية تغيير اللون
الطريقة كالتالي بإظهار شاشة إنتقاء اللون من خلال أداة الCommonDialog فتأخذ أداة ال PictureBox اللون من أداة الCommonDialog ونقوم بإعطاء الخاصية التي نريد تغييرها كما يلي نضع في زر الأمر الكود التالي
CD.ShowColor
Pic1.BackColor = CD.Color
ActiveBackGround = CD.Color
Changed = True
End Sub
وفي حدث ApplyChanges كالتالي
SelectedControls(0).ActiveBackGround = Pic1.BackColor
End Sub
وفي حدث SelectionChanged كالتالي
Pic1.BackColor = SelectedControls(0).ActiveBackGround
End Sub
وبالنهاية يصبح حدث ApplyChanges كالتالي
SelectedControls(0).ActiveBackGround = Pic1.BackColor
SelectedControls(0).ActiveForeGround = Pic2.BackColor
SelectedControls(0).ActiveFrame = Pic3.BackColor
SelectedControls(0).InactiveBackGround = Pic4.BackColor
SelectedControls(0).InactiveForeGround = Pic5.BackColor
SelectedControls(0).InactiveFrame = Pic6.BackColor
SelectedControls(0).UseSpace = IIf(Check1.Value = 1, True, False)
SelectedControls(0).Enabled = IIf(Check3.Value = 1, True, False)
SelectedControls(0).Locked = IIf(Check4.Value = 1, True, False)
SelectedControls(0).SelectCase = xSelectCase.ListIndex
SelectedControls(0).InputType = xInputType.ListIndex
SelectedControls(0).Alignment = xAlignment.ListIndex
SelectedControls(0).ScrollBars = xScrollBars.ListIndex
End Sub
وحدث SelectionChanged كالتالي
Pic1.BackColor = SelectedControls(0).ActiveBackGround
Pic2.BackColor = SelectedControls(0).ActiveForeGround
Pic3.BackColor = SelectedControls(0).ActiveFrame
Pic4.BackColor = SelectedControls(0).InactiveBackGround
Pic5.BackColor = SelectedControls(0).InactiveForeGround
Pic6.BackColor = SelectedControls(0).InactiveFrame
Check1.Value = IIf(SelectedControls(0).UseSpace = True, 1, 0)
Check3.Value = IIf(SelectedControls(0).Enabled = True, 1, 0)
Check4.Value = IIf(SelectedControls(0).Locked = True, 1, 0)
xSelectCase.ListIndex = SelectedControls(0).SelectCase
xInputType.ListIndex = SelectedControls(0).InputType
xAlignment.ListIndex = SelectedControls(0).Alignment
xScrollBars.ListIndex = SelectedControls(0).ScrollBars
End Sub
الآن بقيت خطوة بسيطة لكيفية ربط ال PropertyPage بال UserControl إذهب ال خصائص ال UserControl واختر خاصية PropertyPages اضغط عليها ستظهر لك نافذة كما في الصورة التالية
كما في الصورة
ثم
القائمة الموجودة في الصفحة هي مجموعة من PropertyPages القياسية التي تأتي مع برنامج الفيجوال بيسك بالإضافة الى الصفحة التي صممناها بإسم Setting ما يلزمنا هي الصفحة التي صممناها وصفحة تغيير الخط واضغط OK
ملاحظة :يمكنك تغيير عرض الصفحات من حيث الصفحة التي ستظهر في البداية من خلال الأسهم اللتي تظهر في الصورة السابقة
والخطوة الأخيرة هي تحويل أداة ال UserControl إلى أداة OCX يمكن استخدامها في أي برنامج والمسألة بسيطة حدد المشروع الظاهر في الصورة واذهب الى قائمة File واختر الخيار الظاهر في الصورة
ثم
حمل المثال النهائي من هنا
أرجو أن أكون قد وفقت في الشرح
تحياتي لكم جميعاً
شارك هذا الرد
رابط المشاركة
شارك الرد من خلال المواقع ادناه