تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
مقتطفات برمجية
#1
السلام عليكم...

هذه مجموعة أكواد عامة قد نحتاجها من حين إلى آخر في برامجنا. معظمها أكواد قصيرة، و ربما يكون بعضها متوسط الطول.

(لا تلوموني على الإطالة، فهذه طبيعتي: إذا تعلق الأمر بالبرمجة فإني أحب أن يكون كل شيء واضحاً)

= تظليل أو تحديد كامل النص عند دخول المؤشر إلى مربع النص:
تفتقر بعض مكونات VB6 إلى العديد من المزايا التي نراها في الكثير من البرامج الحديثة. مثلاً في معظم البرامج، عندما ننتقل بين المكونات باستعمال المفتاح TAB فإنه عند الانتقال إلى مربع نص يتم تلقائياً تحديد أو تظليل كل النص في ذلك المربع.
لإنجاز ذلك برمجياً ضع الإجراء التالي في Module:

كود :
Public Sub SelectAll(ATextBox As Control)
    If TypeOf ATextBox Is TextBox Then
        ATextBox.SelStart = 0
        ATextBox.SelLength = Len(ATextBox.Text)
    End If
End Sub

ثم في إجراء الحدث GotFocus لأي مربع نص تريد تظليله عند الدخول إليه اكتب السطر التالي:

كود :
SelectAll text_box_name

حيث text_box_name هو اسم مرع النص، مثلاً:

كود :
Private Sub Text2_GotFocus()
    SelectAll Text2
End Sub

= تحريك النافذة من أي جزء على سطحها:
نلاحظ هذه الميزة في نوافذ العديد من البرامج، خاصة النوافذ ذات الحجم الثابت.
نضع التصريحات التالية في Module:

كود :
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

Public Declare Function ReleaseCapture Lib "user32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

ثم في إجراء الحدث MouseDown للنافذة:

كود :
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Me.Hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0
End Sub

= إصدار صوت تنبيه:
قد تحتاج لإصدار صوت تنبيه للفت انتباه المستخدم مثلاً إلى ضرورة إدخال بيانات ضرورية، أو عند انتهاء عملية طويلة أو ... إلخ. طبعاً يمكنك ذلك باستخدام الوسائط المتعددة (Multimedia) مثلاً بتشغيل ملف wav باستخدام الدالة sndPlaySound أو استعمال ملف مع MediaPlayer أو RealPlayer مخفي، لكن ذلك يعتمد على ملفات خارجية، كما أنه إهدار لموارد النظام إذا كان الغرض فقط هو إصدار بضعة أصوات للتنبيه.
يمكننا الاستفادة من الدالة Beep (من دوال API التابعة للنظام Windows) لإصدار نغمات معينة نتحكم نحن بها، و أيضاً سيتم إصدارها من مكبر الصوت الداخلي (Internal Speaker) إذا لم تكن هناك بطاقة صوت (Sound Card) معرفة.

ضع التصريح التالي في Module:

كود :
Private Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

و اكتب الإجراء التالي أيضاً في الـ Module:

كود :
Public Sub PlayAlarm()
    Beep 500, 250
    Beep 1000, 250
    Beep 1500, 500
End Sub

و كما نلاحظ فإن الدالة Beep تأخذ بارامترين:
- البارامتر dwFreq: يحدد تردد النغمة (Frequency) و هو يقبل قيماً بين 37 و 32767. فكلما زاد التردد زادت حدة النغمة، و كلما نقص التردد أصبحت النغمة أقل حدة (غليظة).
- البارامتر dwDuration: يحدد مدة النغمة بالملي ثانية.

طبعاً يمكنك تغيير القيم في الإجراء PlayAlarm كما تشاء و تزيد عليها، و إذا كنت تفهم في التلحين الموسيقي فستصنع نغمات رائعة! Idea

= معرفة ما إذا كانت المصفوفة فارغة (لا تحتوي على عناصر) أم لا:
معظمنا يعرف أن VB6 تدعم المصفوفات الديناميكية (Dynamic Arrays) و هي المصفوفات التي يمكن تغيير عدد عناصرها، و ذلك بتعريف المصفوفة في البداية دون تحديد عدد العناصر:

كود :
Dim MyArray() As Integer

طبعاً As Integer فقط للتوضيح، حيث يمكن أن تكون المصفوفة من أي نوع. و بعد ذلك، عندما نريد تحديد عدد عناصر المصفوفة نستعمل عبارة ReDim، مثلاً:

كود :
Dim MyArray(1 To 100) As Integer

