Visual Basic(Vb) practical

INDEX
1.Write a program which demonstrates the loading
of controls at runtime.
2. Write a program which demonstrates the dynamic
menus. For example the recently visited files are
added in menus which changes dynamically.
3. Write a program to create an analog clock,
which shows all the three hands (Hour, Minute and
second). You can add an option to change the
background of the clock.
4. Create an application such that it will collect
the Personal, Educational, and Professional
information from a candidate and creates resume in
rich text format automatically.
5. Create a program that enables the users to open
and choose files from the folders in their PC.
The picture viewer provides the functionality to
move to the NEXT and PREVIOUS photos, ZOOM IN &
ZOOM OUT

6. Develop a program Tic Tac Toe in VB so that
you can play the game virtually. First of all, you
need to draw the interface with four straight
lines, then insert nine image controls and make
them an array, Image1 (0) to Image1 (8). Secondly,
insert two pictures, one is a circle and the other
one is a cross to represent player 1 and player2.
7. A DRAG & DROP RECYCLE_BIN: Make a drag and drop
program that resembles a recycle bin. Drag and
drop is a common windows application where you can
drag and drop an object such as a file into a
folder or into a recycle bin. This capability can
be easily programmed in visual basic
8. TRAFFIC LIGHT: Create a Traffic light program
in which, one can insert one timer and sets its
interval according to its desire. Suppose set it
to 3000, which is equivalent to 3 seconds. Next
you insert three shapes and set their shape
properties to circle and fill the colors.
9. CUBIC FUNCTION GRAPH PLOTTER: Make a program
that enables users to input the coefficients of a
cubic equation and draw its graph. The cubic
equation takes the form ax3
+bx2
+cx+d.
10. GEOMETRIC PROGRESSION: Make a Visual Basic
program that can compute a geometric progression
and display the results in a list box.

1. Write a program which demonstrates the loading of
controls at runtime.
Dim i As Integer
Dim lblindex As Integer
Dim btnindex As Integer
Private Sub cmd_btn_Click(Index As Integer)
' first give the index =0 to command button at design
time
Load cmd_btn(btnindex)
With cmd_btn(btnindex)
.Caption = "Button " & btnindex
.Left = 3800
.Top = 1200 + btnindex * 500
.Height = 300
.Visible = True
End With
btnindex = btnindex + 1
End Sub
Private Sub cmd_lbl_Click()
Set lblnew = Controls.Add("VB.Label", "Labels" &
lblindex)
With lblnew
.Caption = "Label " & lblindex
.Left = 800
.Top = 1200 + lblindex * 500
.Visible = True
End With
lblindex = lblindex + 1
End Sub
Private Sub cmd_Remove_Button_Click()
If btnindex > 1 Then
btnindex = btnindex - 1
Unload cmd_btn(btnindex)
Else
MsgBox ("There is no Button to remove")
End If
End Sub
Private Sub cmd_remove_Label_Click()
If lblindex > 1 Then

lblindex = lblindex - 1
Me.Controls.Remove ("Labels" & lblindex)
Else
MsgBox ("There is no label to remove")
End If
End Sub
Private Sub cmd_Remove_Tbox_Click()
If i > 1 Then
i = i - 1
Me.Controls.Remove ("TextBox" & i)
Else
MsgBox ("There is no TextBox to remove")
End If
End Sub
Private Sub cmd_tbox_Click()
Set txtnew = Controls.Add("VB.TextBox", "TextBox" &
i)
txtnew.Text = "TextBox " & i
' move left, top, width , height
txtnew.Move 2200, 1200 + i * 500, 1400, 20
txtnew.Visible = True
i = i + 1
End Sub
Private Sub Form_Load()
i = 1
btnindex = 1
lblindex = 1
End Sub

2. Write a program which demonstrates the dynamic
menus. For example the recently visited files are added
in menus which changes dynamically.
Dim Index As Integer
Private Sub cmd_execute_Click()
If Index < 5 Then
Index = Index + 1
Load FileRecent(Index)
FileRecent(Index).Enabled = True
End If
Dim i As Integer
i = Index
Do While i > 1
FileRecent(i).Caption = FileRecent(i - 1).Caption
i = i - 1
Loop
FileRecent(1).Caption = tbox_command.Text

