اساتید vb6 بیان تو برای نوشتن چند برنامه ی کوچیک کمک کنند ! 1 روز وقت دارمـــــــــــــــــــــ

سلام دوستان با توجه به وقته کمی که دارم چند از دوستان کار بلد کمکم کنید کد این برنامه ها رو برام بنویسید
خیلی کارم گیره
« پیشاپیش تشکر »

1- 10 دانش آموز و 3 نمره از از هریک را از ورودی دریافت کند ، سپس نام هردانش آموز را به همراه معدل سه نمره ی او را نشان دهد در پایان نام دانش آموزانی که بالا ترین و پایین ترین معدل را دارند چاپ یا اعلام کند.
((**با استفاده از آرایه **))

2-تعدادی عدد دریافت شود و آنها را در یک ماتریس 4*4 قرار دهد و شپش این ماتریس را روی فرم نشان دهد
و با پیغامی اعلام کند قطر اصلی ماتریس با هم برابرند یا نه . ((**با استفاده از آرایه **))

3- دو عدد دریافت شود و با استفاده از یک تابع عدد کوچک را به نوان عدد بزرگ تر برساند.(* با استفاده از تابع *)

4-عددی دریافت شود و با استفاده از تابع فاکتوریل آن حساب شود. (* با استفاده از تابع *)

5- عددی چند رقمی دریافت شود و با کمک یک روال مجموع ارقام آن عدد را حساب کند و نمایش دهد.
( * با استفاده از روال * )

6 - عدد چند رقمی دریافت کند و و با استفاده از روال مقسوم علیه های آن را نماش دهد. (* استفاده از روال *)

7- رشته ای دریافت کند و تعداد فضاهای خالی میان حروف را با استفاده از روال نمایش دهد ((** روال**))
ممنون
انشا اله جبران کنیم
دمتون گرم!

هیچکی اینجا vb6 بلد نیست!!!!!!!!!!!!!!!!!
یعنی اینقدر سخته؟؟؟؟؟
من واقعا عجله دارم!

نقل قول:

---

