تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
تعديل بسيط على الكود
#2
السلام عليكم

- أعتقد أنك تريد عمل كود للتخمين . لذلك للمرور على جميع الإحتمالات . عدلت الكود السابق وأيضاً أضفت طلبك بأن يتم فتح خانه جديدة عند الإنتهاء من الإحتمالات . وتستطيع أن تضع او تحدد عدد الخانات الجديدة التي تفتح أو طول النص المعروض في التكست وذلك بإلغاء التي باللون الأخضر وذلك بإزالة علامة التنصيص المفرد التي قبل كل سطر أخضر .

- هذا الكود . وأيضاً في المرفقات مثال :

كود :
Dim aIndex() As Integer
Dim aCols As Integer
'Dim MaxCols As Integer


Private Sub Command1_Click()

Command1.Enabled = False
'MaxCols = 6
aCols = 1
ReDim Preserve aIndex(1 To 1) As Integer
aIndex(1) = 1
Timer1.Enabled = True

End Sub


Private Sub Timer1_Timer()

Dim aChars As String
Static I As Integer
Dim Str_PrevCols As String
Dim N, Z As Integer

aChars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890/+-*@#%&)_"

If I < Len(aChars) Then

   I = I + 1
   For N = 1 To aCols
       Str_PrevCols = Str_PrevCols & Mid$(aChars, aIndex(N), 1)
   Next
   Text1.Text = Str_PrevCols & Mid$(aChars, I, 1)
   Exit Sub
  
Else

   For N = aCols To 1 Step -1
  
       If aIndex(N) < Len(aChars) Then
      
          I = 0
          aIndex(N) = aIndex(N) + 1
          If N < aCols Then
             N = N + 1
             For Z = N To aCols
                 aIndex(Z) = 1
             Next
          End If
          Exit Sub
          
       Else
                    
          If N = 1 Then
            
             'هنا إذا أردت تحديد طول او عدد الخانات الجديدة التي سيتم فتحها
             'If aCols + 1 >= MaxCols Then
             '   Timer1.Enabled = False
             '   Command1.Enabled = True
             '   MsgBox "تم الإنتهاء من عمل الكود"
             '   Exit Sub
             'End If
            
             ReDim Preserve aIndex(1 To aCols + 1) As Integer
             aCols = aCols + 1
             For Z = 1 To aCols
                 aIndex(Z) = 1
             Next
             I = 0
             Exit Sub
          
          End If
          
       End If
      
   Next

End If

End Sub

- تحياتي .


الملفات المرفقة
.rar   Random_CharsArray.rar (الحجم : 1.92 ك ب / التحميلات : 38)
الرد }}}
تم الشكر بواسطة:


الردود في هذا الموضوع
تعديل بسيط على الكود - بواسطة VB_Coder - 10-05-13, 02:59 AM
تعديل بسيط على الكود - بواسطة VB_Coder - 10-05-13, 03:08 PM


التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم