شريط متحرك سهل الإستخدام

[أبو هادي]

السلام عليكم

لا يتطلب إلا وضع أداة "مجموعة الخيارات" Option Group فقط ويمكن وضع الحد الأدنى والحد الأعلى في خاصية tag كالتالي :

1,100

أو تمريرها أثناء طلب الإجراء .

تحياتي .

تم حذف الملف المرفق لإرفاق نسخة أحدث بالأسفل .

تم تعديل فبراير 7, 2004 بواسطه أبو هادي

[Daniello]

شكراً أخ أبوهادي على هذا المثال الجميل

وكأنك عرفت بأني في أمس الحاجة إليه

[أبو هادي]

السلام عليكم

شكرا لك أخي Daniello .

لقد تم تعديل طفيف على المثال .

يفضل ملاحظة أن تكون التسمية label للأداة غير مرئية .

تحياتي .

تم حذف الملف المرفق لإرفاق نسخة أحدث بالأسفل .

تم تعديل فبراير 7, 2004 بواسطه أبو هادي

[ashraf]

أكثر من رائع ، بارك الله فيك .

أشرف خليل

[أبو هادي]

السلام عليكم

شكرا لك أشرف .

أنا أتأسف من الجميع ، لقد اكتشفت خطأ كبير في حالة تمرير قيم بالسالب ، وقد تم التعديل ، وأعتقد أنه التعديل الأخير .

على كل من أنزل المثال من قبل إنزاله من جديد .

تحياتي .

ملاحظة : تم تعديل الملف فى مشاركة لاحقة

[مصلح الحريصي]

الله يعطيك الصحة والعافية أخي أبو هادي

دائماً تأتينا بالجديد المفيد وتتميز في عطاءك زادك الله علماً

[مصلح الحريصي]

الأخ ابو هادي

جربت المثال رائع جداً

جعلت القيمة الأولية 9999 بدلاً من 999 وظهر لي خط أزرق بوسط شريط التمرير وأحدث تشويش شبيه بالإهتزاز ألا يمكن التخلص منه.

هذا ليس عيباً فالمثال لا تكفي فيه كلمة رائع بحق وليست مجاملة بارك الله فيك وبارك لك في علمك.

[أبو هادي]

السلام عليكم

أخي مصلح .. أعتقد أن المشكلة لها علاقة بكارت الشاشة .

تحياتي .

[Daniello]

لقد سبق وشكرت على هذا المثال الأكثر من رائع أخ أبو هادي
لكن حبذا لو ساعدتني مساعدة صغيرة
وهي كالتالي
أريد عند فتح نموذج أن يظهر الشريط الأزرق
ولكن لا أريد أن ينتهي الشريط الأزرق قبل فتح النموذجفهلا ساعدتني أرجوك

:$ :$ :') :')

[أبو هادي]

السلام عليكم

أضف هذا الكود للنموذج وجرب :

Private Sub Form_Open(Cancel As Integer)
  Me.TimerInterval = 1
End Sub

Private Sub Form_Timer()
  Call CmdRun_Click
  Me.TimerInterval = 0
End Sub

تحياتي .

[أبو هادي]

السلام عليكم

تعديلات خطيرة لا تفوتكم

شريط التقدم يعمل في كل الإتجاهات

كل واحد ينزل نسخته وبالترتيب لو سمحتوا ، لا نريد زحاما :d

تحياتي .

ملاحظة : تم تعديل الملف فى مشاركة لاحقة

[ابومؤنس]

استاذي العزيز

بارك الله فيك وزادك من علمة وصراحة وبدون مجاملة يشهد علي ربي (خبير اكسيس ) قليلة في حقة ..

اتمني لك التوفيق

[hurryup]

بارك الله فيك أخي

[Daniello]

شكراً أخي أبو هادي على المساعدة

لكن ما أريده بالضبط هو كالتالي:

لدي نموذج بحث أقوم بواسطته البحث في نموذج آخر يضم ما يفوق 52000 سجل إذن ستأخذ عملية فتح النموذج وقتاً طويلا
وقد قمت بنسخ الكود الذي أعطيتني إياه لكن لا يعمل الشريط إلا بعد فتح النموذح وبالتالي تكون كل البيانات قد ظهرت ولا فائدة من الشريط

أما أنا فأريد أن يظهر الشريط قبل فتح النموذج بحيث ما إن يفتح النموذج حتى يكون الشريط قد وصل إلى 100

:') :') استحملني أرجوك أخ أبوهادي :') :')

[أبو هادي]

السلام عليكم

أخي الفاضل .. لم أجرب من قبل ولكن يبدو لي إمكانية ذلك من خلال حدث Load بعد إمكانية الحصول على مجموع السجلات قبل فتح النموذج أو من خلال حدث Open .

سأحاول غدا إن شاء الله تعالى .

الحقيقة أنا لا أهتم بهذه الأمور كثيرا ، حتى هذه الأداة فقد تكون من النادر أن أستخدمها في برامجي ، ولكني تحمست للوصول لهذه الفكرة .. دعاوتكم .

تحياتي .

[مصلح الحريصي]

واااااااو

هذا في غاية الروعة

لي سؤال فقط

هل يمكن تثبيت الرقم الذي يبدأ بالعد إلى المائة في وسط آل Frame1 حتى لا يكون مصاحب للشريط في المرور.

الله يوفقك في دنياك وأخرتك.

[أبو هادي]

السلام عليكم