tbox_command.Text = ""
tbox_command.SetFocus
End Sub
Private Sub FileExit_Click()
End
End Sub
Private Sub FileRecent_Click(Index As Integer)
tbox_command.Text = FileRecent(Index).Caption
End Sub
Private Sub FileReset_Click()
For i = 1 To Index
Unload FileRecent(i)
Next
End Sub
FileRecent(0).Enabled = False
End Sub

3. Write a program to create an analog clock, which
shows all the three hands (Hour, Minute and second).
You can add an option to change the background of the
clock.
Dim min, hour As Integer
Const PI = 3.14159265 'Pi
constant
Dim theta As Single
Dim dtheta As Single
Dim second As Long
Dim cx As Single
Dim cy As Single
Dim radius As Single
Const stheta As Single = 4.7142857
Private Sub btn_image_Click()
CommonDialog1.Filter = "Graphics|*.bmp;*.gif;*.jpg|
Text File|*.txt|All Files|*.*"
CommonDialog1.ShowOpen
If Not Picture1.AutoRedraw Then Picture1.AutoRedraw
= True
Picture1.Picture =
LoadPicture(CommonDialog1.Filename)
Picture1.PaintPicture Picture1.Picture, 0, 0, 5000,
5000
gettime
End Sub
Public Sub gettime()
theta = stheta
dtheta = 2 * PI / 60
cx = 2500
cy = 2500
radius = 2300
second = Format(Time, "s") + Format(Time, "n") * 60 +
(Format(Time, "h") Mod 12) * 3600

min = second / 60
hour = Format(Time, "h") Mod 12
LineSec.X1 = 2500
LineSec.Y1 = 2500
theta = stheta + (second Mod 60) * dtheta
LineSec.x2 = cx + (radius - 100) * Cos(theta)
LineSec.y2 = cy + (radius - 100) * Sin(theta)
line_minute.X1 = 2500
line_minute.Y1 = 2500
line_Hour.X1 = 2500
line_Hour.Y1 = 2500
line_Hour.x2 = cx + (radius - 200) * Cos(stheta + (2
* PI / 3600) * min * 5)
line_Hour.y2 = cy + (radius - 200) * Sin(stheta + (2
* PI / 3600) * min * 5)
End Sub
Private Sub cmd_ForeColor_Click()
CommonDialog1.ShowColor
For i = 0 To Label14.Count - 1
Label14(i).ForeColor = CommonDialog1.color
Next i
Shape1.BorderColor = CommonDialog1.color
DrawCircle 2500, 2500, 2400, 60, CommonDialog1.color
End Sub
'LoadDots
DrawCircle 2500, 2500, 2400, 60
gettime
End Sub
Private Sub Timer2_Timer()
second = second + 1
theta = theta + dtheta
line_minute.x2 = cx + (radius - 100) * Cos(stheta +
(2 * PI / 3600) * second)
line_minute.y2 = cy + (radius - 100) * Sin(stheta +
(2 * PI / 3600) * second)

If second Mod 60 = 0 Then
theta = 4.7142857
min = min + 1
line_Hour.x2 = cx + (radius - 200) * Cos(stheta + (2
* PI / 3600) * min * 5)
line_Hour.y2 = cy + (radius - 200) * Sin(stheta + (2
* PI / 3600) * min * 5)
If second = 43200 Then second = 0
End If
If min = 720 Then
min = 0
End If
X = cx + radius * Cos(theta)
Y = cy + radius * Sin(theta)
LineSec.x2 = X
LineSec.y2 = Y
End Sub
Private Sub DrawCircle(ByVal cx As Single, ByVal cy
As Single, ByVal radius As Single, ByVal num_segments
As Integer, Optional fcolor As ColorConstants)
Const PI = 3.14159265
Dim X As Single
Dim Y As Single
Dim theta As Single
Dim dtheta As Single
Dim second As Integer
For i = 1 To Dot.Count - 1
Unload Dot(i)
Next
dtheta = 2 * PI / num_segments
theta = stheta
For seg = 1 To num_segments
theta = theta + dtheta
X = cx + radius * Cos(theta)
Y = cy + radius * Sin(theta)

Load Dot(seg)
Dot(seg).X1 = X
Dot(seg).Y1 = Y
Dot(seg).x2 = X + 2
Dot(seg).y2 = Y + 2
Dot(seg).BorderWidth = 3
If seg Mod 5 = 0 Then
Dot(seg).BorderWidth = 5
Else
Dot(seg).BorderColor = fcolor
End If
Dot(seg).Visible = True
Next seg
End Sub

