مكتبة اكواد فجول باسك

[b][b]ارجو عدم نقل الاكواد فقط ولكن تعلم ما معناها
الوصف : حتى تتمكن من تسجيل قيم في ملف التسجيل الخاص بالجهاز registry File تمكنك هذه الدالة المتضمنة داخليا هذه بهذا الامر

التصنيف : Registry

كود:
SaveSetting "", "", "", ""
الوصف : دلة لمعرفة عدد الاحرف في مربع نص text box وترجع العدد الى label

التصنيف : Custom Controls/ Forms/ Menus

كود:
Label1.caption = len(Text1.text)

تغيير شكل الفورم بشكل دائرة

الوصف : كود لتغيير شكل الفورم على شكل دائرة

التصنيف : Custom Controls/ Forms/ Menus

كود:
'Declarations
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
'Code
Private Sub Form_Load()
Dim lngRegion As Long
Dim lngReturn As Long
Dim lngFormWidth As Long
Dim lngFormHeight As Long
lngFormWidth = Me.Width / Screen.TwipsPerPixelX
lngFormHeight = Me.Height / Screen.TwipsPerPixelY
lngRegion = CreateEllipticRgn(0, 0, lngFormWidth, lngFormHeight)
lngReturn = SetWindowRgn(Me.hWnd, lngRegion, True)
End Sub

توسيط فورم وقت التشغيل

الوصف : توسيط فورمform في الشاشة وقت التشغيل Run time

التصنيف : Custom Controls/ Forms/ Menus

كود:

Private Sub Form_Load()
Me.Top = (Screen.Height - Me.Height) / 2
Me.Left = (Screen.Width - Me.Width) / 2
End Sub

تغيير حجم الخط على الزر

الوصف : تغيير حجم الخط على الزر عند مرور المؤشر عليه

التصنيف : Custom Controls/ Forms/ Menus

كود:

Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Command1.FontBold = False Then
Command1.FontBold = True
Command1.FontSize = 12
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Command1.FontBold = True Then
Command1.FontBold = False
Command1.FontSize = 10
End If
End Sub
الوصف : السماح بإدخال تاريخ فقط في مربع النص

التصنيف : Coding Standards

كود:

Dim i As IntegerDim t1 As StringDim t2 As StringPublic Sub AutoDate(TextBoxName As TextBox ByVal keyasci As Integer)If Val(keyasci) 8 ThenIf TextBoxName.Text Empty Theni 0Elsei i - 1End IfExit SubEnd Ifi i 1If i 3 Thent1 Mid(TextBoxName.Text 1 2)t2 Mid(TextBoxName.Text 3 1)TextBoxName.Text Trim$(t1) & / & t2TextBoxName.SelStart 4t2 EmptyElseIf i 6 Thent1 Mid(TextBoxName.Text 1 5)t2 Mid(TextBoxName.Text 6 1)TextBoxName.Text Trim$(t1) & / & t2TextBoxName.SelStart 7End IfIf i 11 Then Exit SubEnd SubPublic Function DateValidation(TextBoxName As TextBox) As BooleanIf IsDate(Trim$(TextBoxName.Text)) False ThenMsgBox Enter valid date in dd/mm/yyyy format. vbInformation System Info..TextBoxName.SetFocusDateValidation FalseElseIf Not Len(Trim$(TextBoxName.Text)) 10 ThenMsgBox Enter valid date in dd/mm/yyyy format. vbInformation System Info..TextBoxName.SetFocusDateValidation FalseElseDateValidation TrueEnd IfEnd FunctionPrivate Sub Text1_KeyPress(KeyAscii As Integer)Call AutoDate(Text1 0)End SubPrivate Sub Text1_LostFocus()Call DateValidation(Text1)End Sub

طباعة النص على النموذج بألوان مختلفة

الوصف : طباعة النص على النموذج بألوان مختلفة

التصنيف : Coding Standards

كود:

Sub Form_Paint()
Dim i As Integer X As Integer Y As Integer
Dim C As String
Cls
For i 0 To 91
X CurrentX
Y CurrentY
C Chr(i)
Line -(X TextWidth(C) Y TextHeight(C)) _
QBColor(Rnd * 16) BF
CurrentX X
CurrentY Y
ForeColor RGB(Rnd * 256 Rnd * 256 Rnd * 256)
Print منتدى الإبداع الإسلامي منتدى الإبداع الإسلامي
Next
End Sub

تحويل حالة الأحرف من صغيرة إلى كبيرة

الوصف : تحويل حالة الأحرف من صغيرة إلى كبيرة

التصنيف : String Manipulation

كود:
Private Sub Command1_Click()
x Text1.Text
y UCase(Left(x Len(x)))
Text1.Text y
End Sub
Private Sub Command2_Click()
x Text1.Text
y LCase(Left(x Len(x)))
Text1.Text y
End Subمسح محتويات أكثر من مربع نص

الوصف : مسح محتويات أكثر من مربع نص

التصنيف : Coding Standards

ضع هذا الكود في الفورم

كود:
Public Sub ClearTextBoxes(frm As Form)
Dim c As Control
For Each c In frm
If TypeOf c Is TextBox Then c.Text
Next c
End Sub
Private Sub Command1_Click()
Call ClearTextBoxes(Form1)
End Sub
خلفية وامضة للنص

الوصف : خلفية وامضة للنص

التصنيف : Coding Standards

كود:
Private Sub Timer1_Timer()
Static COL
COL COL 10
If COL 510 Then COL 0
Label1.BackColor RGB(Abs(COL - 255) 0 0)
Label2.BackColor RGB(0 Abs(COL - 255) 0)
Label3.BackColor RGB(0 0 Abs(COL - 255))
Label4.BackColor RGB(Abs(COL - 0) 180 180)
Label5.BackColor RGB(Abs(COL - 200) 30 180)
End Sub

أكواد نسخ قص لصق

الوصف : أكواد نسخ قص لصق

التصنيف : Coding Standards

كود:
Private Sub Command1_Click()
Clipboard.Clear
Clipboard.SetText text1
End Sub
Private Sub Command2_Click()
Clipboard.Clear
Clipboard.SetText text1
text1
End Sub
Private Sub Command3_Click()
text1 Clipboard.GetText
End Sub

[/b][/b]

اسفون على الخربشه مكتبة اكواد فجول باسك Icon_mad

موضوع: اكواد 2 الثلاثاء 01 ديسمبر 2009, 1:18 pm

السلام عليكم....
راح حاول بهالموضوع بس أجذب المهتمين للفيجوال بيسك، لأن مثل ماني ملاحظ أنو هالمنتدى نايم تماما.... من أسبوع ما شفت فيه أي مشاركة... و أليكم الأكواد...
1) أكواد الحافظة....
الحافظة في الفيجوال بيسك تأخذ الأسم Clipboard ، حيث يتم ربط توابع معينة بهذا
الكائن لكي تتم أوامر الحافظة...سأكتب الأكواد على فرض أن لدينا صندوق نص اسمه
txtMyText...

*** كود القص:
Clipboard.clear
Clipboard.SetText txtMyText.SelText
txtMyText.SelText=""

إن المنهج Clear يقوم بتفرغة كل محتويات الحافظة... كما يقوم الأمر SetText بإضافة النص المحدد إلى الحافظة... و إذا أردنا معرفة ما تحملة العبارة التالية txtMyText.SelText فهي تحمل قيمة النص المحدد... أي أن SelText تشير إلى النص المحدد...
ثم في العبارة الأخيرة، نحذف النص المحدد لكي تتم عملية القص...

*** كود النسخ:
Clipboard.clear
Clipboard.SetText txtMyText.SelText

هذا الكود يماثل تماما الكود السابق، لكن الفرق أننا لا نقوم بحذف النص المحدد و الذي نود نسخه...

*** كود اللصق:
txtMyText.SelText=ClopBoard.GetText( )

إن العبارة ClipBoard.GetText() تحمل قيمة النص الموجود في الحافظة.... و نحن نأمر الجهاز في هذا الكود بوضع قيمة الحافظة مكان النص المحدد...

2) كود الأحداث المعلقة:
من المؤكد أنكم تتسائلون " ما هي الأحداث المعلقة؟ "، أنا سأشرح لكم...
إن بعض البرامج تحتوي على Loop أي حلقة ... و لهذه الحلقة أشكال كثيرة، أشهرها و
أكثرها شيوعا:
For I=0 to 100
.......
.....
.......
if I=100 then I=0
next I

إذا قمنا بتحليل عمل هذا البرنامج، نتوصل إلى انه سيقوم بتنفيذ الأوامر الموجودة داخل الحلقة إلى ما لا نهاية... و بذلك، فإن أي حدث تقوم بتنفيذه خلال عمل هذه الحلقة فإنه لن يستجيب.....
أعرف أنكم لم تفهموا، سأوسع الشرح...
لنفرض أنه لدينا برنامج يقوم برسم نقاط عشوائية على نموذج معين، و هذه النقاط غير منتهية.... و لدينا زري أوامر، الأول للبدء الحلقة، و الثاني لإنهاءها...
إذا ضغطنا زر البدء، فإن الحلقة ستبدأ إلى ما لا نهاية.... و سترسم نقاطا على النموذج إلى ما لا نهاية... فعند القيام بحدث الضغط على زر إنهاء الحلقة، فأنه لن يستجيب أبدا، و ذلك بسبب عمل الحلقة.... فما الحل إذن...
يوجد تابع خاص لهذه المشكلة و هو DoEvents... عند وضع هذا التابع ضمن الحلقة، فإنه ينفذ الحدث الذي قمت به، ثم يكمل تنفيذ الحلقة....

3) كود تنفيذ أي برنامج عن طريق الفيجوال بيسك:
إذا أردت أن تشغل إي برنامج في جهازك عن طريق الفيجوال بيسك، اكتب العبارة التالية....
Dim A
A = Shell ("programpath",n)

حيث A متغير... و اكتب مكان الــ programpath مسار البرنامج كاملا، و اكتب مكان n رقم من 0 إلى 6، حيث كل رقم له دلالته...

