نقدم لأحبائنا أعضاء منتديات Fantom
أكواد هامه
لكل مستخدمى الفيجوال بيسك 6
كود الحفظ
*******
On Error Resume Next
Data1.Recordset.AddNew
MsgBox ("تم حفظ الأعدادات بنجاح")
==========================
كود التعديل
********
Data1.Recordset.Edit
Data1.Recordset.Fields!الاسم= Text1.Text
Data1.Recordset.Fields!العمر= Text2.Text
Data1.Recordset.Fields!العنوان= Text3.Text
Data1.Recordset.Update
==========================
كود الحذف
********
Data1.Recordset.Delete
==========================
كود الانتقال بين السجلات
مثل السجل الاول والاخير والتالى والسابق
*******************************
Private Sub Command4_Click()
Data1.Recordset.MoveNext
End Sub
Private Sub Command5_Click()
Data1.Recordset.MoveFirst
End Sub
Private Sub Command6_Click()
Data1.Recordset.MovePrevious
End Sub
Private Sub Command7_Click()
Data1.Recordset.MoveLast
End Sub
========================
كود التحقق من عدد السجلات
*********************
MsgBox Data1.Recordset.RecordCount
=========================
كود الخروج
********
End
=========================
كود الخروج مع رسالة تنبيه
********************
d = MsgBox("أنت الأن تحاول الخروج من البرنامج , هل تريد الخروج فعلاً", vbYesNo + vbInformation, "تنبيه")
Select Case d
Case vbYes
End
End Select
=========================
كود أغلاق فورم معين
***************
Unload Form2
=========================
كود أخفاء الفورم
************
Me.Hide
أو
Form1.Hide
=========================
كود اخفاء فورم داخلى مفتوح
******************
Form2.Hide
=========================
كود تصغير الفورم
Me.WindowState = vbMinimized
=========================
كود فتح فورم داخل فورم
******************
Form2.Show
==========================
كود جعل الفورم لا يظهر فى التاسك مانجر
ضع هذا الكود على الفورم لود
App.TaskVisible = False
==========================
كود جعل الفورم ملء الشاشه
**********************
Private Sub Form_Load()
Me.WindowState = 2
End Sub
==========================
كود حذف ملف
يوضع هذا الكود على زر الامر
Kill "Data\Reg.bat"
==========================
كود الجمع
********
Text3.Text = Val(Text1.Text) + Val(Text2.Text)
=========================
كود جمع عدة قيم
*************
Text3.Text = Val(Text1.Text) + Val(Text2.Text)+val (textx.text)
=========================
كود الطرح بنفس الطريقة لكن غير العلامه
وكود الضرب أيضاَ غير العلامه
وكذلك القسمه
والعلامات هى
- * / +
=========================
كود يجعل الكتابه فى التكست بالانجليزيه فقط
Private Sub Text1_KeyPress(KeyAscii As Integer)
If (KeyAscii >= Asc("a") And KeyAscii <= Asc("z")) Or (KeyAscii >= Asc("A") And KeyAscii <= Asc("Z")) Then
Else
KeyAscii = 0
End If
End Sub
=========================
كودجعل التكست لايقبل الا ارقام فقط
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
End If
End Sub
==========================
كود عمل خلفيه موسيقيه على الفورم
******************
WindowsMediaPlayer1.URL = "ARABIC FILMS.mp3"
يوضع هذا الكود على الفورم اسفل اوامر الاسكين
واذا اردت اعادة الموسيقى باستمرار
ضع واحد تايمر واكتب بداخله
WindowsMediaPlayer1.Controls.play
واجعل خصائص التايمر
Interval=100
==========================
كود فتح اى ملف سواء كان وورد او باور بوينت
او اى ما كان الملف
**********
نضع هذا الكود فى الجنرال
Option Explicit
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
Const SW_SHOW = 5
ثم نضيف هذا الكود للزر المراد لبفتح به
ShellExecute hwnd, "open", "أسم الملف بأمتداده", vbNullString, "FILE DIRECTORY", SW_SHOW
==========================
كود وضع رابط تحميل ملف
*************
Shell "explorer http://عنوان الموقع.rar"
MsgBox "ضع الرساله هنا"
==========================
كود فتح جوجال
************
ضع زر واكتب به هذا الكود
Shell "explorer http://www.google.com.eg/"
==========================
كود فتح رابط معين
************
ضع لابيل واكتب هذا الكود فى حدث اللابيل كليك
Shell "explorer http://www.fantom.alafdal.net"
====================================
الساعه
====================================
كود لعرض الساعة الان بنظام اثنى عشر
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Text1 = Format(Time, "")
أو الكود التالى
Text1 = Time
========================
كود عمل ساعه على الليبل
ضع واحد تايمر وواحد ليبيل واكتب على التايمر الكود التالى
Label1.Caption = Time
========================
كود لعرض الساعة الان بنظام اربعه وعشرون
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Text1 = Format(Time, "hh:mm:ss")
أو لجعله نظام اثنى عشر يكون الكود كالتالى
Text1 = Format(Time, "hh:mm:ss Am/Pm")
او
Text1 = Format(Time, "hh:mm:ss am/pm")
========================
كود ساعة على شريط الفورم
*****************
ضع واحد تايمر
ثم اكتب على الفورم
form1.caption= time
مع تغيير الانترفال الى 1
========================
كود لعرض التاريخ بالارقام
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Text1 = Format(Date, "")
أو
Text1 = Date
====================================
التقويم الهجرى
====================================
كود لعرض الشهور الهجريه بالاسم
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalHijri
Text1.Text = Month(Now)
Month_Now = Month(Date)
If Month_Now = 1 Then Text1 = "محرم"
If Month_Now = 2 Then Text1 = "صفر"
If Month_Now = 3 Then Text1 = "ربيع أول"
If Month_Now = 4 Then Text1 = "ربيع ثانى"
If Month_Now = 5 Then Text1 = "جماد أول"
If Month_Now = 6 Then Text1 = "جماد ثانى"
If Month_Now = 7 Then Text1 = "رجب"
If Month_Now = 8 Then Text1 = "شعبان"
If Month_Now = 9 Then Text1 = "رمضان"
If Month_Now = 10 Then Text1 = "شوال"
If Month_Now = 11 Then Text1 = "ذو القعدة"
If Month_Now = 12 Then Text1 = "ذو الحجه"
========================
كود لعرض التاريخ الهجرى بالارقام
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalHijri
Text1 = Date
أو
Calendar = vbCalHijri
Text1 = Format(Date, "")
=======================
كود عرض السنه الهجريه فقط
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalHijri
Text1 = Year(Now)
=======================
كود لعرض الشهر الهجرى فقط
ولكن بالرقام وليس بالاسم كما سبق
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalHijri
Text1 = Month(Now)
=======================
كود لعرض اليوم الهجرى فقط
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalHijri
Text1= Day(Now)
========================
أقصى مدة للتايمر هي 65535 ملي ثانية
===================================
التقويم الميلادى
===================================
كود لعرض اليوم سبت أو أحد
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Text1 = Format(Date, "dddd")
=======================
كود لعرض الشهور الميلاديه بالاسم
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalGreg
Text1.Text = Month(Now)
Dim Month_Now As Integer
Month_Now = Month(Date)
If Month_Now = 1 Then Text1 = "يناير"
If Month_Now = 2 Then Text1 = "فبراير"
If Month_Now = 3 Then Text1 = "مارس"
If Month_Now = 4 Then Text1 = "ابريل"
If Month_Now = 5 Then Text1 = "مايو"
If Month_Now = 6 Then Text1 = "يونيو"
If Month_Now = 7 Then Text1 = "يوليو"
If Month_Now = 8 Then Text1 = "أغسطس"
If Month_Now = 9 Then Text1 = "سبتمبر"
If Month_Now = 10 Then Text1 = "اكتوبر"
If Month_Now = 11 Then Text1 = "نوفمبر"
If Month_Now = 12 Then Text1 = "ديسمبر"
========================
كود لعرض التاريخ الميلادى بالارقام
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalGreg
Text1 = Date
أو
Calendar = vbCalGreg
Text1 = Format(Date, "")
=======================
كود عرض السنه الميلاديه فقط
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalGreg
Text1 = Year(Now)
=======================
كود لعرض الشهر الميلادى فقط
ولكن بالرقام وليس بالاسم كما سبق
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalGreg
Text1 = Month(Now)
=======================
كود لعرض اليوم الميلادى فقط
ضع تكست وتايمر واكتب الكود التالى
على التايمر بعد جعل الانترفال للتايمر واحد
Calendar = vbCalGreg
Text1= Day(Now)
=================================
كود أظهار رسالة تحية عند فتح البرنامج حسب الوقت
ضع الكود التالى على الفورم
*******************
Private Sub Form_Load()
If Time <= "11:30 AM" Then
MsgBox ("Good Morning YourNameHere!")
End If
If Time > "11:30 AM" And Time < "5:00 PM" Then
MsgBox ("Good Afternoon YourNameHere!")
End If
If Time > "5:00 PM" Then
MsgBox ("Good Evening YourNameHere!")
End If
If Time >= "12:01 AM" Then
MsgBox ("Good Morning YourNameHere!")
End If
End Sub
==========================
كود فتح رابط معين
**************
Shell "explorer.exe http://www.vba4a.com",vbNormalFocus
==========================
لجعل البرنامج لا يعمل فى تاريخ معين
**************************
ضع تايمر وتكست واعمل تاريخ عادى جدا
ثم ضع الكود التالى على التكست
If Text1.Text = "28/07/2009" Then
End
End If
==========================
كود جعل الفورم شفاف
في ال ( General )
Private Declare Function SetLayeredWindowAttributes Lib "user32.dll" (ByVal hwnd As Long , ByValcrKey As Long , ByVal bAlpha As Byte , ByVal dwFlags As Long) As Boolean
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long , ByVal nIndex As Long , ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long , ByVal nIndex As Long) As Long
Const LWA_ALPHA = 2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
وفى الفورم لوود
Private Sub Form_Load()
SetWindowLong hwnd , GWL_EXSTYLE , GetWindowLong(hwnd , GWL_EXSTYLE) Or WS_EX_LAYERED
SetLayeredWindowAttributes hwnd , 0 , 128 , LWA_ALPHA
End Sub
================================
لتكبير خحم الخط عند المرور بالماوس على النموذج
ضع على الفورم هذا الكود
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
================================
كود كتابة أرقام فقط فى التكست ومنع كتابة حروف
بوضع هذا الكود على الفورم
private sub text1_keypress (keyascii as integer)
if ( keyascii < 48 or keyascii > 57 ) then keyascii = 0
end sub
===============================
كود لفتح الفورم بطريقه رائعه
ضع على الفورم هذا الكود
Sub Explode(form1 As Form)
form1.Width = 0
form1.Height = 0
form1.Show
For x = 0 To 5000 Step 1
form1.BackColor = x
form1.Width = x
form1.Height = x
With form1
.Left = (Screen.Width - .Width) / 2
.Top = (Screen.Height - .Height) / 2
End With
Next
form1.BackColor = &H8000000F
End Sub
Private Sub Form_Load()
Explode Me
End Sub
===========================
أو الكود التالى أيضاً لفتح الفورم بطريقه جديده
Sub Explode(form1 As Form)
form1.Width = 0
form1.Height = 0
form1.Show
For x = 0 To 5000 Step 1
form1.Width = x
form1.Height = x
With form1
.Left = (Screen.Width - .Width) / 2
.Top = (Screen.Height - .Height) / 2
End With
Next
End Sub
Private Sub Form_Load()
Explode Me
End Sub
==============================
كود تشغيل مساعد الاوفيس فى برنامجك
******************************
فى الجنرال نوضع الكود التالى
Dim Genie As IAgentCtlCharacter
*******************
وفى الفورم لود نضع الكود التالى
Dim FileName
FileName = App.Path
If Right(FileName, 1) <> "\" Then
FileName = FileName + "\"
End If
FileName = FileName + "genie.acs"-----أسم المساعد
Agent1.Characters.Load "Genie", FileName
Set Genie = Agent1.Characters("Genie")---أسم المساعد
Genie.Show----------أمر ظهور المساعد
Genie.Speak "الرساله التى يقرأها المساعد"
Genie.Play "Gestureleft"---------حركة المساعد أثناء القراءه
Genie.Left = 250-----------موقع المساعد
Genie.Top = 285-----------موقع المساعد
*********************
كود ظهور المساعد
Genie.Show
تشغيل حركه معينه للمساعد أثناء الظهور
Genie.Play "Congratulate"
*********************************
كود أخفاء المساعد
Genie.Hide
*********************************
كود جعل المساعد يقرأ ما فى التكست
Genie.Speak Text1.Text
حركة المساعد أثناء القراءه
Genie.Play "Read"
*********************************
يوضع هذا الكود فى الفورم
لتغيير مكان ظهور المساعد
وهذا الرقم يجعله غى المنتصف
Genie.Left = 415
Genie.Top = 315
=================================
كود معرفة اسم اليوم الحالى
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
================================
كود معرفة اسم الشهر الحالى
Private Sub Command1_Click()
Mmonth = Mid(Date, 4, 2)
Label1 = MonthName(Mmonth)
End Sub
===============================
كود فتح السى دى روم واغلاقه
Private Declare Function mciSendString Lib "winmm.dll" _
Alias "mciSendStringA" (ByVal lpstrCommand As String, _
ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) _
As Long
Public Sub OpenCDDriveDoor(ByVal State As Boolean)
If State = True Then
Call mciSendString("Set CDAudio Door Open", 0&, 0&, 0&)
Else
Call mciSendString("Set CDAudio Door Closed", 0&, 0&, 0&)
End If
End Sub
Private Sub Command1_Click()
OpenCDDriveDoor (True)
End Sub
Private Sub Command2_Click()
OpenCDDriveDoor (False)
End Sub
==============================
اكواد نسخ وقص ولصق
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
================================
كود الطباعه
Private Sub Command1_Click()
PrintForm
End Sub
==============================
كود لتغيير لون الخط فى التكست
الكود يوضع على زر
Text1.ForeColor = QBColor(Rnd * 15)
==============================
كود ايقاف عمل زر الايقاف الخاص بالفورم
نضع فى الفورم انلود
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Cancel = True
End Sub
===============================
اكواد النسخ والصق والمسح والطباعه
النسخ
Clipboard.Clear
Clipboard.SetText Text1
اللصق
Text1 = Clipboard.GetText
المسح
Clipboard.Clear
Clipboard.SetText Text1
Text1 = ""
الطباعه
Printer.Print Text1.Text
=============================
طريقة اضافة اسكينات لبرنامجك
ضع هذا الكود
فى الفورم لود
Skin1.ApplySkin Me.hWnd
وضيف اداة الاكتيف اسكين للفورم
وكليك يمين على الاداة
واختار الاسكين الذى تريد اضافته من جهازك
Load Skin
دون الحاجه لوضعه مع ملفات البرنامج
==============================
كود جعل البرنامج يعمل عند بدء تشغيل الجهاز
RegistryKey key = Registry.CurrentUser.OpenSubKey("Software\\Microsoft\\Windows\\CurrentVersion\\Run", true);
key.SetValue("أسم برنامجك", Application.ExecutablePath.ToString());
===============================
معرفة دقه ضبط الشاشه
ضع الكود التالى على زر امر
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")
=====================
لجعل البرنامج فى المقدمه
ضع فى الجنرال الكود التالى
Private Declare Sub SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
وضع تايمر واجعل الانترفال له=1
وضع على التايمر الكود التالى
SetWindowPos Form1.hwnd, -1, 0, 0, 0, 0, 3
======================
جعل البرنامج يعمل عدد محدد ثم يطالبك بالشراء
ضع فى الفورم لود الكود التالى
retvalue = GetSetting("A", "0", "Runcount")
GD$ = Val(retvalue) + 1
SaveSetting "A", "0", "RunCount", GD$
If GD$ > 3 Then-----------(الرقم 3 يحدد عدد مرات التشغيل)
MsgBox ("أنتهت مدة تشغيل البرنامج!!!قم بشراء النسخه الكامله من المنتج")
Unload Me
End If
=====================
جعل البرنامج لا يعمل الا من على الأسطوانه
ضع فى الجنرال الكود التالى
Private Declare Function GetDriveType Lib "kernel32.dll" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
وفى الفورم لود الكود التالى
Dim driveType As Long
driveType = GetDriveType(Mid(App.Path, 1, 3))
If driveType <> 5 Then
End
End If
======================
كود تشغيل ملف فلاشى
ضع الاداة
وضع الكود التالى على الفورم
ShockwaveFlash1.Movie = App.path & "\Data\Abo Seif.swf"
ShockwaveFlash1.Play
=======================
مع تحياتى
أبو سيف