4. Create an application such that it will collect the
Personal, Educational, and Professional information
from a candidate and creates resume in rich text format
automatically.
Const RTF_NUMSTART As String = _
"{rtf1ansideff0deftab720{fonttbl{f0fswiss
MS Sans Serif;}{f1fromanfcharset2 Symbol;}
{f2fnilfprq2fcharset2 Wingdings;}
{f3fromanfprq2 Times New Roman;}}" & vbCrLf & _
"{colortblred0green0blue0;}" & vbCrLf & _
"deflang1033pardli720fi-360plainf3fs24"
Const RTF_NUMITEM As String = _
"par @%@.tab "
Const RTF_NUMEND As String = "par }"
Dim sex As String
Private Sub btn_more_edu_Click()
Dim eindex As Integer
eindex = tbox_course.Count
If eindex > 8 Then
MsgBox ("Course completed")
Exit Sub
End If
Load tbox_course(eindex)
With tbox_course(eindex)
.Height = tbox_course(eindex - 1).Height
.Width = tbox_course(eindex - 1).Width
.Left = tbox_course(eindex - 1).Left
.Top = tbox_course(eindex - 1).Top +
tbox_course(eindex - 1).Height + 100
.Text = ""
.Visible = True
End With
Load tbox_iname(eindex)
With tbox_iname(eindex)
.Height = tbox_iname(eindex - 1).Height

.Width = tbox_iname(eindex - 1).Width
.Left = tbox_iname(eindex - 1).Left
.Top = tbox_iname(eindex - 1).Top + tbox_iname(eindex
- 1).Height + 100
.Visible = True
End With
Load tbox_stream(eindex)
With tbox_stream(eindex)
.Height = tbox_stream(eindex - 1).Height
.Width = tbox_stream(eindex - 1).Width
.Left = tbox_stream(eindex - 1).Left
.Top = tbox_stream(eindex - 1).Top +
tbox_stream(eindex - 1).Height + 100
.Visible = True
End With
Load tbox_board(eindex)
With tbox_board(eindex)
.Height = tbox_board(eindex - 1).Height
.Width = tbox_board(eindex - 1).Width
.Left = tbox_board(eindex - 1).Left
.Top = tbox_board(eindex - 1).Top + tbox_board(eindex
- 1).Height + 100
.Visible = True
End With
Load tbox_pyear(eindex)
With tbox_pyear(eindex)
.Height = tbox_pyear(eindex - 1).Height
.Width = tbox_pyear(eindex - 1).Width
.Left = tbox_pyear(eindex - 1).Left
.Top = tbox_pyear(eindex - 1).Top + tbox_pyear(eindex
- 1).Height + 100
.Visible = True
End With
Load tbox_per(eindex)
With tbox_per(eindex)
.Height = tbox_per(eindex - 1).Height
.Width = tbox_per(eindex - 1).Width
.Left = tbox_per(eindex - 1).Left
.Top = tbox_per(eindex - 1).Top + tbox_per(eindex -
1).Height + 100
.Visible = True

End With
If eindex > 4 Then
Load Label9(eindex)
With Label9(eindex)
.Height = Label9(eindex - 1).Height
.Width = Label9(eindex - 1).Width
.Left = Label9(eindex - 1).Left
.Top = tbox_course(eindex).Top
.Caption = "Other"
.Visible = True
End With
End If
End Sub
Private Sub calendar_dob_DblClick()
calendar_dob.Visible = False
tbox_DOB.Text = calendar_dob.Value
End Sub
Private Sub cmd_dob_Click()
calendar_dob.Visible = Not calendar_dob.Visible
End Sub
Private Sub cmd_enext_Click()
SSTab1.Tab = 2
End Sub
Private Sub cmd_more_Click()
Dim pindex As Integer
pindex = tbox_exper.Count
If pindex > 8 Then
MsgBox ("Experience done")
Exit Sub
End If
Load tbox_exper(pindex)
With tbox_exper(pindex)
.Height = tbox_exper(pindex - 1).Height
.Width = tbox_exper(pindex - 1).Width
.Left = tbox_exper(pindex - 1).Left
.Top = tbox_exper(pindex - 1).Top + tbox_exper(pindex
- 1).Height + 100
.Visible = True
End With