0 تظهر نافذة البرنامج مخفية.
1 تظهر نافذة البرنامج بحجمها الطبيعي و معها التركيز.
2 تظهر النافذة مصغرة و معها التركيز.
3 تظهر النافذة مكبرة و ومعها التركيز.
4 تظهر نافذة عادية و بدون تركيز.
6 تظهر نافذة مصغرة بدون تركيز.

و إن التابع Shell يرجع قيمة عددية تحفظ في المتغير A تشير إلى مقبض النافذة الذي يعترف عليه Windows

ملاحظة: الفائدة من وضع القيمة 0 للمتغير n ، هي لظهور النافذة مخفية، و بالتالي يتم تحميل النافذة في الذاكرة دون أن نراها. و نستغيد من هذه الحالة في تشغيل ملف تنفيذي لكي يؤدي وظائف معينة دون أن يشاهد المستخدم نافذة البرنامج (برامج الفيروسات و التجسس)

4) كود للقيام باتصال هاتفي:
يجب أولا تضمين أداة جديدة و هي MSComm، و ذلك بالخطوات التالية:
* اضغط بزر اليمين على مكان فارغ شريط الأدوات.
* اختر الخيار Components
* اختر الأداة MSComm من القائمة و اضغط على الزر موافق.
* ستظهر لك أداة جديدة لها شكل الهاتف على شريط الأدوات.

بعد تضمين هذه الأداة في النموذج، نسميها على سبيل المثال Comm1....
و إليك الكود:
Dim PhoneNumber as String
On Error Goto WrongPort
Comm1.CommPort = 1
Comm1.Settings = "300,n,8,1"
PhoneNumber = "164883"
Comm1.PortOpen = True
Comm1.OutPut = "ATDT" + PhoneNumber + Chr$(13)Sub
WrongPort:
MsgBox "Title", 1048576 + 524288 + 16, "Prompt"

الشرح:
في السطر الأول: نعرف متغير حرفي و هو PhoneNumber
في السطر الثاني: نضع هذه العبارة بحيث في حال حدوث أي خطأ ( مثلا المودم غير
متصل، أو المنفذ غير صحيح ) ينتقل التنفيذ إلى السطر الثامن حيث
الإجراء . طبعا يمكن تسمة WrongPort كما نشاء.
في السطر الثالث: نحدد البورت الذي سنجري منه الإتصال. يفضل أن تقوم بتجربة البرنامج
عدة مرات بتغيير البورت (1، 2، 3، 4، 5، 6، 7 ) حتى تصل للبورت
الصحيح.
في السطر الرابع: نحدد إعدادات الإتصال. ضعها كما هي موجودة في هذا الكود، لأن
شرحها معقد نوعا ما.
في السطر الخامس: نكتب رقم الهاتف المراد طلبه.
في السطر السادس: يفتح البورت الذي حددته.
في السطر السابع: تنتقل البيانات عبر خط الهاتف مع بعض الشيفرات.
في السطر الثامن: ينتهي تنفيذ الأوامر.
في السطر التاسع: يوجد الإجراء الذي ينتقل أليه التنفيذ عند حدوث خطأ.
في السطر العاشر: تظهر رسالة الخطأ التي عنوانها Title و نصها هو Prompt.
يمكن تغيير هذه القيم كما تشاء.

و الأن تم الإتصال، و ماعليك سوى التكلم عن طريق الهيدفون أو الهاتف.
لقطع الإتصال: ضع الكود التالي:
Comm1.PortOpen = False
حيث يقوم هذا السطر بإغلاق المنفذ.

5) كود لإيقاف تشغيل ويندوز:
ننشئ نافذة جديدة من النوع Module و نكتب فيها السطر التالي:
Public Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags as Long, By Val dwReserved As Long) As Long

و لكن انتبه، اكتبه في سطر واحد، و ليس في سطرين...
و الأن في النموذج، ضمن أزرارا لإيقاف التشغيل، و أعادت التشغيل، و إنهاء كافة العمليات البرمجية، و أنهاء كافة العمليات البرمجية التي لا تستجيب.
و اكتب الكود التالي لكل زر:
Dim LonStatus
LonStatus = ExitWindowsEx (Flag, n)

اكتب إحدى الأرقام التالية للمتغير n:
0 لإنهاء كافة العمليات البرمجية.
1 لإيقاف التشغيل.
2 لإعادة التشغيل.
4 ينهي كافة العمليات البرمجية التي لا تستجيب.

ملاحظة هامة: اللي عندو أي سؤال بخص هالموضوع و أي موضوع ثاني، أرجو إنو ما يتردد و يطرحو مباشرة....

في الدرس القادم، سأعطي أكوادا لتشغيل ملفات الصوت و الفيديو و الميديا. و كود لتشغيل الأقراص المدمجة ( برنامج تشغيل الأغاني من السيدي). و كيفية إنشاء مساعد أوفيس ناطق و متحرك.

تحياتي
:p

» برنامج الفجول باسك 6
» اصنع هكر بالفجول باسك