ایجاد لغت

[blackhatgh]

سلام دوستان
من میخواستم یه برنامه ای بنویسم که باید یک قسمتش من تمام کلمات ممکن با حروف را طبق طول کلمه بسازم.

مثلا :
یک کلمه دو حرفی بخوام بسازم باید هر 28 کاراکتر رو با 28 کاراکتر بعدی امتحان کنم :

اینجوری :
aa
ab
...
ba
bb
...

هالا بازم بستگی به طول رشته داره .
مثلا کلمه 2 حرفی میشه 28*28 کلمه که 748 کلمه میسازه.اگه کمک کنید خیلی ممنون میشم.
برای یک برنامه خیلی ضروریه.
ممنون:قلب::قلب::قلب:

[vbhamed]

سلام

يك ليست باكس بزاريد روي صفحه، ضمنا انگليسي 26 حرف داره
Private Sub Form_Load()

Dim i%, j%
For i = 1 To 26
For j = 1 To 26
List1.AddItem Chr$(i + 96) & Chr$(j + 96)
Next
Next

End Sub

[blackhatgh]

ممنون دوست عزیز هالا من اگه بخوام اینو برای تعداد کاراتر دلخواه انجام بدم چی ؟ نمیدونم کاربر چند کاراکتر میده که بخوام همون تعداد حقه بزارم ؟

ممنون:قلب:

[SlowCode]

کافیه تعداد ارقامی رو که کاربر وارد میکنه رو به جای 26 بنویسی. مثلا:
Private Sub Form_Load()

Dim i%, j%
For i = 1 To text1.text
For j = 1 To text1.text
List1.AddItem Chr$(i + 96) & Chr$(j + 96)
Next
Next

End Sub
البته در این صورت باید ورودی رو کنترل کنی تا برنامه خطا نده، مثلا اگه منفی باشه اجرا نمیشه.

[blackhatgh]

کافیه تعداد ارقامی رو که کاربر وارد میکنه رو به جای 26 بنویسی. مثلا:
Private Sub Form_Load()

Dim i%, j%

For i = 1 To text1.text
For j = 1 To text1.text
List1.AddItem Chr$(i + 96) & Chr$(j + 96)
Next
Next

End Sub
البته در این صورت باید ورودی رو کنترل کنی تا برنامه خطا نده، مثلا اگه منفی باشه اجرا نمیشه.



ممنون دوست عزیز ولی من منظورم این که همون 26 تا حرف رو کنار هم بزاره ولی مثلا ما 2 تا For میزاریم تمام کلمات 2 کاراکتی چاپ میشود من میخوام مثلا کاربر 3 رو وارد کنه تمام کلمات 3 حرفی ممکن با این 26 حرف رو بسازه یعنی 17576 کلمه بسازه هالا بنا بر نیاز کاربر.
بازم ممنون:قلب:

[blackhatgh]

میتونی از روش زیر استفاده کنی، تعداد تکرار حلقه ها همون مقدار text2 هست:
Dim i%, j%
1:
For i = 1 To text1.text
For j = 1 To text1.text
List1.AddItem Chr$(i + 96) & Chr$(j + 96)
Next
Next
a=a+1
if a<= text2.text then goto 1

نه دوست عزیز بازم خروجی فقط 2 حرف ما هر عددی به Text2 بدیم چون ما 2 ته حلقه بیشتر تعریف نکردیم که و بعد هم ما تو این خط :

List1.AddItem Chr$(i + 96) & Chr$(j + 96)

فقط 2 کاراکتر رو کنار هم میزاریم.
به نظر من باید باید یجوری این کد هارو تو خود برنامه تغییر بدیم تا بشه البته شایدم راه دیگه ای باشه ؟

بازم ممنون.:قلب:

[amin32]

باید از روش بازگشتی استفاده کنید. اگه اشتباه نکنم در درس طراحی الگوریتم در مورد یک چنین چیزی بحث شده بود ولی من اون رو پیدا نکردم. به هر حال یک لیست باکس قرار بدید و از تابع زیر استفاده کنید:


Public Function NumberToWord(ByVal lngWord As Long) As String
Dim lngLetter As Long
Do While lngWord > 0
lngLetter = (lngWord - 1) Mod 26 + 1
NumberToWord = Chr(lngLetter + 96) & NumberToWord
lngWord = (lngWord - 1) \ 26
Loop
End Function


و برای فراخوانی از این کد استفاده کنید:


L = 3
Do
i = i + 1
List1.AddItem NumberToWord(i)
Loop Until (NumberToWord(i) = String(L, "z"))


شما باید در متغیر L به جای 3 طول رشته رو قرار بدید. البته توجه داشته باشید که اجرای الگوریتم برای بیشتر از سه کاراکتر خیلی طول میکشه.

[blackhatgh]

باید از روش بازگشتی استفاده کنید. اگه اشتباه نکنم در درس طراحی الگوریتم در مورد یک چنین چیزی بحث شده بود ولی من اون رو پیدا نکردم. به هر حال یک لیست باکس قرار بدید و از تابع زیر استفاده کنید:


Public Function NumberToWord(ByVal lngWord As Long) As String
Dim lngLetter As Long
Do While lngWord > 0
lngLetter = (lngWord - 1) Mod 26 + 1
NumberToWord = Chr(lngLetter + 96) & NumberToWord
lngWord = (lngWord - 1) \ 26
Loop
End Function


و برای فراخوانی از این کد استفاده کنید:


L = 3
Do
i = i + 1
List1.AddItem NumberToWord(i)
Loop Until (NumberToWord(i) = String(L, "z"))


شما باید در متغیر L به جای 3 طول رشته رو قرار بدید. البته توجه داشته باشید که اجرای الگوریتم برای بیشتر از سه کاراکتر خیلی طول میکشه.

ممنون دوست عزیز بله منظورم هم همین بود شما راهکاری برای افزایش سرعت یا یک الگوریتم جدید تر که سرعت بالاتری داشته یاشه رو سراغ ندارید از DoEvents هم استفاده کردم ولی برای رقم های بالا یازم به مشکل زمان برخورد کردم.
بازم ممنون.:قلب:

[amin32]

ممنون دوست عزیز بله منظورم هم همین بود شما راهکاری برای افزایش سرعت یا یک الگوریتم جدید تر که سرعت بالاتری داشته یاشه رو سراغ ندارید از DoEvents هم استفاده کردم ولی برای رقم های بالا یازم به مشکل زمان برخورد کردم.
بازم ممنون.:قلب:


خواهش میکنم.
به نظرم این مساله فقط به روش بازگشتی حل میشه. من هم الگوریتم بهینه تری سراغ ندارم.

[vbhamed]

سلام

اينم كمي سريعتر و بدون الگوريتم بازگشتي
چون تعداد بالا هست سرعت مسلما پايين مياد ولي بايد ديد استفاده شما چيه، ضمنا چون ما داريم به ليست اضافه مي‌كنيم خيلي طول ميكشه، مثلا من مقايسه كردم براي 4 كاراكتري اضافه به ليست 14 ثانيه و قراردادن در آرايه 2.5 ثانيه طول كشيد

اما برنامه زير طوري نوشته شده كه مي‌تونيد كلمه با شماره رديف دلخواه رو سريع به دست بياريد مثلا من نوشتم اگر 8 كاراكتري باشه، كلمه 1,999,999,999 ام چي ميشه يا اگر 3 كاراكتري باشه كلمه 17564 (هفده هزار و پانصد و شصت و چهارم) چي ميشه كه برنامه در جا حساب مي‌كنه

Private Function word(ByVal r#, ByVal l#) As String

On Error Resume Next

Dim i#, c#, s$

For i = 0 To l - 1

If i > 0 Then

c = (r \ (26 ^ i))
c = c - ((c \ 26) * 26)
s = Chr$(c + 97) & s
Else

c = r - ((r \ 26) * 26)
s = Chr$(c + 97)
End If

Next

word = s

End Function

Private Sub Form_Load()

Dim i#, l#

List1.AddItem word(1999999999#, 8)
List1.AddItem word(17564, 3)

l = 3

For i = 0 To 26 ^ l - 1
List1.AddItem i & " : " & word(i, l)
Next

End Sub