Load tbox_company(pindex)
With tbox_company(pindex)
.Height = tbox_company(pindex - 1).Height
.Width = tbox_company(pindex - 1).Width
.Left = tbox_company(pindex - 1).Left
.Top = tbox_company(pindex - 1).Top +
tbox_company(pindex - 1).Height + 100
.Visible = True
End With
Load tbox_from(pindex)
With tbox_from(pindex)
.Height = tbox_from(pindex - 1).Height
.Width = tbox_from(pindex - 1).Width
.Left = tbox_from(pindex - 1).Left
.Top = tbox_from(pindex - 1).Top + tbox_from(pindex -
1).Height + 100
.Visible = True
End With
Load tbox_to(pindex)
With tbox_to(pindex)
.Height = tbox_to(pindex - 1).Height
.Width = tbox_to(pindex - 1).Width
.Left = tbox_to(pindex - 1).Left
.Top = tbox_to(pindex - 1).Top + tbox_to(pindex -
1).Height + 100
.Visible = True
End With
Load tbox_desig(pindex)
With tbox_desig(pindex)
.Height = tbox_desig(pindex - 1).Height
.Width = tbox_desig(pindex - 1).Width
.Left = tbox_desig(pindex - 1).Left
.Top = tbox_desig(pindex - 1).Top + tbox_desig(pindex
- 1).Height + 100
.Visible = True
End With
Load tbox_tech(pindex)
With tbox_tech(pindex)
.Height = tbox_tech(pindex - 1).Height
.Width = tbox_tech(pindex - 1).Width

.Left = tbox_tech(pindex - 1).Left
.Top = tbox_tech(pindex - 1).Top + tbox_tech(pindex -
1).Height + 100
.Visible = True
End With
End Sub
Private Sub cmd_pnext_Click()
SSTab1.Tab = 1
End Sub
Private Sub cmd_pronext_Click()
SSTab1.Tab = 3
build_resume
End Sub
Function build_resume()
Dim str As String
str = ""
str = RTF_NUMSTART & " qc b " & tbox_name.Text &
"b0 par "
str = str & " qc " & tbox_city.Text & ", " &
tbox_state.Text & " par " & "b Mobile : " &
tbox_mobile & " par " & tbox_email.Text & " par "
str = str & "ql Summary" & " b0 par bullet tab
" & "Quick Learner with the ability to work under
pressure & willingness to enhance knowledge." & "
par bullet tab " & _
"Proficiency at grasping technical concept quickly
and implementing them in an effective manner." & "
par bullet tab " & _
"Hard Working, Time Management, Punctuality & having
good attitude." & " par par "
str = str & " b Education b0 par "
Dim i As Integer
Dim education As String
i = tbox_course.Count
While i > 0
i = i - 1

If tbox_course(i).Text <> "" Then
education = education & " bullettab " &
tbox_course(i).Text
If tbox_stream(i).Text <> "" Then
education = education & " in " & tbox_stream(i).Text
End If
education = education & " from " &
tbox_iname(i).Text & " (" & tbox_board(i).Text & ")
in " & tbox_pyear(i).Text & " with scoring " &
tbox_per(i).Text & "%. par "
End If
Wend
str = str & education
Dim prof As String
If tbox_exper(0).Text <> "" Then
prof = prof & " parpar b Experience b0par"
i = tbox_exper.Count
While i > 0
i = i - 1
If tbox_exper(i).Text <> "" Then
prof = prof & " bullettab " & tbox_exper(i).Text
& " in " & tbox_tech(i).Text & ", from " &
tbox_from(i).Text & " to " & tbox_to(i).Text
prof = prof & " in " & tbox_company(i).Text & " at
Designation " & tbox_desig(i).Text & " par"
End If
Wend
End If
str = str & prof
str = str & "par b " & "Personal Detail" & "
b0par" & " Father's Name :" & tbox_fname.Text &
"par" & " Date of Birth :" & tbox_DOB.Text &
"par Gender :" & sex & " par" & "
Marital Status :" & cbox_status.SelText & " par "
& " Address :" & tbox_address.Text & "
par "
str = str & " parb Declaration:b0par " & " I
here by declare that the above information are true
to the best of my knowledge and belief and can be
supported by reliable documents when needed."

