تعديل بسيط على الكود - نسخة قابلة للطباعة

تعديل بسيط على الكود - نسخة قابلة للطباعة

+- منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب (https://vb4arb.com/vb)
+-- قسم : قسم أسئلة واستفسارات الأعضاء - المنتدى القديم (https://vb4arb.com/vb/forumdisplay.php?fid=94)
+--- قسم : قسم Visual Basic 6 وما قبله (https://vb4arb.com/vb/forumdisplay.php?fid=167)
+--- الموضوع : تعديل بسيط على الكود (/showthread.php?tid=8837)

تعديل بسيط على الكود - samee119485r - 09-05-13

السلام عليكم ورحمة الله وبركاته

انا اسف ازعجتكم مع وبكثرت طلباتي سامحوني

اولا اشكر الاخ VB_Coder

على مساعدته لي.

وتمنى منه ومن العضاء التعديل على هاذا الكود

Private Sub Timer1_Timer()
Dim SmallChars As String
Dim CapitalChars As String
Dim Numbers As String
Dim Symbols As String
Static I, N, Z, R, E, X, M, F As Integer

SmallChars = "abcdefghijklmnopqrstuvwxyz"
CapitalChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Numbers = "1234567890"
Symbols = "/+-*@#%&)_"

If I < Len(SmallChars) Then

If N < Len(SmallChars) Then
N = N + 1
Text1.Text = Mid$(SmallChars, I + 1, 1) & Mid$(SmallChars, N, 1)
Exit Sub
End If

If Z < Len(Numbers) Then
Z = Z + 1
Text1.Text = Mid$(SmallChars, I + 1, 1) & Mid$(Numbers, Z, 1)
Exit Sub
End If

If R < Len(Symbols) Then
R = R + 1
Text1.Text = Mid$(SmallChars, I + 1, 1) & Mid$(Symbols, R, 1)
Exit Sub
Else
N = 0
Z = 0
R = 0
I = I + 1
Exit Sub
End If

End If

If E < Len(CapitalChars) Then

If X < Len(SmallChars) Then
X = X + 1
Text1.Text = Mid$(CapitalChars, E + 1, 1) & Mid$(SmallChars, X, 1)
Exit Sub
End If

If M < Len(Numbers) Then
M = M + 1
Text1.Text = Mid$(CapitalChars, E + 1, 1) & Mid$(Numbers, M, 1)
Exit Sub
End If

If F < Len(Symbols) Then
F = F + 1
Text1.Text = Mid$(CapitalChars, E + 1, 1) & Mid$(Symbols, F, 1)
Exit Sub
Else
X = 0
M = 0
F = 0
E = E + 1
Exit Sub
End If
Else
I = 0
E = 0
Exit Sub
End If
End Sub

المطلوب:

هاذا الكود يولد ارقام وحروف ورموز بتسلسل بس فيه مشكله انه بيضل يعيد على خانتين فقط :

وانا بدي يتعدل عليه بحيث كل ما يخلص توليد خانه يفتح خانه جديده
بالا نهايه

تعديل بسيط على الكود - VB_Coder - 10-05-13

السلام عليكم

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

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

كود :
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

- تحياتي .

تعديل بسيط على الكود - samee119485r - 10-05-13

وعليك السلام ورحمة الله وبركاته

اخي الكريم والله ثم والله وبالله ليعجز الكلام عن وصف مدى شكري وأمتنناني وتقديري لك

نعم هاذا الذي اطلب بتمام.

شكرا لك والف شكر

تعديل بسيط على الكود - VB_Coder - 10-05-13

السلام عليكم

- أهلا بك أخي العزيز ، شكراً لك .
- تحياتي .