(مع ReDim يكون الجزء As Integer أو أي نوع اختيارياً، لكن إذا استعملناه فلابد أن يكون نفسه المستعمل مع Dim الأولى).
و يمكننا بعد ذلك أيضاً إعادة تحديد حجم المصفوفة بالزيادة أو النقصان في عدد عناصرها (باستعمال ReDim مرات و مرات).
أين المشكلة؟ قد تحتاج أحياناً إلى معرفة ما إذا كانت المصفوفة فارغة (لا تحتوي على عناصر) أم لا. سيقول البعض استعمل الدالة UBound أو الدالة LBound - خطأ Confused : لأن الدالة LBound تعطي أصغر مؤشر عنصر للمصفوفة، و الدالة UBound تعطي أكبر مؤشر عنصر للمصفوفة، و في VB6 فإن مؤشرات المصفوفة قد تكون سالبة أو موجبة. يعني إذا أعادت الدالة UBound مثلاً القيمة 0 فلا يعني ذلك أن المصفوفة فارغة، و إنما يعني أنها ربما تم تحديد عناصرها كالتالي مثلاً:

كود :
ReDim MyArray(-9 To 0)    // عشرة عناصر، و أكبر مؤشر فيها هو الصفر

بالإضافة إلى ذلك - و هو الأهم - أنه إذا كانت المصفوفة فارغة (لا تحتوي على عناصر) فإن استعمال UBound أو LBound سيتسبب في حدوث خطأ و إغلاق البرنامج.
يحدث خطأ؟؟ ألا يوحي ذلك بشيء Huh - نعم! ذلك يعني أننا أمام حالة اختبار نموذجية: إذا حدث خطأ فالمصفوفة فارغة، و إذا لم يحدث خطأ فالمصفوفة غير فارغة.

إذن ما علينا سوى اقتناص الخطأ (باستعمال جملة On Error GoTo) لمنع انهيار البرنامج، و نعيد قيمة مناسبة للحالة.

الخلاصة: ضع تعريف الدالة التالية في Module:

كود :
Public Function IsEmptyArray(AArray As Variant) As Boolean
    Dim AnyVar As Long
    
    If Not IsArray(AArray) Then
        Err.Raise 1001 + vbObjectError, App.EXEName & ".IsEmptyArray", "The passed parameter is not an array"
    End If
    
    On Error GoTo IsEmptyArray_Err
    AnyVar = UBound(AArray)
    IsEmptyArray = False
    Exit Function
    
IsEmptyArray_Err:
    IsEmptyArray = True
End Function

و لتجربة الأمر نضع زر أمر (Command) على النافذة و نكتب فيه الكود التالي:

كود :
Private Sub Command1_Click()
    Dim MyArray() As Integer        ' المصفوفة الآن فارغة
    
    If IsEmptyArray(MyArray) Then
        MsgBox "Array is empty"            ' سيعرض هذه الرسالة
    Else
        MsgBox "Array is NOT empty"
    End If
    
    ReDim MyArray(1 To 10)        ' المصفوفة الآن أصبحت غير فارغة
    
    If IsEmptyArray(MyArray) Then
        MsgBox "Array is empty"
    Else
        MsgBox "Array is NOT empty"            ' سيعرض هذه الرسالة
    End If
    
    Erase MyArray            ' تفريغ المصفوفة من جديد - حذف جميع عناصرها
    
    If IsEmptyArray(MyArray) Then
        MsgBox "Array is empty"            ' سيعرض هذه الرسالة
    Else
        MsgBox "Array is NOT empty"
    End If
End Sub

بصراحة لقد تعمدت وضع هذه الفقرة و توسيع الشرح قليلاً لأبين أمراً - أنا شخصياً أستعمله في بعض الحالات - و هو أنه يمكن أحياناً الاستفادة من أخطاء وقت التشغيل (Run-time Errors) و ذلك باقتناصها (Error Trapping) للحصول على معلومة أو الوصول إلى وضعية معينة.

من ناحية أخرى، و ضمن الموضوع نفسه، فإنه يمكن معرفة ما إذا كانت المصفوفة فارغة أم لا بطرق أخرى:

- مثلاً هذا الاختبار العجيب! فرغم أن شكله و معناه غير واضح فإنه يفي بالمطلوب:

كود :
If (Not MyArray()) = -1 then
    MsgBox "Array is empty"
Else
    MsgBox "Array is NOT empty"
End If

حيث التعبير ()Not MyArray يعيد -1 إذا كانت المصفوفة فارغة!!

- كذلك يمكن استعمال إحدى دوال API للكشف عن المصفوفة:

كود :
Private Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long

If SafeArrayGetDim(yourarray) > 0 Then
    MsgBox "Array is NOT empty"
Else
    MsgBox "Array is empty"
End If

Angry يبقى بتنفخ رؤوسنا لييييه Angry