str = str & "parpar Date:
tabtabtabtabtabtabtabtabtab (" &
UCase(tbox_name.Text) & ")"
'rtb_resume.SelAlignment = vbLeftJustify
rtb_resume.TextRTF = str & RTF_NUMEND
End Function
sex = "Male"
cbox_status.ListIndex = 0
End Sub
Private Sub opt_sexFemale_Click()
sex = "Female"
End Sub
Private Sub opt_sexMale_Click()
sex = "Male"
End Sub

5. Create a program that enables the users to open and
choose files from the folders in their PC. The picture
viewer provides the functionality to move to the NEXT
and PREVIOUS photos, ZOOM IN & ZOOM OUT
Dim Index As Integer
Dim path As String
Dim X, Y As Integer
Private Sub bnt_prev_Click()
If Index > 0 Then
Index = Index - 1
End If
path = File1.path
If Right(path, Len(path) - 2) <> "" Then
path = path & ""
End If
PictureViewer.Picture1.Picture = LoadPicture(path &
File1.List(Index))
PictureViewer.Picture1.PaintPicture
PictureViewer.Picture1.Picture, 0, 0, 800, 600
End Sub
Private Sub btn_next_Click()
If Index < File1.ListCount - 1 Then
Index = Index + 1
path = File1.path
If Right(path, Len(path) - 2) <> "" Then
path = path & ""
End If
Picture1.Picture = LoadPicture(path &
File1.List(Index))
Picture1.PaintPicture Picture1.Picture, 0, 0, 800,
600
Picture2.Picture = LoadPicture(path &
File1.List(Index))
End If
End Sub
Private Sub btn_open_Click()

openFolderDialog.Show 1
End Sub
Private Sub btn_zoomin_Click()
If Picture1.Picture = 0 Then
Exit Sub
End If
X = X + 80
Y = Y + 60
Picture1.Height = Y
Picture1.Width = X
Picture1.PaintPicture Picture1.Picture, 0, 0, X, Y
If X > Pic_holder.ScaleWidth Then
HScroll1.Max = X - Pic_holder.ScaleWidth
VScroll1.Max = Y - Pic_holder.ScaleHeight
Else
HScroll1.Max = 0
VScroll1.Max = 0
End If
End Sub
Private Sub btn_zoomout_Click()
If Picture1.Picture = 0 Then
Exit Sub
End If
If X > 160 Then
X = X - 80
Y = Y - 60
End If
Picture1.Height = Y
Picture1.Width = X
Picture1.PaintPicture Picture1.Picture, 0, 0, X, Y
If Picture1.ScaleWidth - Pic_holder.ScaleWidth > 0
Then
HScroll1.Max = Picture1.ScaleWidth -
Pic_holder.ScaleWidth
VScroll1.Max = Picture1.ScaleHeight -
Pic_holder.ScaleHeight
Else

HScroll1.Max = 0
VScroll1.Max = 0
End If
End Sub
X = 800
Y = 600
'Set up picturebox
With Picture1
.ScaleMode = vbPixels
.AutoRedraw = True
.DrawMode = vbInvert
.DrawStyle = SelDrawType
.BackColor = vbWhite
.MousePointer = vbCrosshair
.Left = 0
.Top = 0
.ScaleHeight = Pic_holder.ScaleHeight
.ScaleWidth = Pic_holder.ScaleWidth
End With
Picture2.ScaleHeight = Picture1.ScaleHeight
Picture2.ScaleWidth = Picture1.ScaleWidth
HScroll1.Max = Picture1.ScaleWidth -
Pic_holder.ScaleWidth
HScroll1.min = 0
VScroll1.Max = Picture1.ScaleHeight -
Pic_holder.ScaleHeight
HScroll1.min = 0
End Sub
Private Sub HScroll1_Change()
Picture1.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Change()
Picture1.Top = -VScroll1.Value
End Sub

6. Develop a program Tic Tac Toe in VB so that you can
play the game virtually. First of all, you need to draw
the interface with four straight lines, then insert nine
image controls and make them an array, Image1 (0) to
Image1 (8). Secondly, insert two pictures, one is a circle
and the other one is a cross to represent player 1 and
player2.
Dim sym As String
Dim winr(9) As String
sym = "X"
Dim i As Integer

For i = 0 To 8
winr(i) = i
Next i
End Sub
Private Sub Label1_Change()
If Label1.Caption = "Player 1" Then
sym = "X"
Else
sym = "0"
End If
End Sub
Private Sub lbl_gstatus_Click(Index As Integer)
If lbl_gstatus(Index).Caption = "" Then
lbl_gstatus(Index).Caption = sym
winr(Index) = sym
If Label1.Caption = "Player 1" Then
Label1.Caption = "Player 2"
Else
End If
check
End If
End Sub
Function check()
Dim i As Integer
Dim won As Boolean
Dim psymbol As String
If winr(0) = winr(1) And winr(1) = winr(2) Then
won = True
psymbol = winr(0)
ElseIf winr(2) = winr(4) And winr(4) = winr(6) Then
won = True
psymbol = winr(2)
won = True
psymbol = winr(0)
won = True
psymbol = winr(1)
won = True
psymbol = winr(2)

won = True
psymbol = winr(0)
won = True
psymbol = winr(3)
won = True
psymbol = winr(6)
End If
If won = True Then
Dim pno As Integer
If psymbol = "X" Then
pno = 1
Else
pno = 2
End If
MsgBox (" Player " & pno & " won")
won = False
For i = 0 To 8
winr(i) = i
lbl_gstatus(i).Caption = ""
Next i
End If
End Function

7. A DRAG & DROP RECYCLE_BIN: Make a drag
and drop program that resembles a recycle bin. Drag
and drop is a common windows application where you
can drag and drop an object such as a file into a folder
or into a recycle bin. This capability can be easily
programmed in visual basic
Private Sub Picture1_DragDrop(Source As Control, X As
Single, Y As Single)
Source.Visible = False
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift
As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
PopupMenu RestoreMenu, vbPopupMenuRightAlign
End If
End Sub
Private Sub Restore_Click()
Image1.Visible = True
End Sub

8. TRAFFIC LIGHT: Create a Traffic light program in
which, one can insert one timer and sets its interval
according to its desire. Suppose set it to 3000, which is
equivalent to 3 seconds. Next you insert three shapes
and set their shape properties to circle and fill the
colors.
Dim status(4) As Boolean
Const interval As Integer = 1000
Dim wait As Integer
Dim waittime(3) As Integer
Dim stage, t1, t2, t3, t4 As Integer
Private Sub Command1_Click()
Me.FillColor = vbRed
Me.FillStyle = vbSolid
Call light(250, 50, 1)
Call light(100, 200, 1)
Call light(400, 200, 1)
Call light(250, 300, 1)
waittime(0) = 10
waittime(1) = 4
waittime(2) = 8
Timer2.Enabled = True
Timer1.Enabled = True
t1 = waittime(0) + waittime(1)
t2 = (waittime(1) + waittime(2)) * 2 + 1
Label1.Left = 320
Label1.Top = 50
Label2.Left = 320
Label2.Top = 300
Label3.Left = 170
Label3.Top = 200
Label4.Left = 470
Label4.Top = 200
wait = 10
stage = 0
End Sub

Function light(X As Integer, Y As Integer, Optional c
As Integer)
Call rectangle(X, Y, X + 50, Y + 100)
Call fillcircle(X + 25, Y + 20, vbWhite)
Select Case c
Case 1:
Call fillcircle(X + 25, Y + 20, vbRed)
Case 2:
Call fillcircle(X + 25, Y + 50, vbYellow)
Case 3:
Call fillcircle(X + 25, Y + 80, vbGreen)
End Select
End Function
Function rectangle(X As Integer, Y As Integer, x2 As
Integer, y2 As Integer)
Me.Line (X, Y)-(X, y2), vbRed
Me.Line (x2, Y)-(x2, y2), vbRed
Me.Line (X, Y)-(x2, Y), vbRed
Me.Line (X, y2)-(x2, y2), vbRed
End Function
Function fillcircle(X As Integer, Y As Integer, color
As ColorConstants)
Me.FillColor = color
Me.Circle (X, Y), 10, vbBlack
End Function
t1 = t1 - 1
t2 = t2 - 1
t3 = t3 - 1
t4 = t4 - 1
Label1.Caption = t1
Label2.Caption = t2
Label3.Caption = t3
Label4.Caption = t4

End Sub
stage = stage + 1
Select Case stage
Case 1:
Timer2.interval = interval * waittime(1)
Case 2:
Call light(400, 200, 1)
t1 = waittime(2)
Case 3:
Call light(250, 300, 2)
t1 = (waittime(1) + waittime(2)) * 3 + waittime(1)
Case 4:
Call light(250, 300, 3)
t2 = waittime(2)
Case 5:
Call light(100, 200, 2)
Call light(250, 300, 2)
Case 6:
Call light(100, 200, 3)
Call light(250, 300, 1)
t3 = waittime(2)
Case 7:
Call light(100, 200, 2)
Call light(400, 200, 2)
Case 8:
Call light(100, 200, 1)
Call light(400, 200, 3)
t4 = waittime(2)
Case 9:
Call light(400, 200, 2)

stage = 1
End Select
End Sub
9. CUBIC FUNCTION GRAPH PLOTTER: Make a
program that enables users to input the coefficients of a
cubic equation and draw its graph. The cubic equation
takes the form ax3
+bx2
+cx+d.
Private Sub btn_cls_Click()
pic_graph.Cls
End Sub
Private Sub cmd_draw_Click()
Dim a, b, c, d As Integer
Dim w, v As Double
a = Val(tbox_a.Text)
b = Val(tbox_b.Text)
c = Val(tbox_c.Text)
d = Val(tbox_d.Text)
'Using a scale of 0.5 cm to represent i unit to draw
the graph

' Need to make some transformation as the coordinates
in VB start from top left
For w = 0 To 10 Step 0.001
v = a * (5 - w) ^ 3 + b * (5 - w) ^ 2 + c * (5 - w) +
d
pic_graph.PSet (w, 5 - v)
Next w
End Sub
Line_x.X1 = 0
Line_x.x2 = pic_graph.ScaleWidth
Line_x.Y1 = pic_graph.ScaleHeight / 2
Line_x.y2 = pic_graph.ScaleHeight / 2
Line_y.X1 = pic_graph.ScaleWidth / 2
Line_y.x2 = pic_graph.ScaleWidth / 2
Line_y.Y1 = 0
Line_y.y2 = pic_graph.ScaleHeight
End Sub

10. GEOMETRIC PROGRESSION: Make a Visual
Basic program that can compute a geometric
progression and display the results in a list box.
Private Sub btn_sum_Click()
Dim a, n As Integer
Dim r As Single
If check() = False Then
MsgBox ("Required fields are empty")
Exit Sub
End If
If opt_inputbox.Value Then
a = InputBox("First Term", "Geometric Progression",
1)
r = InputBox("Common Ratio", "Geometric Progression",
1)
n = InputBox("How many terms", "Geometric
Progression", 1)
Else
a = tbox_fn.Text
r = tbox_r.Text
n = tbox_terms.Text
End If
Dim s As Single
If r > 1 Then
s = (a * ((r ^ n) - 1)) / (r - 1)
Else
s = (a * (1 - (r ^ n))) / (1 - r)
End If
MsgBox ("The sum is " & s)
End Sub
Private Sub btn_term_Click()
Dim a, n As Integer
Dim r As Single
Exit Sub
End If
If opt_inputbox.Value Then

a = InputBox("First Term", "Geometric Progression",
1)
r = InputBox("Common Ratio", "Geometric Progression",
1)
n = InputBox("Which Term you want to display",
"Geometric Progression", 1)
Else
a = tbox_fn.Text
r = tbox_r.Text
n = tbox_terms.Text
End If
MsgBox ("The " & n & "th term is " & a * (r ^ (n -
1)))
End Sub
Private Sub cmd_Clear_Click()
List1.Clear
End Sub
Private Sub cmd_series_Click()
Exit Sub
End If
cmd_Clear_Click
Dim f, n, terms As Integer
Dim r As Single
f = tbox_fn.Text
r = tbox_r.Text
terms = tbox_terms.Text
List1.AddItem "Term" & vbTab & "Value"
List1.AddItem "-----------------------"
n = 1
Do
List1.AddItem n & vbTab & f * (r ^ (n - 1))
n = n + 1
Loop While n <= terms
End Sub
Function check() As Boolean
If tbox_fn.Text = "" Then
check = False
ElseIf tbox_r.Text = "" Then
check = False

ElseIf tbox_terms.Text = "" Then
check = False
Else
check = True
End If
End Function

Visual Basic(Vb) practical

More Related Content

What's hot

Similar to Visual Basic(Vb) practical

Recently uploaded

In this document

Visual Basic(Vb) practical