fighters

    أكــواد تهمك يجب عليك الدخول

    شاطر
    avatar
    fighter
    الـمـديـرالـعـام
    الـمـديـرالـعـام

    عدد الرسائل : 226
    العمر : 29
    مزاجى :
    تاريخ التسجيل : 16/04/2008

    03 أكــواد تهمك يجب عليك الدخول

    مُساهمة من طرف fighter في الخميس مايو 01, 2008 8:20 pm

    الكود:
    لجعل الفورم يملأ الشاشة

    me.top = 0
    me.left = 0
    me.height = screen.height
    me.width = screen.width
    --------------------
    لتشغيل فلاش
     تشغل ملف فلاش الكود طبعا موجود
    الكود هو
    Private Sub Command1_Click()
    Dim s As String
    s = App.Path
    If Mid(s, Len(s), 1) <> "\" Then s = s + "\"
    ShockwaveFlash1.Movie = s + "a4.swf"
    End Sub
    ----------------
    إذا تغير مسار صورة متحركة مستخدمه
    Gif89a1.FileName = App.Path + "\picname.gif"
    ------------------------
    الوقت

    كل ما عليك هو وضع Timer وتغيير خاصية Interval = 1000 مثلاً للوقت وأكثر للتاريخ ، ومن ثم كتابة الأمر التالي

    Label1.Caption = DateTime

    Date : 07/07/2003
    Date$ : 07-07-2003
    Now : 07/07/2003 04:37:21 ص
    Time : 04:38:30 ص
    Time$ : 16:38:46
    ----------
    التاريخ الهجري
    VBA.Calendar = vbCalHijri

    التاريخ الميلادي
    VBA.Calendar = vbCalGreg


    ومن ثم كتابة أمر التاريخ بصورة طبيعية كما يلي

    Text1.Text = DateTime.Date

    ---------------------------------

    التحويل بين التاريخين الهجري والميلادي


    Public Function TransDate(thedate As Date, TypeTrans As Integer) As String
    Dim TempDate As String, MD As Date, a As String
    If TypeTrans = 1 Then
        VBA.Calendar = vbCalHijri
        TempDate = CStr(thedate)
        TransDate = TempDate
        VBA.Calendar = vbCalGreg
        Text1 = TransDate
    Else
        a = CStr(thedate)
        VBA.Calendar = vbCalHijri
        MD = CDate(a)
        VBA.Calendar = vbCalGreg
        TransDate = CStr(Format(MD, "yyyy/mm/dd"))
        txtdateofenglish = TransDate
    End If
    End Function
    ومن ثم في زر الأمر ( للتحويل من ميلادي إلى هجري )
    Dim Date1
    Date1 = TransDate(Text1, 1)
    MsgBox Format(Date1, "DD/MM/YYYY")
    وللتحويل من هجري إلى ميلادي :
    Dim Date1
    Date1 = TransDate(Text1, 2)
    MsgBox Format(Date1, "DD/MM/YYYY")

    ------------------------------

    معرفة اليوم من الأسبوع

    Dim Day_Now As Integer
    Day_Now = Weekday(Date)
    If Day_Now = 1 Then Label1 = "الأحد"
    If Day_Now = 2 Then Label1 = "الاثنين"
    If Day_Now = 3 Then Label1 = "الثلاثاء"
    If Day_Now = 4 Then Label1 = "الأربعاء"
    If Day_Now = 5 Then Label1 = "الخميس"
    If Day_Now = 6 Then Label1 = "الجمعة"
    If Day_Now = 7 Then Label1 = "السبت"

    --------------------------------
    عمل ساعة بسيطة بعقارب

    Dim x, y, w, m
    Private Sub Form_Load()
    y = Me.Height / 2 'تحديد نقطة منتصف الفورم
    x = Me.Width / 2 'تحديد نقطة منصف الفورم
    w = 1700
    End Sub
    Private Sub Timer1_Timer()
    Me.Cls 'مسح ما في الفورم
    DrawWidth = 4: Me.Circle (x, y), w 'رسم دائرة قطرها 1700 هي قيمة w
    DrawWidth
    = 4: Me.Line (x, y)-(x + (900 * Sin(Hour(Now) * 3.1415 / 6)), y - (900
    * Cos(Hour(Now) * 3.1415 / 6))), &HFFFF00 ' رسم عقرب الساعات
    DrawWidth
    = 3: Me.Line (x, y)-(x + (1200 * Sin(Minute(Now) * 3.1415 / 30)), y -
    (1200 * Cos(Minute(Now) * 3.1415 / 30))), vbYellow 'رسم عقرب الدقائق
    DrawWidth
    = 1: Me.Line (x, y)-(x + (1500 * Sin(Second(Now) * 3.1415 / 30)), y -
    (1500 * Cos(Second(Now) * 3.1415 / 30))), vbRed 'رسم عقرب الثواني
    End Sub

    ----------------------------------------
    معرفة الوقت المنقضي على تشغيل الجهاز

    Declare Function GetTickCount Lib "kernel32" () As Long

    ومن ثم نكتب في زر الأمر :

    Dim Minutes As Long
    Dim Hours As Long
    Dim My_Time As Long
    My_Time = GetTickCount
    Hours = ((lngCount / 1000) / 60) / 60
    Minutes = ((lngCount / 1000) / 60) Mod 60
    MsgBox Hours & ":" & Minutes
    ------------------------------
    Calendar أداة
    الكود
    Calendar1.Value = DateTime.Calendar
    .....................................

    First Day : لتحديد اليوم الأول من الأسبوع .
    * Day Length - Month Length : لتحديد طريقة عرض اليوم والشهر .
    * Grid Call Efect : لاختيار طريقة من ثلاث طرق للعرض باختلاف التحديد .
    ستجد أيضاً العديد من الخيارات لاظهارها واخفائها تحت بند Show .
    ومن ثم في Font ستجد ثلاثة أنواع : خط ( اليوم من الأسبوع - الأرقام الخاصة بأيام الشهر - العنوان ) .
    وفي Color ستجد لون ( الخلفية - اليوم من الأسبوع - الأيام من الشهر - شيء ما لا أعرفه - العنوان ) .
    أما عن الأوامر التي يمكن استخدامها فمنها:
    NextDay - NextMonth - NextWeek - NextYear ( اليوم - الأسبوع - الشهر - السنة ) التالية .
    وعكسها : PreviousDay - PreviousMonth - PreviousWeek - PreviousYear

    ------------------------
    عمل مؤقت ليدق جرس عند مدة معينة

    الامر ليس صعباً ، فكل ما في الأمر هو وضع Timer واختبار الوقت بالشكل التالي :
    If Text1.Text = DateTime.Time Then Ring
    حيث أن Text1 تحتوي على الوقت المطلوب ، و Ring هو حدث ليدق جرس أو لتظهر رسالة .
    -------------------------------
    : تغيير وقت الكومبيوتر

    اكتب الوقت الذي تريده في Text1 مثلاً ثم اكتب الأمر التالي فقط :
    DateTime.Time = text1.Text

    -----------------------------------

    عمل ستوب ووتش
    ... ضع أربع مربعات نص Text1,Text2,Text3,Text4 ثم ضع الأمر التالي في Timer بعد ضبط خاصية Intrval = 100

    Text4 = Text4 + 1
    If Text4 = 9 Then
    Text3 = Text3 + 1
    Text4 = 0
    End If
    If Text3 = 59 Then
    Text2 = Text2 + 1
    Text3 = 0
    End If
    If Text2 = 59 Then
    Text1 = Text1 + 1
    Text2 = 0
    End If

    في زر ستوب Stopاكتب
    Timer1.Enabled = False

    ---------------------------

    اكتب في Genral
    Dim My_Time
    وضع Timer وغير interval إلى 1000 وخاصية Enabled = False .
    ضع Text1 للثواني Text2 للدقائق Text3 للساعات ، وفي زر الأمر ضع الامر التالي :

    My_Time = Text1 + ( Text2 * 60 ) + ( Text3 * 60 *60 )
    Timer1.Enabled = True


    وفي التايمر ضع الأمر التالي :

    كود:
    My_Time = My_Time - 1
    If My Time <= 0 Then
     Timer1.Enabled = False
     Ring
    End If


    -----------------------------

    حيث Ring حدث تقوم أنت بوضعه حسبما تريد .
    وعند زر Stop اكتب :

    كود:
    Timer1.Enabled = Falseالثالث عشر : اضافة يوم - شهر - تاريخ ( إلى تاريخ معين ) - وكذلك الوقت .

    نستخدم في ذلك الدالة DateValue ويمكننا أن نكتب قبلها DateTime. أولا لا كما نريد ... ومثال لاضافة يوم .

    كود:
    MsgBox DateTime.DateValue(Now + 2)الرابع عشر : جمع التواريخ وطرحها واضافة أيام وشهور إليها :

    الصيغة العامة لأمر اضافة أيام هي ما يلي :

    كود:
    Text1.Text = DateAdd ( "اضافة إلى","العدد","اضافة")اضافة ( إما D للايام أو M للشهور أو YYY للأيام
    فمثلاً لاضافة يومين إلى التاريخ الحالي :

    كود:
    Text1.Text = DateAdd ("D",2,Now)وهكذا ...
    أما لطرح تاريخين فمثلاً نكتب الأمر التالي

    كود:
    Msgbox DateDiff("M","12/11/2001","11/08/2003)حيث M ليخرج الناتج بالشهور كما سبق

     معرفة الشهر من السنة :

    نستخدم الدالة MonthName بالشكل التالي

    كود:
    Msgbox MonthName(4)وسيكون الناتج حسب النظام المعتمد من Vba

    -----------------------
    لضبط حجم البرنامج حسب مقاس الشاشة

    Private Sub Form_Resize()
        FSControlReSizer1.ResizeControls
    End Sub
                
                
                
             
             
             


    _________________

      الوقت/التاريخ الآن هو الأحد أغسطس 19, 2018 3:50 pm