نوشته شده توسط mehr film [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

سلام دوستان با توجه به وقته کمی که دارم چند از دوستان کار بلد کمکم کنید کد این برنامه ها رو برام بنویسید
خیلی کارم گیره
« پیشاپیش تشکر »

1- 10 دانش آموز و 3 نمره از از هریک را از ورودی دریافت کند ، سپس نام هردانش آموز را به همراه معدل سه نمره ی او را نشان دهد در پایان نام دانش آموزانی که بالا ترین و پایین ترین معدل را دارند چاپ یا اعلام کند.
((**با استفاده از آرایه **))

2-تعدادی عدد دریافت شود و آنها را در یک ماتریس 4*4 قرار دهد و شپش این ماتریس را روی فرم نشان دهد
و با پیغامی اعلام کند قطر اصلی ماتریس با هم برابرند یا نه . ((**با استفاده از آرایه **))

3- دو عدد دریافت شود و با استفاده از یک تابع عدد کوچک را به نوان عدد بزرگ تر برساند.(* با استفاده از تابع *)

4-عددی دریافت شود و با استفاده از تابع فاکتوریل آن حساب شود. (* با استفاده از تابع *)

5- عددی چند رقمی دریافت شود و با کمک یک روال مجموع ارقام آن عدد را حساب کند و نمایش دهد.
( * با استفاده از روال * )

6 - عدد چند رقمی دریافت کند و و با استفاده از روال مقسوم علیه های آن را نماش دهد. (* استفاده از روال *)

7- رشته ای دریافت کند و تعداد فضاهای خالی میان حروف را با استفاده از روال نمایش دهد ((** روال**))
ممنون
انشا اله جبران کنیم
دمتون گرم!

---

براي اولي

کد:

---

Private Sub StudentAvg()
 Dim StudentName(1 To 10) As String
 Dim StudentNumber(1 To 3, 1 To 10) As Single
 Dim StudentAvg(1 To 10) As Single
 Dim MaxAvg As Single, MinAvg As Single
 Dim Counter
 
 MaxAvg = 0
 MinAvg = 20
 
 For Counter = 1 To 10
 StudentName(Counter) = InputBox("Enter Name:")
 StudentNumber(1, Counter) = InputBox("Enter number 1 :")
 StudentNumber(2, Counter) = InputBox("Enter number 2 :")
 StudentNumber(3, Counter) = InputBox("Enter number 3 :")
 StudentAvg(Counter) = (StudentNumber(3, Counter) + StudentNumber(2, Counter) + StudentNumber(1, Counter)) / 3
 If StudentAvg(Counter) > MaxAvg Then MaxAvg = StudentAvg(Counter)
 If StudentAvg(Counter) < MinAvg Then MinAvg = StudentAvg(Counter)
 Next Counter
 
 Me.Cls
 Print String(10, "*") & " Student Name & Avg " & String(10, "*")
 Print "StudentName:" & vbTab & vbTab & "AVG:"
 For Counter = 1 To 10
 Print StudentName(Counter) & vbTab & vbTab & vbTab & Trim(StudentAvg(Counter))
 Next Counter
 
 Print
 Print String(10, "*") & " Max Avg " & String(10, "*")
 Print "StudentName:" & vbTab & vbTab & "AVG:"
 For Counter = 1 To 10
 If StudentAvg(Counter) = MaxAvg Then _
 Print StudentName(Counter) & vbTab & vbTab & vbTab & Trim(StudentAvg(Counter))
 Next Counter
 
 Print
 Print String(10, "*") & " Min Avg " & String(10, "*")
 Print "StudentName:" & vbTab & vbTab & "AVG:"
 For Counter = 1 To 4
 If StudentAvg(Counter) = MinAvg Then _
 Print StudentName(Counter) & vbTab & vbTab & vbTab & Trim(StudentAvg(Counter))
 Next Counter
End Sub

---

براي دومي

کد:

---

Private Sub ArrayShower()
 Dim Number(1 To 4, 1 To 4) As Single
 Dim RowCounter, ColCounter, Counter
 Dim NumberTemp As Single
 
 For RowCounter = 1 To 4
 For ColCounter = 1 To 4
 Number(RowCounter, ColCounter) = InputBox("Enter number:")
 Next ColCounter
 Next RowCounter
 
 Me.Cls
 For RowCounter = 1 To 4
 For ColCounter = 1 To 4
 Me.Print Number(RowCounter, ColCounter) & vbTab;
 Next ColCounter
 Me.Print: Me.Print
 Next RowCounter
 
 NumberTemp = Number(1, 1)
 For Counter = 2 To 4
 If Number(Counter, Counter) <> NumberTemp Then
 MsgBox "Main ghotr are not equal"
 Exit Sub
 End If
 Next Counter
 MsgBox "Main ghotr are equal"
End Sub

---

براي سومي

کد:

---

Private Function LowerPowerUper(ByVal Num1, ByVal Num2)
 Dim LowerNum, UperNum
 LowerNum = Num1
 If Num2 < LowerNum Then LowerNum = Num2
 
 If LowerNum = Num1 Then UperNum = Num2 Else UperNum = Num1
 
 LowerPowerUper = LowerNum ^ UperNum
End Function

---

براي چهارمي

کد:

---

Private Function Fact(ByVal Number)
 If Number = 1 Then Fact = 1 Else Fact = Fact(Number - 1) * Number
End Function

---

براي پنجمي

کد:

---

Private Sub DigitSumCalculator(ByVal Number)
 Dim Counter
 Dim DigitSum
 
 DigitSum = 0
 For Counter = 1 To Len(Number)
 DigitSum = DigitSum + Val(Mid$(Number, Counter, 1))
 Next Counter
 
 MsgBox "Digit Sum is: " & Trim(DigitSum)
End Sub

---

براي ششمي

کد:

---

Private Sub MaghsoomAlayhShower(ByVal Number)
 Dim Counter
 
 For Counter = 1 To Number
 If Number Mod Counter = 0 Then MsgBox Trim(Counter) & " is a maghsoomAlayah for " & Trim(Number)
 Next Counter
End Sub

---

براي هفتمي

کد:

---

Private Sub StringSpaceShower(ByVal Str As String)
 Dim Counter
 Dim SpaceNo
 
 SpaceNo = 0
 
 For Counter = 1 To Len(Str)
 If Mid(Str, Counter, 1) = Space(1) Then SpaceNo = SpaceNo + 1
 Next Counter
 
 MsgBox "Your entered string has " & Trim(SpaceNo) & " space(s)"
End Sub

---

براي ديگه نداريم

نقل قول:

---

اگه بدردت خورد، برام دعا کن کنکور اونجايي که مي خوام قبول بشم. [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

---

البته اين سوالات رو خودت بايد جواب ميدادي چون سخت نيستند و در حد ابتدايي هستند. [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

نقل قول:

---

نوشته شده توسط SuB [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

براي اولي

کد:

---

Private Sub StudentAvg()
 Dim StudentName(1 To 10) As String
 Dim StudentNumber(1 To 3, 1 To 10) As Single
 Dim StudentAvg(1 To 10) As Single
 Dim MaxAvg As Single, MinAvg As Single
 Dim Counter
 
 MaxAvg = 0
 MinAvg = 20
 
 For Counter = 1 To 10
 StudentName(Counter) = InputBox("Enter Name:")
 StudentNumber(1, Counter) = InputBox("Enter number 1 :")
 StudentNumber(2, Counter) = InputBox("Enter number 2 :")
 StudentNumber(3, Counter) = InputBox("Enter number 3 :")
 StudentAvg(Counter) = (StudentNumber(3, Counter) + StudentNumber(2, Counter) + StudentNumber(1, Counter)) / 3
 If StudentAvg(Counter) > MaxAvg Then MaxAvg = StudentAvg(Counter)
 If StudentAvg(Counter) < MinAvg Then MinAvg = StudentAvg(Counter)
 Next Counter
 
 Me.Cls
 Print String(10, "*") & " Student Name & Avg " & String(10, "*")
 Print "StudentName:" & vbTab & vbTab & "AVG:"
 For Counter = 1 To 10
 Print StudentName(Counter) & vbTab & vbTab & vbTab & Trim(StudentAvg(Counter))
 Next Counter
 
 Print
 Print String(10, "*") & " Max Avg " & String(10, "*")
 Print "StudentName:" & vbTab & vbTab & "AVG:"
 For Counter = 1 To 10
 If StudentAvg(Counter) = MaxAvg Then _
 Print StudentName(Counter) & vbTab & vbTab & vbTab & Trim(StudentAvg(Counter))
 Next Counter
 
 Print
 Print String(10, "*") & " Min Avg " & String(10, "*")
 Print "StudentName:" & vbTab & vbTab & "AVG:"
 For Counter = 1 To 4
 If StudentAvg(Counter) = MinAvg Then _
 Print StudentName(Counter) & vbTab & vbTab & vbTab & Trim(StudentAvg(Counter))
 Next Counter
End Sub

---

براي دومي

کد:

---

Private Sub ArrayShower()
 Dim Number(1 To 4, 1 To 4) As Single
 Dim RowCounter, ColCounter, Counter
 Dim NumberTemp As Single
 
 For RowCounter = 1 To 4
 For ColCounter = 1 To 4
 Number(RowCounter, ColCounter) = InputBox("Enter number:")
 Next ColCounter
 Next RowCounter
 
 Me.Cls
 For RowCounter = 1 To 4
 For ColCounter = 1 To 4
 Me.Print Number(RowCounter, ColCounter) & vbTab;
 Next ColCounter
 Me.Print: Me.Print
 Next RowCounter
 
 NumberTemp = Number(1, 1)
 For Counter = 2 To 4
 If Number(Counter, Counter) <> NumberTemp Then
 MsgBox "Main ghotr are not equal"
 Exit Sub
 End If
 Next Counter
 MsgBox "Main ghotr are equal"
End Sub

---

براي سومي

کد:

---

Private Function LowerPowerUper(ByVal Num1, ByVal Num2)
 Dim LowerNum, UperNum
 LowerNum = Num1
 If Num2 < LowerNum Then LowerNum = Num2
 
 If LowerNum = Num1 Then UperNum = Num2 Else UperNum = Num1
 
 LowerPowerUper = LowerNum ^ UperNum
End Function

---

براي چهارمي

کد:

---

Private Function Fact(ByVal Number)
 If Number = 1 Then Fact = 1 Else Fact = Fact(Number - 1) * Number
End Function

---

براي پنجمي

کد:

---

Private Sub DigitSumCalculator(ByVal Number)
 Dim Counter
 Dim DigitSum
 
 DigitSum = 0
 For Counter = 1 To Len(Number)
 DigitSum = DigitSum + Val(Mid$(Number, Counter, 1))
 Next Counter
 
 MsgBox "Digit Sum is: " & Trim(DigitSum)
End Sub

---

براي ششمي

کد:

---

Private Sub MaghsoomAlayhShower(ByVal Number)
 Dim Counter
 
 For Counter = 1 To Number
 If Number Mod Counter = 0 Then MsgBox Trim(Counter) & " is a maghsoomAlayah for " & Trim(Number)
 Next Counter
End Sub

---

براي هفتمي

کد:

---

Private Sub StringSpaceShower(ByVal Str As String)
 Dim Counter
 Dim SpaceNo
 
 SpaceNo = 0
 
 For Counter = 1 To Len(Str)
 If Mid(Str, Counter, 1) = Space(1) Then SpaceNo = SpaceNo + 1
 Next Counter
 
 MsgBox "Your entered string has " & Trim(SpaceNo) & " space(s)"
End Sub

---

براي ديگه نداريم

البته اين سوالات رو خودت بايد جواب ميدادي چون سخت نيستند و در حد ابتدايي هستند. [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

---

دوست عزیز واقعا نمیدونم با چه زبونی ازت تشکر کنم واقعا ممنونم بیخودی نیست زیر اسمت زده پروفشنال !!!
نکته: اولی و دومی مشکی نداشت و خیلی هم توپ بود
برای بقیه نحوه ی نمایشش یا همون فراخانی رو روی فرم هم کاشکی بنویسی چون من الان مشکل دارم
توی هفتمی هم از len(str) کامپایل ارور میگیره!
دستت بیبلا الهی دانشگاه کمبریج انگلستان قبول شی!!!!:46:

SuB جان به خاطر اين پشتكار و حوصلت بايد يه * ديگه هم بگيري به خدا !
چه حوصله اي داري بشر !

نقل قول:

---

نوشته شده توسط jamali [ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]

SuB جان به خاطر اين پشتكار و حوصلت بايد يه * ديگه هم بگيري به خدا !
چه حوصله اي داري بشر !

---

آره به خدا
اگه دست من بود 2 تا * بهش میدادم