fighters

هل تريد التفاعل مع هذه المساهمة؟ كل ما عليك هو إنشاء حساب جديد ببضع خطوات أو تسجيل الدخول للمتابعة.
fighters

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

    fighter
    fighter
    الـمـديـرالـعـام
    الـمـديـرالـعـام


    عدد الرسائل : 226
    العمر : 34
    مزاجى : أكــواد تهمك يجب عليك الدخول 463436386
    تاريخ التسجيل : 16/04/2008

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

    مُساهمة من طرف 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
                
                
                
             
             
             

      مواضيع مماثلة

      -

      الوقت/التاريخ الآن هو الخميس مارس 28, 2024 6:43 am