PDA

View Full Version : اعداد تصادفی



پرستو پارسایی
جمعه 28 اسفند 1394, 08:10 صبح
با سلام
من میخواهم از عدد 1 تا 300 بصورت تصادفی در 5 لیست باکس add کنم که هر لیست باکس بخشی از اعداد 1 تا 300 رو دریافت کنه و تکراری نباشند
در اصل هر لیست باکس 60 عدد بگیره و با لیست باکس های دیگر عدد مشترک نداشته باشه
ممنون میشم در صورت اطلاع پاسخ دهید

milad_d993
جمعه 28 اسفند 1394, 10:09 صبح
یه آرایه 300 خانه ای رو توی یه حلقه for با توابع تولید اعداد تصادفی پر کنید.
بعد عناصر 0 تا 59 رو توی combo اول بریزید و ....
چند طور میشه انجامش داد.

پرستو پارسایی
جمعه 28 اسفند 1394, 11:40 صبح
اگر میشه یکی از این چند طور رو با مثال(کد) مرحمت بفرمایید
ممنون

gilsoft
سه شنبه 03 فروردین 1395, 19:43 عصر
سلام دوست عزیز
اول دوتا Button و دوتا RichTextBox رو فرم بزار ....
اینم کدی که میخواستی:
Imports VB = Microsoft.VisualBasic

Public Class Form1
Public MinValue As Long = CLng(0)
Public MaxValue As Long = Long.MaxValue

Public Ar(300) As Integer

Public Function GenerateNumber() As Long
VB.Randomize()
GenerateNumber = 0
Try
GenerateNumber = CLng(MinValue + ((MaxValue - MinValue) * Rnd()))
Catch ex As Exception
End Try
End Function 'GenerateNumber() As Long

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Button1.Text = "Generate"
Button2.Text = "Sort"
MinValue = 1
MaxValue = 300
End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim value As Long = 0
RichTextBox1.Clear()
For Ndx As Long = MinValue To MaxValue
ReGenerateNumber:
value = GenerateNumber()
If CInt(Ar.Contains(value) = True) Then GoTo ReGenerateNumber
Ar(Ndx) = value
RichTextBox1.Text &= String.Format(Ndx + 1).ToString & ". " & Ar(Ndx).ToString & vbCrLf
Next
End Sub

Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
Array.Sort(Ar)
RichTextBox2.Clear()
For Ndx As Long = 0 To 299
RichTextBox2.Text &= String.Format(Ndx + 1).ToString & ". " & Ar(Ndx).ToString & vbCrLf
Next
End Sub
End Class



موفق باشید .....

پرستو پارسایی
چهارشنبه 04 فروردین 1395, 12:15 عصر
سپاسگزارم از شما دوست گرامی خیلی محبت کردید امکانش هست کد ها بصورت توضیحات متنی که در بالا گذاشتم در لیست باکس باشه و اعداد در یک ستون دریافت بشه .
باز هم تشکر میکنم

gilsoft
پنج شنبه 05 فروردین 1395, 03:38 صبح
امکانش هست کدها بصورت توضیحات متنی که در بالا گذاشتم در لیست باکس باشه و اعداد در یک ستون دریافت بشه .

سلام مجدد دوست عزیز

اینم کدهای مربوطه:
Imports VB = Microsoft.VisualBasic

Public Class Form1
Public MinValue As Long = CLng(0)
Public MaxValue As Long = Long.MaxValue

Public Ar(300) As Integer

Public Function GenerateNumber() As Long
VB.Randomize()
GenerateNumber = 0
Try
GenerateNumber = CLng(MinValue + ((MaxValue - MinValue) * Rnd()))
Catch ex As Exception
End Try
End Function

Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
Button1.Text = "Generate"
MinValue = 1
MaxValue = 300
End Sub

Private Sub Button1_Click(sender As System.Object, e As System.EventArgs) Handles Button1.Click
Dim value As Long = 0
Dim LBX As Byte

For Ndx As Long = MinValue To MaxValue
ReGenerateNumber:
value = GenerateNumber()
If CInt(Ar.Contains(value) = True) Then GoTo ReGenerateNumber
Ar(Ndx) = value
LBX = Ndx Mod 5
Select Case LBX
Case 0 : ListBox1.Items.Add(value)
Case 1 : ListBox2.Items.Add(value)
Case 2 : ListBox3.Items.Add(value)
Case 3 : ListBox4.Items.Add(value)
Case 4 : ListBox5.Items.Add(value)
End Select
Next
Label1.Text = ListBox1.Items.Count
Label2.Text = ListBox2.Items.Count
Label3.Text = ListBox3.Items.Count
Label4.Text = ListBox4.Items.Count
Label5.Text = ListBox5.Items.Count
End Sub

End Class

موفق باشید .....

samiasoft
پنج شنبه 05 فروردین 1395, 05:34 صبح
این قسمت از کد برای من خطا میاره »

If CInt(Ar.Contains(value) = True) Then GoTo ReGenerateNumber

در واقع خاصیت Contains رو داخل Ar پیدا نمیکنه !

gilsoft
پنج شنبه 05 فروردین 1395, 06:41 صبح
این قسمت از کد برای من خطا میاره »

If CInt(Ar.Contains(value) = True) Then GoTo ReGenerateNumber

در واقع خاصیت Contains رو داخل Ar پیدا نمیکنه !

سلام دوست عزیز
من پروژه رو ضمیمه می‌کنم ( برای من هیچ خطایی نمیده )

موفق باشید .....

پرستو پارسایی
پنج شنبه 05 فروردین 1395, 07:06 صبح
سپاسگزارم بدون ارور هست و کدهاش همونیه که میخواستم
ممنونم