Posted: Mon May 09, 2005 9:45 pm Post subject: تمرین های ویژوال بیسیک
'frmtrst:
'give the nomber of numbers
'give n numbers
'get average
Option Explicit
Private Sub cmdcalculate_Click()
Dim totcount, totnum, ncount, inputno As Integer
Dim naver As Single
lbldisp.Caption = ""
totcount = Val(txtcount.Text)
Do While ncount < totcount
inputno = InputBox("Enter a no ", "input no")
ncount = ncount + 1
totnum = totnum + inputno
Loop
If totcount > 0 Then
naver = totnum / ncount
End If
lbldisp.Caption = "The average is " & naver
txtcount.Text = ""
End Sub
Private Sub Form_Load()
End Sub
'frm421
'10*10 stars
Option Explicit
Private Sub cmdstar_Click()
Dim i As Integer
For i = 1 To 100
Print "*";
If i Mod 10 = 0 Then
Print
End If
Next i
End Sub
Private Sub Form_Load()
End Sub
'frm0605
'the most little
Option Explicit
Private Sub cmdsmall_Click()
Dim val1 As Long, val2 As Long, val3 As Long
val1 = txtone.Text
val2 = txttwo.Text
val3 = txtthree.Text
Call minimum(val1, val2, val3)
End Sub
Private Sub minimum(min As Long, y As Long, z As Long)
If y < min Then
min = y
End If
If z < min Then
min = z
End If
lblsmall.Caption = "smallest value is " & min
End Sub
'count & print even
'frm0703
Option Explicit
Private Sub cmdprint_Click()
Dim s(9) As Integer
Dim x As Integer
Cls
For x = LBound(s) To UBound(s)
s(x) = 2 + 2 * x
Next x
For x = LBound(s) To UBound(s)
Print Space$(2) & x & Space$(7) & s(x)
Next x
End Sub
'frm0706
Option Explicit
Dim marray(-5 To 5) As Integer
Private Sub cmdarray_Click()
Dim x As Integer
Call initialize
Call modifyarray(marray())
Call printmodified
End Sub
Private Sub cmdelement_Click()
Dim x As Integer
Call initialize
For x = LBound(marray) To UBound(marray)
Call modifyelement(marray(x))
Next x
Call printmodified
End Sub
Private Sub cmdexit_Click()
End
End Sub
Private Sub initialize()
Dim x As Integer
lstoriginal.Clear
lstmodified.Clear
For x = LBound(marray) To UBound(marray)
marray(x) = x
lstoriginal.AddItem marray(x)
Next x
End Sub
Private Sub printmodified()
Dim x As Integer
For x = LBound(marray) To UBound(marray)
lstmodified.AddItem marray(x)
Next x
End Sub
Private Sub modifyarray(a() As Integer)
Dim x As Integer
For x = LBound(a) To UBound(a)
a(x) = a(x) * 2
Next x
End Sub
Private Sub modifyelement(element As Integer)
element = element * 5
End Sub
Private Sub Form_Load()
End Sub
'frmboolean
Option Explicit
Private Sub cmdprint_Click()
Dim bool As Boolean
Dim x As Integer
x = -1
Print "x" & vbTab & "bool"
Do Until x = 10
bool = x
Print x & vbTab & bool
x = x + 1
Loop
Print
bool = True
Print bool
bool = False
Print bool
End Sub
'frmcompund
Option Explicit
Private Sub cmdcal_Click()
Dim years As Integer
Dim interestrate As Double
Dim amount As Currency
Dim principal As Currency
lstdisplay.Clear
years = 10
principal = txtamount.Text
interestrate = txtinterest.Text / 100
lstdisplay.AddItem "year " & vbTab & "amount on deposit"
For years = 1 To 10
amount = principal * (1 + interestrate) ^ years
lstdisplay.AddItem Format$(years, "@@@@") & vbTab & Format$(Format$(amount, "currency"), _
String$(17, "@"))
Next years
End Sub
Private Sub cmdexit_Click()
End
End Sub
'frmdisplay
Option Explicit
Private Sub cmdprint_Click()
Dim counter As Integer
txtinput.SetFocus
counter = 0
counter = Val(txtinput.Text)
lbldisplay.Caption = ""
'txtinput.SetFocus
Do While counter > 0
lbldisplay.Caption = lbldisplay.Caption & "#"
counter = counter - 1
Loop
End Sub
'frmdraw
Option Explicit
Private Sub cmddraw_Click()
Dim side As Integer, row As Integer, column As Integer
side = txtinput.Text
Cls
If side <= 12 Then
If side > 0 Then
row = 1
While row <= side
column = 1
While column <= side
If row = 1 Or row = side Or column = 1 Or column = side Then
Print "$";
Else
Print "&";
End If
column = column + 1
Wend
Print
row = row + 1
Wend
Else
Print "side too small "
Beep
End If
Else
Print "side too large "
Beep
End If
End Sub
'frmfig0310
Option Explicit
Dim sum As Integer
Private Sub cmdadd_Click()
sum = sum + txtinput.Text
txtinput.Text = ""
txtsum.Text = sum
End Sub
Private Sub cmdexit_Click()
End
End Sub
'frmfig0614
Option Explicit
Private Sub cmddivide_Click()
Dim numerator As Integer, denominator As Integer
Dim result As String
numerator = txtnum.Text
denominator = txtden.Text
result = divide(numerator, denominator)
If result = "" Then
lblthree.Caption = "divide by zero"
Else
lblthree.Caption = result
End If
End Sub
Private Function divide(n As Integer, d As Integer) As String
If d = 0 Then
Exit Function
Print "after exit function "
Else
divide = "division yields " & n / d
End If
End Function
'frmsecurity
Option Explicit
Dim maccesscode As Long
Private Sub cmd3_Click()
txtdisplay.Text = txtdisplay.Text & "3"
End Sub
Private Sub cmd4_Click()
txtdisplay.Text = txtdisplay.Text & "4"
End Sub
Private Sub cmd5_Click()
txtdisplay.Text = txtdisplay.Text & "5"
End Sub
Private Sub cmd6_Click()
txtdisplay.Text = txtdisplay.Text & "6"
End Sub
Private Sub cmd7_Click()
txtdisplay.Text = txtdisplay.Text & "7"
End Sub
Private Sub cmd8_Click()
txtdisplay.Text = txtdisplay.Text & "8"
End Sub
Private Sub cmd9_Click()
txtdisplay.Text = txtdisplay.Text & "9"
End Sub
Private Sub cmdclear_Click()
txtdisplay.Text = ""
End Sub
Private Sub cmdenter_Click()
Dim message As String
lstlongentery.Clear
maccesscode = Val(txtdisplay.Text)
txtdisplay.Text = ""
Select Case maccesscode
Case Is < 1000
message = "Aceess Denied "
Beep
Case 1645 To 1689
message = "Technican personnel"
Case 8345
message = "Custodial Services"
Case 55875
message = "Special Services"
Case 999898, 1000006 To 1000008
message = "Scientific Personal"
Case Else
message = "Acess DEnied "
End Select
lstlongentery.AddItem Now & Space$(3) & message
End Sub
Private Sub cmdone_Click()
txtdisplay.Text = txtdisplay.Text & "1"
End Sub
Private Sub cmdzero_Click()
txtdisplay.Text = txtdisplay.Text & "0"
End Sub
Private Sub cmd2_Click()
txtdisplay.Text = txtdisplay.Text & "2"
End Sub
You cannot post new topics in this forum You cannot reply to topics in this forum You cannot edit your posts in this forum You cannot delete your posts in this forum You cannot vote in polls in this forum
Profile 
Log in to check your private messages | 
FAQ 
Search 
Memberlist 
Usergroups 
Log in
Register