= البحث من داخل البرنامج في "غوغل" أو "جوجل" أو "كوكل" ... المهم Google:
نفرض أن لديك مربع نص (Text1) لكتابة نص البحث، و لديك زر (Command1) لتنفيذ أمر البحث:

أ. إذا كنت تستعمل المكون WebBrowser في برنامجك و تريد عرض نتائج البحث فيه فاستخدم الكود التالي:

كود :
Private Sub Command2_Click()
    Dim URL As String

    If Trim$(Text1.Text) = "" Then
        MsgBox "الرجاء إدخال نص البحث"
        Text1.SetFocus
    Else
        URL = "http://www.google.com/search?hl=ar&q=" & Trim$(Text1.Text)
        WebBrowser1.Navigate2 URL
    End If
End Sub

ب. أما إذا كنت تريد عرض نتائج البحث في المتصفح الافتراضي للمستخدم فضع التصريحين التاليين في قسم التصريحات العام للنافذة أو في Module (مع تغيير Private إلى Public):

كود :
Private Const SW_NORMAL = 1
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal Hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

و يكون كود الزر كالتالي:

كود :
Private Sub Command2_Click()
    Dim URL As String

    If Trim$(Text1.Text) = "" Then
        MsgBox "الرجاء إدخال نص البحث"
        Text1.SetFocus
    Else
        URL = "http://www.google.com/search?hl=ar&q=" & Trim$(Text1.Text)
        ShellExecute 0&, "open", URL, vbNullString, vbNullString, SW_NORMAL
    End If
End Sub

= معرفة ما إذا كانت مجموعة سجلات (ADODB.Recordset) فارغة (لا تحتوي على سجلات) أم لا:
أرى في العديد من الأكواد أنه يتم ذلك باختبار الخاصية RecordCount فإذا كانت تساوي صفراً فذلك يعني أنها فارغة.
هذا الأمر غير مضمون دائماً لأنه ليس كل محركات قواعد البيانات تدعم ذلك، و في هذه الحالة فإن الخاصية RecordCount قد تعيد 1 أو -1، و في بعض الحالات تتم - داخلياً - قراءة كافة السجلات إلى السجل الأخير من أجل احتساب العدد الفعلي للسجلات، و هذا قد يؤثر على موارد النظام إذا كان عدد السجلات بالآلاف أو الملايين.

يمكننا تجنب ذلك والحصول على نتيجة مؤكدة باستعمال الدالة التالية:

كود :
Public Function IsEmptyRecordSet(ARecordSet As ADODB.Recordset) As Boolean
    If ARecordSet Is Nothing Then
        IsEmptyRecordSet = True
    ElseIf ARecordSet.State <> adStateOpen Then
        IsEmptyRecordSet = True
    ElseIf ARecordSet.BOF And ARecordSet.EOF Then
        IsEmptyRecordSet = True
    Else
        IsEmptyRecordSet = False
    End If
End Function

حيث تعيد الدالة True إذا كانت الـ Recordset فارغة، و تعيد False إذا كانت الـ Recordset تحتوي على سجلات.

!! آسف على الإطالة !!

و للمتفرقات بقية إن شاء الله تعالى...

أرجو الاستفادة و السلام.
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
الرد }}}}
#2
السلام عليكم

الله يبارك فيك رائع

يعطيك العافية
شـــايـفـــك

الرد }}}}
تم الشكر بواسطة: aamalomari , ahmed3d , princeofislam
#3
السلام عليكم....

مقتطفات برمجية أخري...

= الحصول على اسم الحاسوب و اسم المستخدم الحالي:

ضع التصريحات و الدوال التالية في Module:

كود :
Private Const MAX_COMPUTERNAME_LENGTH As Long = 32&

Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

' دالة الحصول على اسم الكمبيوتر
Public Function GetMyComputerName() As String
    Dim BufferSize As Long
    Dim Buffer As String
    
    GetMyComputerName = ""
    
    Buffer = Space$(MAX_COMPUTERNAME_LENGTH + 1)
    BufferSize = Len(Buffer)
    If GetComputerName(Buffer, BufferSize) Then
        GetMyComputerName = Left$(Buffer, BufferSize)
    End If
End Function

' دالة الحصول على اسم المستخدم
Public Function GetCurrentUserName()
    Dim BufferSize As Long
    Dim Buffer As String
    
    GetCurrentUserName = ""
    
    Buffer = Space$(MAX_COMPUTERNAME_LENGTH + 1)
    BufferSize = Len(Buffer)
    If GetUserName(Buffer, BufferSize) Then
        GetCurrentUserName = Left$(Buffer, BufferSize)
    End If
End Function

* عندما تريد الحصول على اسم الحاسوب (الكمبيوتر) استعمل الدالة GetMyComputerName، مثلاً:

كود :
MsgBox GetMyComputerName()

