منتديات ليلاس

منتديات ليلاس (https://www.liilas.com/vb3/index.php)
-   المواضيع المتفرقه للحاسوب (https://www.liilas.com/vb3/forumdisplay.php?f=427)
-   -   أكواد منوعة ومبتكرة للمبرمجين بالفيجوال بيسك (https://www.liilas.com/vb3/showthread.php?t=146348)

ak-spl 03-08-10 07:25 PM

أكواد منوعة ومبتكرة للمبرمجين بالفيجوال بيسك
 
هذه مجموعة أكواد مهمة وفنية وتسهل الكثير من الأعمال البرمجية في الفيجوال بيسك ، وهي من تصميمي ، أرجو أن ينتفع بها مبرمجينا الأعزاء ، هي هكذا تباعا :


1 - ( دالة وظيفية لتفصيل العدد في مراتبه بإضافة الفواصل ) :
حيث الإسم الإفتراضي لهذه الدالة يكون : NDT

حيث يوضع العدد أو المتغير العددي بين قوسين بعدها أثناء كتابتها في
النص البرمجي .

شرح مبسط عن مخرجات الدالة :

مثلا إدخال الآتي :
العدد : 1233948

فتخرج الدالة هذه النتيجة :
1,233,948

ملحوظة : هذا الكود لهذه الدالة يوضع في ( الفورم Form )
في منطقة ( الإعلانات العامة للفورم Declarations )


نص الكود :
Function Ndt(Number As Variant) As String

Z2$ = Format(Number, "Standard")' 1

Ndt = Left$(Z2$, Len(Z2$) - 3) ' 2

End Function

'

-------------------------------------------------------------------


2 - ( دالة وظيفية لإعطاء مقدار النسبة المئوية بين عددين ) :
حيث الإسم الإفتراضي لهذه الدالة يكون : Perc

حيث يوضع العددين أو المتغيرين العدديين بين قوسين بعدها أثناء كتابتها في النص البرمجي .

شرح مبسط عن مخرجات الدالة :

مثلا إدخال الآتي :
العدد الكلي أولا : 20
العدد الجزئي ثانيا : 5

فتخرج الدالة هذه النتيجة :
25
أي 25%

ملحوظة : هذا الكود لهذه الدالة يوضع في ( الفورم Form )
في منطقة ( الإعلانات العامة للفورم Declarations )


نص الكود :


Function Perc(N1 As Variant, N2 As Variant) As Double

If N2 <= N1 Then

N3 = (N2 / N1) * 100

Perc = Round(N3, 2) ''''' 3

Else

Perc = 0

End If

End Function
'

-------------------------------------------------------------------


3 - ( دالة وظيفية لتحديد مقدار عدد من نسبة مئوية معطاة ) :
حيث الإسم الإفتراضي لهذه الدالة يكون : PercN

حيث يوضع العددين أو المتغيرين العدديين بين قوسين بعدها أثناء كتابتها في النص البرمجي .

شرح مبسط عن مخرجات الدالة :

مثلا إدخال الآتي :
العدد النسبي المئوي المُراد أولا : 50 ، أي 50%
العدد الكلي ثانيا : 30

فتخرج الدالة هذه النتيجة :
15

ملحوظة : هذا الكود لهذه الدالة يوضع في ( الفورم Form )
في منطقة ( الإعلانات العامة للفورم Declarations )


نص الكود :

Function Perc(N1 As Variant, N2 As Variant) As Double

If N2 <= N1 Then

N3 = (N2 / N1) * 100

Perc = Round(N3, 2) ''''' 3

Else

Perc = 0

End If

End Function
'

-------------------------------------------------------------------


4 - ( دالة وظيفية لإضافة أصفار إلى يسار العدد) :
حيث الإسم الإفتراضي لهذه الدالة يكون : AddZero

حيث يوضع العدد أو المتغير العددي بين قوسين بعدها أثناء كتابتها في
النص البرمجي .

شرح مبسط عن مخرجات الدالة :

مثلا إدخال الآتي :
عدد خانات الأصفار : 4
العدد نفسه : 33

فتخرج الدالة هذه النتيجة :
0033

ملحوظة : هذا الكود لهذه الدالة يوضع في ( الفورم Form )
في منطقة ( الإعلانات العامة للفورم Declarations )


نص الكود :

Function AddZero(ZerosAdded As Integer, Number As Integer) As String

Z = ZerosAdded

M$ = CStr(Int(Number)): L = Len(M$) '' 1

C = Z - L

If L > Z Then Q$ = "" Else Q$ = String$(C, "0") '' 2

AddZero = Q$ + M$

End Function

'

-------------------------------------------------------------------

........ يتبع .........

ak-spl 05-08-10 02:31 PM


5 - ( دالة وظيفية لمعرفة إسم نوع الملف ( إسم الإمتداد ) ) :
حيث الإسم الإفتراضي لهذه الدالة يكون : Extn

حيث يوضع مسار أو عنوان الملف بين قوسين بعدها أثناء كتابتها في
النص البرمجي .

شرح مبسط عن مخرجات الدالة :

مثلا إدخال الآتي :
مسار أو عنوان الملف

فتخرج الدالة هذه النتيجة :
txt

وفي حال عدم وجود إسم نوع للملف تكون النتيجة هكذا :
Without Extension

ملحوظة : هذا الكود لهذه الدالة يوضع في ( الفورم Form )
في منطقة ( الإعلانات العامة للفورم Declarations )


نص الكود :


Function Extn(FileName As String) As String

LF = Len(FileName): S = InStr(1, FileName, ".") '' 1

F$ = UCase$(Mid$(FileName, S + 1, LF - S)) '' 2

If S = 0 Then F$ = "( Without Extension )" '' 3

Extn = F$ '' 4

End Function

'

-----------------------------------------------------------------------------------------------------


6 - ( دالة وظيفية لتحميل جميع البيانات دفعة واحدة من ملف تسلسلي ) :
حيث الإسم الإفتراضي لهذه الدالة يكون : GetAll

حيث يوضع مسار أو عنوان الملف بين قوسين بعدها أثناء كتابتها في
النص البرمجي .

شرح مبسط عن مخرجات الدالة :

مثلا إدخال الآتي :
مسار أو عنوان الملف

فتخرج الدالة جميع مايحتويه الملف من بيانات

ملحوظة : هذا الكود لهذه الدالة يوضع في ( الفورم Form )
في منطقة ( الإعلانات العامة للفورم Declarations )


نص الكود :

Function GetAll(FileName As String) As String

Open FileName For Append As 1: Close

If FileLen(FileName) <> 0 Then

Open FileName For Input As 1

P$ = Input$(LOF(1), 1) '' 1

Close

Else

P$ = "" '' 2

End If

GetAll = P$ '' 3

End Function

'

-----------------------------------------------------------------------------------------------------


7 - ( دالة وظيفية لتحويل التاريخ الميلادي إلى هجري ) :
حيث الإسم الإفتراضي لهذه الدالة يكون : HjDt

حيث توضع المتغيرات العددية بهذا الترتيب في الدالة :
رقم السنة أولا
رقم الشهر ثانيا
رقم اليوم ثالثا

شرح مبسط عن مخرجات الدالة :

مثلا إدخال الآتي :
2010
8
5

فتخرج الدالة هذه النتيجة :
25-8-1431

ملحوظة : هذا الكود لهذه الدالة يوضع في ( الفورم Form )
في منطقة ( الإعلانات العامة للفورم Declarations )

نص الكود :

Function HjDt(GY, GM, GD As Integer) As Date

D = DateSerial(GY, GM, GD) 'A

VBA.Calendar = vbCalHijri

HjDt = D

End Function

'

-----------------------------------------------------------------------------------------------------

------ يتبع ------

ak-spl 20-12-13 06:58 PM

رد: أكواد منوعة ومبتكرة للمبرمجين بالفيجوال بيسك
 
- 8- إجراء توليد صوت أو نغمة مع تحديد عدد تكرار الصوت .
حيث الإسم الإفتراضي لهذه الدالة يكون : SOUND ( X1 , X2 , X3 ) ' 0
حيث X1 رقم يحدد النغمة ، و X2 رقم يحدد قوة النغمة ، وx3 رقم يحدد عدد التكرار للصوت الخارج .


شرح مبسط عن عمل وإستدعاء الإجراء :
مثلا إريد توليد صوت أو نغمة :
Call Sound ( 250 , 50 , 1 ) ' 0


الشروط :
يجب أن يُلحق الإسم الإفتراضي لهذا الإجراء بالكلمة Call ، وهذا الكود لهذه الدالة يوضع في الفورم في منطقة الإعلانات العامة للفورمDeclarations أو في ملف ميديول تابع للبرنامج Moduel .
ويشترط الأمر التالي في منطقة الإعلانات العامة قبل كتابة الكود البرمجي :

Public Declare Function Beep Lib "kernel32"(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

ثم نص الكود :


Sub Sound(ToneNum As Variant, LenghNum As Variant, RepeatNum As Variant) ' 1

A = Val(ToneNum) ' 2
If A < 32 Or A > 160000 Then OK = 1

B = Val(LenghNum): If B = 0 Then B = 1
If B > 999 Then OK = 1

C = Val(RepeatNum): If C = 0 Then C = 1

If OK <> 1 Then

For I = 1 To C

Call Beep(A, B) ' 3

Next

End If

End Sub

ak-spl 28-12-13 01:18 PM

رد: أكواد منوعة ومبتكرة للمبرمجين بالفيجوال بيسك
 
- 9 - ' دالة معرفة عدد مرات تشغيل البرنامج '

قد تريد يوماً ما أن تعطي أشخاصاً نسخة تجريبية Trial من برنامجك الذي صنعته بالفيجوال بيسك ، يمكنك ذلك
عن طريق تحديد عدد مرات التشغيل للبرنامج ومن ثم يمتنع البرنامج عن التنفيذ مطلقاً , طبعاً هذه هي الطريقة المثلى للتسويق المحكم

لأحد برامجك المهمة والجدية ، إليك الطريقة وهي سهلة :

حيث الإسم الإفتراضي لهذه الدالة يكون :
GetRunNum

الشروط :
هذا الكود لهذه الدالة يوضع في الفورم في منطقة الإعلانات العامة للفورمDeclarations أو في ملف ميديول تابع للبرنامج Moduel .


ثم نص الكود :


Function GetRunNum() As String

retvalue = GetSetting("A", "0", "Runcount") ' 0
GD$ = Val(retvalue) + 1

SaveSetting "A", "0", "RunCount", GD$ ' 0

GetRunNum = GD$ ' 0

End Function


كيفية إستخدام هذه الدالة أن تكتبت مثلاُ :

A$=GetRunNum() ' 0
لابد من القوسين الفارغين الملتصقين ()

ثم :
B=VAL(A$) ' 0

تستطيع بكل بساطة كتابة الأمر التالي في الفورم Form في الحدث Load :


Private Sub Form_Load () ' 0

A$=GetRunNum() ' 0
B=VAL(A$) ' 0
IF B=5 THEN END

End Sub

حيث B = عدد المرات المطلوبة .

والحكمة من كتابة هذا الأمر في الحدث Load هو أن هذا الحدث يكون فاعلاً في أول تشغيل البرنامج
أي أنه بوابة الفحص للدخول وبداية التشغيل، وهو ضروري من هذه الناحية .

ak-spl 28-12-13 02:08 PM

رد: أكواد منوعة ومبتكرة للمبرمجين بالفيجوال بيسك
 



كود يسمح بكتابة الأرقام فقط في مربع إدخال النصوص Text

بعد إضافة الأداة Text إلى الفورم Form ، يكتب الكود الآتي في الحدث KeyPress للكائن Text كالآتي :


Private Sub Text1_KeyPress(KeyAscii As Integer) ' 0

P$ = "1234567890-." + Chr$(8) + Chr$(46) + Chr$(13) ' 0

M$ = Chr$(KeyAscii) ' 0

If InStr(P$, M$) = 0 Then KeyAscii = 0

End Sub


ارقام الكود آسكي : 8=زر إلغاء الخلف ، 48=زر إلغاء الأمام ، 13=زر الإدخال
وأضيقت هنا في الحزمة لإحتمال إستخدامها في مربع النصوص لحذف الأخطاء مثلاً أو غيره ..

ويمكن إضافة مايراد السماح بطباعته غير الأرقام في المتغير P





الساعة الآن 03:08 AM.

Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
شبكة ليلاس الثقافية