ملتقي ابداع طلبة جامعة الحديدة
أهلا وسهلا بكم في ملتقانا الغالي
أخي الفاضل أختي الفاضله نأمل من الله عزوجل
أن ينال إعجابكم وشاركونا جزاكم الله الف خير
أرجوكم لا تنسونا حنى بكلمه شكر
من أجل البناء الهادف معاُ نرتقي نحن وأياكم
ومتشكرين على تسجيلكم في ملتقانا

ملتقي ابداع طلبة جامعة الحديدة

منتدى الابداع والتميز ملتقي العطاء بلا حدود الى الافضل
 
الرئيسيةالتسجيلدخول

شاطر | 
 

 برامج أضافيه في الفيجول بيسك

اذهب الى الأسفل 
كاتب الموضوعرسالة
عبد الواسع الرمانه
المدير العام
المدير العام
avatar

الجنس : ذكر الابراج : السرطان عدد المساهمات : 436
نقاط : 917
السٌّمعَة : 2
تاريخ التسجيل : 20/04/2009
العمر : 30
المزاج : حلوووووووو

مُساهمةموضوع: برامج أضافيه في الفيجول بيسك   الأربعاء يونيو 03, 2009 1:05 am


Esc
إنهاء البرنامج عند الضغط على مفتاح

Private Sub Form1_KeyPress(KeyAscii As Integer)
If KeyAscii = 27 Then
End
End If

End Sub
Private Sub Form_Load()
Form1.KeyPreview = True
End Sub

معرفة دقة الشاشة

Command button
الادوات المطلوبة:

Private Sub Command1_Click()
Dim x, y As Integer
x = Screen.Width / 15
y = Screen.Height / 15
If x = 640 And y = 480 Then MsgBox ("640*480""ÔßÑÇáÇÎÊíÇÑ ÇáÈÑäÇãÌ Ýí ãÚÑÝÉ ÏÞÉ ÇáÔÇÔÉ")
If x = 800 And y = 600 Then MsgBox ("800*600""ÔßÑÇáÇÎÊíÇÑ ÇáÈÑäÇããÌ Ýí ãÚÑÝÉÏÞÉ ÇáÔÇÔÉ")
If x = 1024 And y = 768 Then MsgBox ("1024*768")
End Sub

كود طباعة نموذج

Private Sub Form_Load()
Form1.PrintForm
End Sub

كود طباعة نص

Text1box
عدد1 :+commandbuttonعدد1:

Private Sub Command1_Click()
Printer.Print Text1.Text
End Sub

كود لتشفير وفك تشفير نص معين

Textbox
عدد1: +commandbuttonعدد1:

Private Sub Command1_Click()
For i = 1 To Len(Text1.Text)
st1 = Mid(Text1.Text, i, 1)
as1 = Asc(st1)
ch1 = Chr(250 - as1)
st = st + ch1
Next
Text1.Text = st
End Sub

أي حرف
Ascll معرفة
Textbox1
عدد ,command buttonعدد1 :الادوات المطلوبة

Private Sub Command1_Click()
Dim s as string
S=asc(text1text)
Msgbox s
End sub

الادوات المطلوبة:عدد 1 فورم أخر مع الفورم الرئيسى

Private Sub Form_Load()
start = Timer
finsh = start + 3
Do Until finsh <= Timer
DoEvents
Loop
Unload Form2
Form1.Show
End Sub

معرفة إسم اليوم الحالي

Commandbutton 1
عدد الادوات المطلوبة:

Private Sub Command1_Click()
Dim dday As Integer
dday = Weekday(Date)
If dday = 1 Then Print "
السبت"
If dday = 2 Then Print "
الاحد"
If dday = 3 Then Print "
الاثنين"
If dday = 4 Then Print "
الثلاثاء"
If dday = 5 Then Print "
الاربعاء"
If dday = 6 Then Print "
الخميس"
If dday = 7 Then Print "
الجمعة"
End Sub

معرفة الشهر الحالى

Commandbutton 1
عدد الادوات المطلوبة:

Private Sub Command1_Click()
mmonth = Mid(Date, 4, 2)
Print MonthName(mmonth)
End Sub