* عندما تريد الحصول على اسم المستخدم استعمل الدالة GetCurrentUserName، مثلاً:
كود :
Dim UN As String
UN = GetCurrentUserName()
Text1.Text = UN

نرجو الاستفادة و السلام.
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
الرد }}}}
تم الشكر بواسطة: abulayth , VB_Coder , baderb14 , princeofislam , sendbad100 , sendbad100
#4
السلام عليكم...

= استعمال مؤشرات فأرة (Cursors) مخصصة، و المؤشرات المتحركة (Animated):

يمكن من خلال نافذة الخصائص ضبط شكل مؤشر الفأرة (Cursor أو Mouse Pointer) و ذلك باختيار أحد الأشكال المعرفة مسبقاً في VB6 و ذلك من خلال الخاصية MousePointer، و كذلك يمكننا استعمال مؤشرات من ملفات خارجية و ذلك بضبط الخاصية MousePointer على 99-Custom و استعمال الخاصية MouseIcon لتحديد ملف المؤشر (امتدادات الملفات الممكن استعمالها كمؤشرات للفأرة هي cur و ico).

هناك نوع آخر من المؤشرات و هي المؤشرات المتحركة (Animated Cursors) حيث يظهر مؤشر الفأرة على شكل له حركة... هذا النوع غير مدعوم في VB6، و لكن يمكننا استعمال دوال API من أجل استعمال تلك المؤشرات:

1. ضع التصريحات التالية في قسم التصريحات العام للـ Form. إذا أردت استعمالها في أكثر من نافذة فضعها في Module و غير Private إلى Public:

كود :
Private Const GCL_HCURSOR = (-12)

Private hOldCursor As Long

Private Declare Function LoadCursorFromFile Lib "user32" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

2. بفرض أننا نريد تغيير مؤشر الفأرة للمكون Text1. نضع الكود التالي في الحدث Load للـ Form:

كود :
Private Sub Form_Load()
    Dim hNewCursor As Long

    hNewCursor = LoadCursorFromFile("C:\Windows\Cursors\aero_working_l.ani")
    hOldCursor = SetClassLong(Text1.hwnd, GCL_HCURSOR, hNewCursor)
End Sub

* طبعاً بدل المسار C:\Windows\Cursors\aero_working_l.ani نضع مسار و اسم الملف الخاص بنا (تجد بعض ملفات المؤشرات المتحركة في المجلد Cursors ضمن المجلد Windows التابع للنظام).

3. في الحدث Unload للـ Form نكتب السطر التالي:

كود :
hOldCursor = SetClassLong(Text1.hwnd, GCL_HCURSOR, hOldCursor)

نرجو الاستفادة و السلام.
بِسْمِ اللهِ الرَّحْمَنِ الرَّحِيمِ ( وَ مَا تُقَدِّمُوا لِأَنفُسِكُم مِّنْ خَيْرٍ تَجِدُوهُ عِندَ اللهِ هُوَ خَيْراً وَ أَعْظَمَ أَجْراً ) صَدَقَ اللهُ الْعَظِيمُ
الرد }}}}
#5
مجهود رااااااااااائع جداً اكيد استفدت منه جزاك الله خير استاذ ناجى
سبحان الله وبحمده سبحان الله العظيم
آللهم لگ آلحمد حتى ترضى .. ولگ آلحمد إذا رضيِت .. ولگ آلحمد بعد آلرضآ
الرد }}}}
تم الشكر بواسطة: a_almisery , princeofislam
#6
بارك الله فيك

شرح ممتاز وجميلBlush
الرد }}}}
تم الشكر بواسطة: princeofislam
#7
شرح اكثر من رائع

جزاك الله كل خير

Big GrinBig GrinBig Grin

العاب من برمجتي  

Smile
الرد }}}}
تم الشكر بواسطة: princeofislam
#8
السلام عليكم ورحمة الله وبركاته

جزاك الله خيرا اخي العزيز

تحياتي
الرد }}}}
تم الشكر بواسطة: princeofislam
#9
السلام عليكم ورحمة الله وبركاته

ما اروعك اخى

جزاك الله كل الخير
الرد }}}}
تم الشكر بواسطة: princeofislam
#10
جــزاك الله خــيراً .. اســتاذ ناجـي



[صورة مرفقة: g5qidgW.jpg]

ســبحــانك الـلهم بـحمدك , الـلهم لا عــلم لـنا الى مــأ علــمتــنا , الـلهـم علــمنـا ما جــهلـنا وانــفـعنــا بــما عــلمــتنـا انــك انـتَ الـسـميع الــعلــيم الـحكـيم ~~!I!

الرد }}}}
تم الشكر بواسطة: princeofislam , Ksa004


التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم