منتديات Fantom


عزيزي الزائر / عزيزتي الزائرة يرجي التكرم بتسجيل الدخول اذا كنت عضو معنا
او التسجيل ان لم تكن عضو وترغب في الانضمام الي اسرة المنتدي
سنتشرف بتسجيلك
أدارة المنتدى

لا إله إلا الله محمد رسول الله


    أكود هامه فى vb6

    شاطر
    avatar
    Fantom
    Admin

    عدد المساهمات : 50
    تاريخ التسجيل : 06/07/2010
    الموقع : www.fantom.alafdal.net

    أكود هامه فى vb6

    مُساهمة  Fantom في الجمعة ديسمبر 13, 2013 8:21 am



    نقدم لأحبائنا أعضاء منتديات 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



    =======================
    مع تحياتى
    أبو سيف

      الوقت/التاريخ الآن هو الجمعة نوفمبر 17, 2017 8:13 pm