عرض الوقت والتاريخ من خلال برنامجك

Timer1
عدد +label1عدد:الادوات المطلوبة

Private Sub Form_Load()
Timer1.Interval = 100
End Sub
Private Sub Timer1_Timer()
Label1 = Time & Date
End Sub

كود لعرض نص يكبر ويصغر

Timrr1
عدد+label1الادوات المطلوبة:عدد

Private Sub Form_Load()
Label1.Caption = "
ملتقى الابداع"
Label1.Font = "tohama"
Label1.AutoSize = True
Timer1.Interval = 100
End Sub
Private Sub Timer1_Timer()
Static c
c = c + 1
Label1.FontSize = Abs(c) + 8
Label1.Top = (Height - Label1.Height) / 2
Label1.Left = (Width - Label1.Width) / 2
If c = 50 Then c = -50
End Sub

تحريك نص من اعلى الفورم إلي اسفل

Timer1
عدد+label عدد:الادوات المطلوبة

Private Sub Form_Load()
Timer1.Interval = 90
Me.Label1.Top = 0
Label1.Caption = "ãÚáã ÍÇÓæÈ"
End Sub
Private Sub Timer1_Timer()
a = Me.Height
b = 200
If Me.Label1.Top < a Then
Me.Label1.Top = Me.Label1.Top + b
Exit Sub
For m = 1 To (Int(a / b) + 1)
Me.Label1.Top = Me.Label1.Top - 200
For x = 1 To 1000000
Next
Next
End If
End Sub






تحريك نص من اقصىيسار الفورم إلي أقصى اليمين وبالعكس

Timer2
+عددlabel 1عدد:الادوات المطلوبة

Dim x As Integer
Private Sub Form_Load()
Form1.ScaleMode = 3
Timer1.Interval = 100
Label1.Caption = "
ملتقى إبداع طلبة جامعة الحديدة"
End Sub
Private Sub Timer1_Timer()
x = x + 10
Label1.Left = x
If x > 300 Then
Timer1.Interval = 0
Timer2.Interval = 200
End If
End Sub
Private Sub Timer2_Timer()
x = x - 10
Label1.Left = x
If x < 0 Then
Timer1.Interval = 200
Timer2.Interval = 0
End If
End Sub

تحريك نص من اسفل الفورم غلي أعلاها بشكل طولى

Timer 1
عدد+label1عدد

Private Sub Form_Load()
Timer1.Interval = 100
Label1.Caption = "
معلم حاسوب ثالث"
End Sub
Private Sub Timer1_Timer()
Label1.Move 2000, Label1.Top - 100
If Label1.Top < 0 Then
Label1.Top = Form1.Height
End If
End Sub

تحريك نص في إتجاهين متعاكسينمع تغير الوانهما

Timer2
عدد+label2عدد

Private Sub Form_Load()
Timer1.Interval = 100
Timer2.Interval = 100
Label1.Caption = "
ملتقى إبداع طلبة جامعة الحديدة"
Label2.Caption = " yemen.mam9.com "
End Sub

بقية البرنامج في الصفحة

Private Sub Timer1_Timer()
Label1.ForeColor = QBColor(Rnd * 15)
Label1.Left = Label1.Left + 10
End Sub
Private Sub Timer2_Timer()
Label2.ForeColor = QBColor(Rnd * 10)
Label2.Left = Label2.Left - 10
End Sub

نص مشع ومتحرك في خليفة الفورم

Timer1
عدد+label1 الادوات المطلوبة:عدد

Private Sub Form_Load()
Timer1.Interval = 100
Label1 = "
سبحان اللة"
End Sub
Private Sub Timer1_Timer()
Label1.ForeColor = QBColor(Rnd * 15)
Label1.Left = Label1.Left + 10
End Sub

طهور نص بالوان مختلفة واماكن متفرقة على الفورم

Timer1
عدد+label1عدد: الادوات المطلوبة

Private Sub Form_Load()
Timer1.Interval = 100
Label1.Caption = "
اللة اكبر "
End Sub
Private Sub Timer1_Timer()
Randomize
Label1.ForeColor = QBColor(Rnd * 13)
Label1.Left = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Label1.Move (Rnd * 1000)
End Sub

جعل خليفة النص تومض بالوان رائعة

Label5
عدد+timer1عدد:الادوات المطلوبة

Private Sub Form_Load()
Timer1.Interval = 100
End Sub
Private Sub Timer1_Timer()
Static g
g = g + 10
If g > 510 Then g = 0
Label1.BackColor = RGB(Abs(g - 255), 0, 0)
Label2.BackColor = RGB(0, Abs(g - 255), 0)
Label3.BackColor = RGB(0, 0, Abs(g - 255))
Label4.BackColor = RGB(Abs(g - 0), 180, 180)
Label5.BackColor = RGB(Abs(g - 200), 0, 0)
End Sub

_________________
الرجوع الى أعلى الصفحة اذهب الى الأسفل
http://yemen22.mam9.com
دمعة العين
عضو نشــط
عضو نشــط
avatar

عدد المساهمات : 34
نقاط : 82
السٌّمعَة : 0
تاريخ التسجيل : 17/05/2009

مُساهمةموضوع: رد: برامج أضافيه في الفيجول بيسك   الثلاثاء يونيو 23, 2009 12:05 am

مشكور أخي عبد الواسع

والله متعتنا بموضيعك الرائعه
الرجوع الى أعلى الصفحة اذهب الى الأسفل
وردة الخريف
ســكرتيـــرة الملتقي
ســكرتيـــرة الملتقي
avatar

عدد المساهمات : 45
نقاط : 59
السٌّمعَة : 0
تاريخ التسجيل : 20/05/2009

مُساهمةموضوع: رد: برامج أضافيه في الفيجول بيسك   الأحد يونيو 28, 2009 1:36 pm

مشكور أخ عبد الواسع



تقبل مروري
الرجوع الى أعلى الصفحة اذهب الى الأسفل
ماجد العريفي
نائب المير العام
نائب المير العام
avatar

الجنس : ذكر عدد المساهمات : 119
نقاط : 173
السٌّمعَة : 0
تاريخ التسجيل : 25/04/2009
الموقع : www.yemen22.mam9
المزاج : أهوى العلم والتعلم

مُساهمةموضوع: رد: برامج أضافيه في الفيجول بيسك   الأربعاء يوليو 01, 2009 2:09 pm

مشكووور أخي عبد الواسع مواضيعك مفيدة ومنورة مثلك تسلم


تحياتي
الرجوع الى أعلى الصفحة اذهب الى الأسفل
http://www.yemen22.mam9.com
باسم القباطي
عضو نشــط
عضو نشــط
avatar

الجنس : ذكر الابراج : السمك عدد المساهمات : 75
نقاط : 167
السٌّمعَة : 0
تاريخ التسجيل : 21/04/2009
العمر : 50

مُساهمةموضوع: رد: برامج أضافيه في الفيجول بيسك   الأربعاء يوليو 08, 2009 12:29 am

الف شكر لك يا غالي

أيش ذي الموضيع الحلوه

تسلم الله يسلمك
الرجوع الى أعلى الصفحة اذهب الى الأسفل
زياد
مشرف عام
مشرف عام
avatar

الجنس : ذكر عدد المساهمات : 24
نقاط : 39
السٌّمعَة : 1
تاريخ التسجيل : 26/04/2009

مُساهمةموضوع: رد: برامج أضافيه في الفيجول بيسك   الأحد يوليو 26, 2009 2:12 pm


تسلم أخي على المواضيع
والتي أضافت على منتدنل الغالي جمالاً
.
الرجوع الى أعلى الصفحة اذهب الى الأسفل
 
برامج أضافيه في الفيجول بيسك
الرجوع الى أعلى الصفحة 
صفحة 1 من اصل 1

صلاحيات هذا المنتدى:لاتستطيع الرد على المواضيع في هذا المنتدى
ملتقي ابداع طلبة جامعة الحديدة :: ملتقي إبداع معلم الحاسوب :: ملتقي الغات البرمجيه-
انتقل الى: