أكواد بعض البرامج

البرنامج الأول :
البرنامج عبارة عن برنامج ترحیب يستخدم للترحیب عند الضغط على أي
لغة فإن البرنامج يظھر كلمة الترحیب الخاصة بكل لغة :
للفورم إلى Caption ثم غیر Standard.exe افتح مشروع قیاسي جديد
"برنامج الترحیب". ثم ضع الأدوات التالیة على الفورم :
List صندوق قائمة 1 ، Text أداة نص 1 ، Label أداة عنوان 1
True ھي Text ل: 1 Locked اجعل خاصیة

: Form_Load أكتب الكود الآتي في
Private Sub Form_Load ()
Text1.Text=""
Label1.Caption=""
List1.Additem " "العربي
List1.Additem " "الإنجلیزي
End Sub
: List1_Click الآن أكتب الكود الآتي في
Private Sub List1_Click()
Select Case List1.ListIndex
Case 0
Label1.Caption = " "العربي
Text1.Text= " "أھلاً بالمبرمج
Case 1
Label1.Caption= " "الإنجلیزي
Text1.Text="Welcome Programmer"
End select
End Sub

البرنامج الثاني :
تحريك صورة في الفیجوال إلى أسفل ويسار الفورم. الأدوات المطلوبة :
للفورم Caption ثم غیر خاصیة Standard.exe افتح مشروع قیاسي جديد
Timer1 ، Picture إلى "تحريك صورة" ثم ضع 1
Timer1 = ل 100 Interval وقم بوضع خاصیة Picture ضع صورة في 1
2- Maximized للفورم إلى WindowState غیر خاصیة
Dim X,Y as Integer General عرف متحولات في القسم العام
: Timer1_Timer أكتب الكود الآتي في
Private Sub Timer1_Timer()
X=100
Y=100
Picture1.Top =Picture1.Top – X
If Picture1.Top<0 then
Picture1.Top=0
Picture1.Left =Picture1.Left +Y
End if
End Sub

البرنامج الثالث :
برنامج كالمفكرة ولكنه بسیط. ضع الأدوات التالیة على الفورم :
Toolbar1 , Combo1 , Text1 , ImageList1 , CommonDialog1
ثم اختیار (Ctrl + T) ملاحظة: بعض ھذه الأدوات تحصل علیه بالضغط على
والأدوات الثلاثة التي Microsoft Windows Common Controls 6.0(SP6)
لونھا صفراء منھا ولا تغیر أي اسم برمجي لھذه الأدوات بل اتركه كما ھو
2-Vertical (Text1) ScrollBar وضع خاصیة .True (Text1) Multiline ضع خاصیة
فیظھر مربع حوار نختار Custom ونختار خاصیة ImageList ثم نعلم الأداة 1
ونحدد الصور التي Insert Picture… ونختار Images 16 ثم نختار التبويب x16
أي نص لو يكن حددنا الصورة الأولى Key نريدھا ثم نضع لكل صورة في خاصیة
ثم نختار Toolbar ثم نغلق مربع الحوار ونحدد 1 n: ووضعنا قیمة مثلا
Buttons ثم نختار التبويب ImageList إلى 1 ImageList ونغیر قیمة Custom
ثم نضغط على n إلى Image ونغیر قیمة Insert Button… ونضغط على الزر
فنرى الصورة وجدت على زر جديد وھكذا نتابع مع بقیة الأزرار ونلاحظ Apply
وھي خاصیة تحدد الاسم البرمجي Toolbar داخل 1 Key وجود خاصیة ھي
لأي أداة أخرى وقد وضعت عدة أسماء Name لكل زر وھي نفسھا الخاصة
New,Open,Save,Bold,Italic,Under,Strike,Color : في ھذا البرنامج مثل
: Form_Resize الآن الكود في الحدث الآتي
Private Sub Form_Resize()
Text1.Width = Form1.Width – 100
Text1.Height = Form1.Height - 1000
End Sub
: ButtonClick بالحدث Toolbar ثم أكتب الكود الخاص بزر 1
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "New"
Text1.Text = ""
Case "Open"
CommonDialog1.FileName = " "المفكرة
Wrap$ = Chr$(13) + Chr$(10)
CommonDialog1.Filter = "TXT Files(*.txt)|*.txt|"
CommonDialog1.ShowOpen
On Error GoTo er:
If CommonDialog1.FileName <> "" Then
Open CommonDialog1.FileName For Input As #3
On Error GoTo erro:
Do Until EOF(3)
Line Input #3, lines$
alltext$ = alltext$ & lines$ & Wrap$
Loop
Text1.Text = alltext$
Form1.Caption = CommonDialog1.FileTitle
Toolbar1.Buttons.Item(3).Enabled = True
CleanUp:
Close #3
Exit Sub
End If
er:
Exit Sub
erro:
MsgBox " ھذا الملف كبیر جداً ", vbCritical, " "خطأ
CommonDialog1.FileName = ""
Resume CleanUp:
Case "Save"
On Error GoTo ew:
CommonDialog1.Filter = "TXT Files(*.txt)|*.txt|"
CommonDialog1.ShowSave
If CommonDialog1.FileName <> "" Then
Open CommonDialog1.FileName For Output As #2
Print #2, Text1.Text
Close #2
End If
ew:
Exit Sub
Case "Color"
CommonDialog1.ShowColor
Text1.ForeColor = CommonDialog1.Color
Case "Bold"
Text1.FontBold = Not Text1.FontBold
Button.Value = IIf(Text1.FontBold, tbrPressed, tbrUnpressed)
Case "Italic"
Text1.FontItalic = Not Text1.FontItalic
Button.Value = IIf(Text1.FontItalic, tbrPressed, tbrUnpressed)
Case "Under"
Text1.FontUnderline = Not Text1.FontUnderline
Button.Value = IIf(Text1.FontUnderline, tbrPressed, tbrUnpressed)
Case "Strike"
Text1.FontStrikethru = Not Text1.FontStrikethru
Button.Value = IIf(Text1.FontStrikethru, tbrPressed, tbrUnpressed)
End Select
End Sub
: Text1_Change وھذا الكود في
Private Sub Text1_Change()
Toolbar1.Buttons.Item(3).Enabled = True
Toolbar1.Buttons.Item(5).Enabled = True
Toolbar1.Buttons.Item(6).Enabled = True
Toolbar1.Buttons.Item(7).Enabled = True
Toolbar1.Buttons.Item(.Enabled = True
Toolbar1.Buttons("Bold").Value=IIf(Text1.FontBold, tbrPressed,
tbrUnpressed)
Toolbar1.Buttons("Italic").Value=IIf(Text1.FontItalic, tbrPressed,
tbrUnpressed)
Toolbar1.Buttons("Under").Value=IIf(Text1.FontUnderline,
tbrPressed, tbrUnpressed)
Toolbar1.Buttons("Strike").Value=IIf(Text1.FontStrikethru,
tbrPressed, tbrUnpressed)
End Sub
: Form_Load ثم نكتب الكود الخاص بالخط والحجم في
Private Sub Form_Load()
Dim i As Integer
For i = 0 To Screen.FontCount - 1
Combo1.AddItem Screen.Fonts(i)
Next
For i = 8 To 72 Step 4
Combo2.AddItem i
Next
Combo1.Text = "Tahoma"
Combo2.Text = "8"
End Sub
Combo1 , Combo الخاصة ب 2 Change , Click ثم ھذه الأكواد في أحداث
Private Sub Combo1_Change()
On Error Resume Next
Text1.Font = Combo1.Text
End Sub
Private Sub Combo1_Click()
Text1.Font = Combo1.List(Combo1.ListIndex)
End Sub
Private Sub Combo2_Change()
On Error Resume Next
Text1.FontSize = Combo1.Text
End Sub
Private Sub Combo2_Click()
Text1.FontSize = Combo2.List(Combo2.ListIndex)
End Sub

البرنامج الرابع :
برنامج ساعة رقمیة مع تاريخ. الأدوات المطلوبة :
إلى 100 Interval غیر خاصیة Timer ومؤقت زمني 1 Label ضع ٢أداة عنوان
: Timer1_Timer أكتب الكود الآتي في
Private Sub Timer1_Timer()
Label1.Caption=Time
Label2.Caption=Date
End Sub

البرنامج الخامس:
آلة حاسبة بسیطة. ضع على الفورم الأدوات التالیة :
Command ٢٥ زر أمر 1 ، Timer مؤقت 1 ، Label أداة عنوان 1
False إلى Enabled للمؤقت إلى 100 وخاصیة Interval غیر خاصیة
الأكواد الخاصة بالبرنامج فھي :
الزر : الكود :
Label1.Caption = "" Ac
Label1.BackColor = vbBlack OFF
Timer1.Enabled = True
Clipboard.SetText Label1.Caption Copy
+/-
Label1.Caption = Val(Label1.Caption) -
(Val(Label1.Caption) + Val(Label1.Caption))
Label1.Caption = Label1.Caption + "1" 1
Label1.Caption = Label1.Caption + "2" 2
Label1.Caption = Label1.Caption + "3" 3
Label1.Caption = Label1.Caption + "4" 4
Label1.Caption = Label1.Caption + "5" 5
Label1.Caption = Label1.Caption + "6" 6
Label1.Caption = Label1.Caption + "7" 7
Label1.Caption = Label1.Caption + "8" 8
Label1.Caption = Label1.Caption + "9" 9
Label1.Caption = Label1.Caption + "0" 0
n1 = Val(Label1.Caption) +
op1 = "+"
Label1.Caption = ""
n1 = Val(Label1.Caption) -
op1 = "-"
Label1.Caption = ""
n1 = Val(Label1.Caption) X
op1 = "*"
Label1.Caption = ""
n1 = Val(Label1.Caption) ÷
op1 = "/"
Label1.Caption = ""
n2 = Val(Label1.Caption)
If op1 = "+" Then
Label1.Caption = n1 + n2
ElseIf op1 = "-" Then
_______________________________________________________
=
Label1.Caption = n1 - n2
ElseIf op1 = "*" Then
Label1.Caption = n1 * n2
ElseIf op1 = "/" Then
If n2 = 0 Or Label1.Caption = "" Then
Msgbox" لا يمكنك التقسیم على صفر ",vbcritical," "خطأ
End If
End If
Label1.Caption = "3.14159265358979" p
Ö
If Val(Label1.Caption) >= 0 Then
Label1.Caption = Sqr(Val(Label1.Caption))
Else
Msgbox" لا يمكن الحصول على جذر لعدد
سالب ",vbcritical," "خطأ
End If
Label1.Caption = Val(Label1.Caption) ^ 2 X^2
Label1.Caption = Val(Label1.Caption) ^ 3 X^3
Label1.Caption = Val(Label1.Caption) ^ 4 X^4
If InStr(1, Label1.Caption, ".") = 0 Then الفاصلة
Label1.Caption = Label1.Caption + "."
End If
Form1.WindowState = 1 Timer1
End