أخي مصلح .. لايمكن عمل ذلك للأسف إلا مع تعقيد العملية وذلك باختيار أكثر من تسمية label وأنا أريد تسهيلها وتبسيطها بقدر الإمكان .

هنا آخر تنقيح للكود فقط ولن يؤثر على أداء الشريط للذين قاموا بإنزال المثال سابقا ، علما أنه تم إضافة بسيطة فقط وهو إمكانية تعطيل النسبة المئوية :

Sub ProgCtrl(Ctrl As Control, _
             ByVal Value As Variant, _
             Optional ByVal Orientation As Byte = 1, _
             Optional ByVal Min As Variant = 1, _
             Optional ByVal Max As Variant, _
             Optional ByVal Percentage As Boolean = True)
  
  '-----------------------------------------------------------'
  '-- Progressive Control rev5 -- 09/02/2004 -- by Abo Hadi --'
  '-----------------------------------------------------------'
  
  Const LeftToRight As Byte = 1
  Const RightToLeft As Byte = 2
  Const UpToDown As Byte = 3
  Const DownToUp As Byte = 4
  Const FontHeight As Integer = 250
  Dim InStrVal
  
  With Ctrl
    If Not .ControlType = acOptionGroup Then Exit Sub
    If Not .Enabled Then Exit Sub
   
    InStrVal = InStr(1, .Tag, ",")
    If IsEmpty(Max) Then
      Select Case InStrVal
        Case 0: Exit Sub
        Case 1: Max = Val(Trim(Mid(.Tag, 2)))
        Case Is > 1
          If Trim(Left(.Tag, InStrVal - 1)) <> "" Then
            Min = Val(Trim(Left(.Tag, InStrVal - 1)))
          End If
          Max = Val(Trim(Mid(.Tag, InStrVal + 1)))
      End Select
    End If
  End With
  
  If Max < Min Then
    InStrVal = Min
    Min = Max
    Max = InStrVal
  End If
  
  If Value < Min Then Value = Min
  If Value > Max Then Value = Max
     
  If Min < 0 Then
    Max = Max - Min + 1
    Value = Value - Min + 1
    Min = 1
  End If
  
  With Ctrl.Controls(0)
    If Orientation < LeftToRight Or _
       Orientation > DownToUp Then Orientation = LeftToRight
    
    Select Case Orientation
      Case LeftToRight
        .Height = Ctrl.Height
        .Top = Ctrl.Top
        .Width = (Ctrl.Width / (Max - Min + 1)) * Value
        .Left = Ctrl.Left
      Case RightToLeft
        .Height = Ctrl.Height
        .Top = Ctrl.Top
        .Width = (Ctrl.Width / (Max - Min + 1)) * Value
        .Left = Ctrl.Left + (Ctrl.Width - .Width + 1)
      Case UpToDown
        .Height = (Ctrl.Height / (Max - Min + 1)) * Value
        .Top = Ctrl.Top
        .Width = Ctrl.Width
        .Left = Ctrl.Left
      Case DownToUp
        .Height = (Ctrl.Height / (Max - Min + 1)) * Value
        .Top = Ctrl.Top + (Ctrl.Height - .Height + 1)
        .Width = Ctrl.Width
        .Left = Ctrl.Left
    End Select
    
    .BackColor = vbBlue   'QBColor(1)
    .Caption = ""
    If Percentage Then
      .Caption = Format(Value / Max * 100, "0") & "%"
      .TopMargin = IIf(.Height > FontHeight, (.Height - FontHeight) / 2, 0)
      .ForeColor = vbWhite  'QBColor(7)
      .FontName = "Tahoma"
      .FontSize = 8
      .TextAlign = 2
    End If
    
    .Visible = True
  End With
  
  DoEvents
End Sub


Private Sub CmdRun_Click()
  Dim Min, Max, Value
  
  Min = 1
  Max = 1000
  
  For Value = 1 To Max
    Call ProgCtrl(Me.Frame1, Value, Me.OptOrientation, Min, Max, True)
  Next Value
End Sub

تحياتي .

[مصلح الحريصي]

ما قصرت أخي أبو هادي

ولا نملك إلا أن ندعو لك بالتوفيق في الدنيا والأجر والثواب في الأخرة فقد ابدعت في مثالك وهذا ما عهدناه منك دائماً .

أكرر شكري لك

[أبو هادي]

السلام عليكم

لقد قمت بعد جهد جهيد بالمحافظة على شكل البراويز بأنواعها المختلفة ومقاساتها المتفاوتة .

صدقوني أني تعبت في حساب المقاسات أكثر من تصميم الشريط نفسه .

آمل أن لا يكون هناك أي خطأ .. حاولت فحصه بما أستطيع ولكن أعتقد أنه يحتاج إلى فحص أكثر .

تحياتي .

ProgCtrl_rev5.zip

[مصلح الحريصي]

أنا على يقين لو أكسيس يستطيع الحركة لهرب بسرعة البرق حين يسمع بذكر ابو هادي .

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

تحياتي لك

[أبو هادي]

السلام عليكم

أخي مصلح .. هل سيهرب خوفا أو كرها :( :d :lol:

شكرا لك على دعمك الا محدود ، كما لا أنسى شكر كل من مر على موضوعي هذا .

تحياتي .

[محمد طاهر عرفه]

ايه الحلاوة دي :d

ماشاء الله ، مثال جميل جدا

دائما متميز كما عودتنا (y)