MENU EDITOR

AIM:To create a menu editor

CODE

Form1
Dim s As String
Private Sub color_Click()
CommonDialog1.ShowColor
rtb1.SelColor = CommonDialog1.color
End Sub
Private Sub copy_Click()
s = rtb1.SelText
End Sub
Private Sub cut_Click()
s = rtb1.SelText
rtb1.SelText = ""
End Sub
Private Sub edit_Click(Index As Integer)
If (rtb1.SelLength = 0) Then
copy.Enabled = False
cut.Enabled = False
Else
copy.Enabled = True
cut.Enabled = True
End If
If Clipboard.GetText = "" Then
paste.Enabled = False
Else
paste.Enabled = True
End If
End Sub
Private Sub exit_Click()
End
End Sub
Private Sub font_Click()
CommonDialog1.ShowFont
rtb1.SelFontName = CommonDialog1.FontName
rtb1.SelBold = CommonDialog1.FontBold
rtb1.SelItalic = CommonDialog1.FontItalic
rtb1.SelUnderline = CommonDialog1.FontUnderline
rtb1.SelStrikeThru = CommonDialog1.FontStrikethru
rtb1.SelFontSize = CommonDialog1.FontSize
End Sub
Private Sub mnunew_Click()
rtb1 = ""
End Sub
Private Sub open_Click()
CommonDialog1.ShowOpen
rtb1.LoadFile (CommonDialog1.FileName)
End Sub
Private Sub paste_Click()
rtb1.Text = rtb1.Text & s
End Sub
Private Sub save_Click()
CommonDialog1.ShowSave
rtb1.SaveFile (CommonDialog1.FileName)
End Sub






STUDENT INFORMATION SYSTEM


AIM:To prepare a form for students information using data control



CODE



Form 1
Private Sub ADD_Click(Index As Integer)
DATA.Recordset.AddNew
End Sub
Private Sub DELETE_Click(Index As Integer)
On Error Resume Next
DATA.Recordset.DELETE
If Not DATA.Recordset.EOF Then
DATA.Recordset.MoveNext
Else
If Not DATA.Recordset.BOF Then
DATA.Recordset.MovePrevious
Else
MsgBox "THIS WAS THE LAST RECORD IN THE TABLE"
End If
End If
End Sub
Private Sub EXIT_Click(Index As Integer)
End
End Sub
Private Sub FIND_Click(Index As Integer)
Dim NAME As String
NAME = InputBox("ENTER THE NAME TO SEARCH", "SEARCH FOR ")
DATA.Recordset.Index = "NAME"
DATA.Recordset.Seek "=", NAME
End Sub
59
Private Sub FIRST_Click(Index As Integer)
DATA.Recordset.MoveFirst
End Sub
Private Sub LAST_Click(Index As Integer)
DATA.Recordset.MoveLast
End Sub
Private Sub NEXT_Click(Index As Integer)
DATA.Recordset.MoveNext
If DATA.Recordset.EOF Then
MsgBox "YOU ARE ON THE LAST RECORD"
DATA.Recordset.MoveLast
End If
End Sub
Private Sub PREV_Click(Index As Integer)
DATA.Recordset.MovePrevious
If DATA.Recordset.BOF Then
MsgBox "YOU ARE ON THE FIRST RECORD"
DATA.Recordset.MoveFirst
End If
End Sub



STUDENT INFORMATION SYSTEM


AIM:To prepare a form for students information using data control



CODE



Form 1
Private Sub ADD_Click(Index As Integer)
DATA.Recordset.AddNew
End Sub
Private Sub DELETE_Click(Index As Integer)
On Error Resume Next
DATA.Recordset.DELETE
If Not DATA.Recordset.EOF Then
DATA.Recordset.MoveNext
Else
If Not DATA.Recordset.BOF Then
DATA.Recordset.MovePrevious
Else
MsgBox "THIS WAS THE LAST RECORD IN THE TABLE"
End If
End If
End Sub
Private Sub EXIT_Click(Index As Integer)
End
End Sub
Private Sub FIND_Click(Index As Integer)
Dim NAME As String
NAME = InputBox("ENTER THE NAME TO SEARCH", "SEARCH FOR ")
DATA.Recordset.Index = "NAME"
DATA.Recordset.Seek "=", NAME
End Sub
59
Private Sub FIRST_Click(Index As Integer)
DATA.Recordset.MoveFirst
End Sub
Private Sub LAST_Click(Index As Integer)
DATA.Recordset.MoveLast
End Sub
Private Sub NEXT_Click(Index As Integer)
DATA.Recordset.MoveNext
If DATA.Recordset.EOF Then
MsgBox "YOU ARE ON THE LAST RECORD"
DATA.Recordset.MoveLast
End If
End Sub
Private Sub PREV_Click(Index As Integer)
DATA.Recordset.MovePrevious
If DATA.Recordset.BOF Then
MsgBox "YOU ARE ON THE FIRST RECORD"
DATA.Recordset.MoveFirst
End If
End Sub



FONT DIALOG BOX

Aim: To stimulate a Font dialog box

CODE

Form1
Private Sub cmdfont_Click()
CommonDialog1.ShowFont
With lblfont.Font
.Name = CommonDialog1.FontName
.Bold = CommonDialog1.FontBold
.Size = CommonDialog1.FontSize
.Underline = CommonDialog1.FontUnderline
End With
End Sub
Private Sub cmdstop_Click()
End
End Sub

NUMERIC CONVERSIONS

AIM:To prepare a form for binary,decimal and octal conversions

CODE

Form 1
Private Sub Command1_Click()
Dim dec As Integer, d As Integer, i As Integer
Dim b As Long
dec = 0
i=0
b = Val(Text1.Text)
While (b > 0)
d = b Mod 10
dec = dec + d * 2 ^ i
i=i+1
b = b / 10
Wend
Text2.Text = dec
End Sub
Private Sub Command2_Click()
Dim n, a, i As Integer
Dim b(100) As Integer
n = Val(Text2.Text)
While (n <> 0)
b(i) = n Mod 2
n=n/2
i=i+1
Wend
For i = i - 1 To 0 Step -1
Text1.Text = Text1.Text & b(i)
Next
End Sub
Private Sub Command3_Click()
Dim oct, o, i As Integer
Dim b As Long
oct = 0
i=0
b = Val(Text1.Text)
While (b > 0)
o = b Mod 10
oct = oct + o * 8 ^ i
i=i+1
b = b / 10
Wend
Text3.Text = oct
End Sub
Private Sub Command4_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
End Sub
Private Sub Command5_Click()
End
End Sub


ONLINE QUIZ PROGRAM

AIM:To prepare an online quiz program

PROCEDURE
Select add-ins
->Visual data manager
->file
->new
->Microsoft Access
->Version.7.7. MDB

QUIZ TABLE
SLNO FIELDS DATATYPE
1 QNO LONG
2 QUESTION TEXT
3 OPTION 1 TEXT
4 OPTION 2 TEXT
5 OPTION 3 TEXT
6 OPTION 4 TEXT
7 ANS TEXT


CODE

Form 1
Private Sub examination_Click()
Form3.Show
End Sub
Private Sub question_Click()
Form2.Show
End Sub
Private Sub quit_Click()
End
End Sub

Form 2
Private Sub Command1_Click()
Data.Recordset.AddNew
With Data.Recordset
.Fields("qno") = Text1.Text
.Fields("question") = Text2.Text
.Fields("option1") = Text4.Text
.Fields("option2") = Text5.Text
.Fields("option3") = Text6.Text
.Fields("option4") = Text7.Text
.Fields("ans") = Text3.Text
End With
Data.Recordset.Update
End Sub
Private Sub Command2_Click()
Data.Recordset.Delete
Data.Recordset.MoveNext
End Sub
Private Sub Command3_Click()
Text1.Text = ""
Text2.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
End Sub
Private Sub Command4_Click()
Form1.Show
End Sub
Form 3
Dim a As Integer, answer As String, mark As Integer
Private Sub Command1_Click()
Form1.Show
End Sub
Private Sub Option1_Click(Index As Integer)
answer = Option1(Index).Caption
If answer = Data.Recordset.Fields("answer") Then
label4.Caption = "right answer"
mark = mark + 1
Else
label4.Caption = "wrong answer"
End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Option1(1).Value = False
Option2(2).Value = False
Option3(3).Value = False
Option4(4).Value = False
label4.Caption = ""
a = Text1.Text
Data.Refresh
Data.Recordset.MoveFirst
With Data.Recordset
While Not .EOF
If a = .Fields("qno") Then
Label2.Caption = .Fields("qno")
Label3.Caption = .Fields("question")
Option1(1).Caption = .Fields("option1")
Option2(2).Caption = .Fields("option2")
Option3(3).Caption = .Fields("option3")
Option4(4).Caption = .Fields("option4")
Exit Sub
Else
.MoveNext
End If
End Sub

SLIDER CONTROL

AIM:To prepare a form for using slider control



CODE

Form 1
Private Sub Form_Load()
RED.Min = 0
RED.Max = 250
RED.SmallChange = 1
RED.LargeChange = 25
RED.TickFrequency = 25
RED.Value = 0
GREEN.Min = 0
GREEN.Max = 250
GREEN.SmallChange = 1
GREEN.LargeChange = 25
GREEN.TickFrequency = 25
GREEN.Value = 0
BLUE.Min = 0
BLUE.Max = 250
BLUE.SmallChange = 1
BLUE.LargeChange = 25
BLUE.TickFrequency = 25
BLUE.Value = 0
colour.BackColor = RGB(RED.Value, GREEN.Value, BLUE.Value)
colour.Caption = Chr(10) & Chr(10) & "red=" & RED.Value & Chr(10) &
"green=" & GREEN.Value & Chr(10) & "blue=" & BLUE.Value
End Sub
Private Sub GREEN_Change()
colour.BackColor = RGB(RED.Value, GREEN.Value, BLUE.Value)
colour.Caption = Chr(10) & Chr(10) & "red=" & RED.Value & Chr(10) &
"green=" & GREEN.Value & Chr(10) & "blue=" & BLUE.Value
End Sub

Private Sub GREEN_Scroll()
colour.BackColor = RGB(RED.Value, GREEN.Value, BLUE.Value)
colour.Caption = Chr(10) & Chr(10) & "red=" & RED.Value & Chr(10) &
"green=" & GREEN.Value & Chr(10) & "blue=" & BLUE.Value
End Sub
Private Sub RED_Change()
colour.BackColor = RGB(RED.Value, GREEN.Value, BLUE.Value)
colour.Caption = Chr(10) & Chr(10) & "red=" & RED.Value & Chr(10) &
"green=" & GREEN.Value & Chr(10) & "blue=" & BLUE.Value
End Sub
Private Sub RED_Scroll()
colour.BackColor = RGB(RED.Value, GREEN.Value, BLUE.Value)
colour.Caption = Chr(10) & Chr(10) & "red=" & RED.Value & Chr(10) &
"green=" & GREEN.Value & Chr(10) & "blue=" & BLUE.Value
End Sub
Private Sub BLUE_Change()
colour.BackColor = RGB(RED.Value, GREEN.Value, BLUE.Value)
colour.Caption = Chr(10) & Chr(10) & "red=" & RED.Value & Chr(10) &
"green=" & GREEN.Value & Chr(10) & "blue=" & BLUE.Value
End Sub
Private Sub BLUE_Scroll()
colour.BackColor = RGB(RED.Value, GREEN.Value, BLUE.Value)
colour.Caption = Chr(10) & Chr(10) & "red=" & RED.Value & Chr(10) &
"green=" & GREEN.Value & Chr(10) & "blue=" & BLUE.Value
End Sub

OLE CONTROL

AIM:To prepare a form for using OLE control
CODE
Form 1
Private Sub OPEN_Click()
Dim fnum As Integer
On Error GoTo cancel
CommonDialog1.ShowOpen
fnum = FreeFile
Open CommonDialog1.FileName For Binary As #fnum
OLE1.ReadFromFile (fnum)
Close #fnum
Exit Sub
cancel:
MsgBox "could not load file"
Close #fnum
End Sub
Private Sub SAVE_Click()
Dim fnum As Integer
On Error GoTo cancel
fnum = FreeFile
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Binary As #fnum
OLE1.SaveToFile (fnum)
Close #fnum
Exit Sub
cancel:
MsgBox "could not save file"
Close #fnum
End Sub
Private Sub EXIT_Click()
End
End Sub

Private Sub mnuExit_Click(Index As Integer)
End
End Sub
Private Sub mnuOPen_Click(Index As Integer)
Dim fnum As Integer
On Error GoTo cancel
CommonDialog1.ShowOpen
fnum = FreeFile
Open CommonDialog1.FileName For Binary As #fnum
OLE1.ReadFromFile (fnum)
Close #fnum
Exit Sub
cancel:
MsgBox "could not load file" + Err.Description
Close #fnum
End Sub
Private Sub mnuSave_Click(Index As Integer)
Dim fnum As Integer
On Error GoTo cancel
fnum = FreeFile
CommonDialog1.ShowSave
Open CommonDialog1.FileName For Binary As #fnum
OLE1.SaveToFile (fnum)
Close #fnum
Exit Sub
cancel:
MsgBox "could not save file"
Close #fnum
End Sub


PICTURE VIEWER

AIM:To prepare a form for picture viewer

CODE

Form 1
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub File1_Click()
Dim temp As String
temp = Dir1.Path
If Right(temp, 1) = "\" Then
Picture1.Picture = LoadPicture(Dir1.Path & File1.FileName)
Else
Picture1.Picture = LoadPicture(Dir1.Path & File1.FileName)
End If
End Sub

NUMBER APPLICATION

AIM:To display whole,even,odd,prime and Fibonacci numbers upto a limit

CODE

Form 1
Dim num As Long, temp As String
Private Sub clear_Click()
display.Text = ""
End Sub
Private Sub even_Click()
display.Text = ""
temp = ""
If limit.Text = "" Then
MsgBox "please enter a number"
Exit Sub
End If
For num = 2 To CLng(limit.Text) Step 2
temp = temp & Str(num)
Next num
display.Text = temp
End Sub
Private Sub exit_Click()
End
End Sub
Private Sub fibonacci_Click()
Dim a, b, c As Long, temp As String
display.Text = ""
temp = ""
a = 1: b = 0
If limit.Text = "" Then
MsgBox "please enter a number"
Exit Sub
End If

For num = 1 To CLng(limit.Text)
c=a+b
a=b
b=c
If c >= CLng(limit.Text) Then Exit For
temp = temp & Str(c)
Next num
display.Text = temp
End Sub
Private Sub odd_Click()
Dim num As Long, temp As String
display.Text = ""
temp = ""
If limit.Text = "" Then
MsgBox "please enter a number"
Exit Sub
End If
For num = 1 To CLng(limit.Text) Step 2
temp = temp & Str(num)
Next num
display.Text = temp
End Sub
Private Sub prime_Click()
Dim i, j As Long, temp As String, flag As Boolean
display.Text = ""
temp = ""
If limit.Text = "" Then
MsgBox "please enter a number "
Exit Sub
End If

For i = 2 To CLng(limit.Text)
flag = True
For j = 2 To Sqr(i)
If i Mod j = 0 Then
flag = False
Exit For
End If
Next j
If flag Then temp = temp & Str(i)
Next i
display.Text = temp
End Sub
Private Sub whole_Click()
Dim num As Long, temp As String
display.Text = ""
temp = ""
If limit.Text = "" Then
MsgBox "please enter a number"
Exit Sub
End If
For num = 1 To CLng(limit.Text)
temp = temp & Str(num)
Next num
display.Text = temp
End Sub

FILE APPLICATION

AIM: To create a file and to perform write and read operations

CODE

Form 1
Private Sub Clear_Click()
Content.Text = ""
Content.SetFocus
End Sub
Private Sub Exit_Click()
End
End Sub
Private Sub Readfromfile_Click()
Dim Strg As String, fNum As Integer
On Error GoTo label
fNum = FreeFile()
Open "E:\vbhas\Sample.txt" For Input As #fNum
While Not EOF(fNum)
Line Input #fNum, Strg
Content.Text = Content.Text & Strg
Wend
Close #fNum
Content.SetFocus
Exit Sub
label:
MsgBox "Error............" & vbCrLf & Err.Description
End Sub
33
Private Sub Writetofile_Click()
Dim i As Integer, fNum As Integer
On Error GoTo label
fNum = FreeFile()
Open "E:\vbhas\Sample.txt" For Output As fNum
Print #fNum, Content.Text
Content.SetFocus
Close #fNum
Exit Sub
label:
MsgBox "Error............." & vbCrLf & Err.Description
End Sub

SCROLL BAR APPLICATION

AIM:To create a form showing scrollbar properties

CODE

Form 1
Private Sub Form_Load()
redScroll.Min = 0
redScroll.Max = 255
redScroll.SmallChange = 1
redScroll.LargeChange = 25
redScroll.Value = 10
greenscroll.Min = 0
greenscroll.Max = 255
greenscroll.SmallChange = 1
greenscroll.LargeChange = 25
greenscroll.Value = 100
bluescroll.Min = 0
bluescroll.Max = 255
bluescroll.SmallChange = 1
bluescroll.LargeChange = 25
bluescroll.Value = 0
redlabel.BackColor = RGB(255, 0, 0)
greenlabel.BackColor = RGB(0, 255, 0)
bluelabel.BackColor = RGB(0, 0, 255)
scrolllabel.Caption = Chr(10) & Chr(10) & Chr(10) & "red=" &
redScroll.Value & Chr(10) & "green=" & greenscroll.Value & Chr(10) &
"blue=" & bluescroll.Value
scrolllabel.BackColor = RGB(redScroll.Value, greenscroll.Value,
bluescroll.Value)
changelabel.Caption = Chr(10) & Chr(10) & Chr(10) & "red=" &
redScroll.Value & Chr(10) & "green=" & greenscroll.Value & Chr(10) &
"blue=" & bluescroll.Value
changelabel.BackColor = RGB(redScroll.Value, greenscroll.Value,
bluescroll.Value)
End Sub
Private Sub greenscroll_Change()

changelabel.Caption = Chr(10) & Chr(10) & Chr(10) & "red=" &
redScroll.Value & Chr(10) & "green=" & greenscroll.Value & Chr(10) &
"blue=" & bluescroll.Value
changelabel.BackColor = RGB(redScroll.Value, greenscroll.Value,
bluescroll.Value)
scrolllabel.Caption = Chr(10) & Chr(10) & Chr(10) & "red=" &
redScroll.Value & Chr(10) & "green=" & greenscroll.Value & Chr(10) &
"blue=" & bluescroll.Value
scrolllabel.BackColor = RGB(redScroll.Value, greenscroll.Value,
bluescroll.Value)
End Sub
Private Sub greenscroll_Scroll()
scrolllabel.Caption = Chr(10) & Chr(10) & Chr(10) & "red=" &
redScroll.Value & Chr(10) & "green=" & greenscroll.Value & Chr(10) &
"blue=" & bluescroll.Value
scrolllabel.BackColor = RGB(redScroll.Value, greenscroll.Value,
bluescroll.Value)
End Sub
Private Sub redScroll_Change()
changelabel.Caption = Chr(10) & Chr(10) & Chr(10) & "red=" &
redScroll.Value & Chr(10) & "green=" & greenscroll.Value & Chr(10) &
"blue=" & bluescroll.Value
changelabel.BackColor = RGB(redScroll.Value, greenscroll.Value,
bluescroll.Value)
scrolllabel.Caption = Chr(10) & Chr(10) & Chr(10) & "red=" &
redScroll.Value & Chr(10) & "green=" & greenscroll.Value & Chr(10) &
"blue=" & bluescroll.Value
scrolllabel.BackColor = RGB(redScroll.Value, greenscroll.Value,
bluescroll.Value)
End Sub
Private Sub redScroll_Scroll()
scrolllabel.Caption = Chr(10) & Chr(10) & Chr(10) & "red=" &
redScroll.Value & Chr(10) & "green=" & greenscroll.Value & Chr(10) &
"blue=" & bluescroll.Value
scrolllabel.BackColor = RGB(redScroll.Value, greenscroll.Value,
bluescroll.Value)
End Sub

STANDARD CALCULATOR

AIM: To create a standard calculator

CODE

Form 1
Option Explicit
Dim res As Double, cleardisp As Boolean, first As Boolean
Dim operation As String, mem As Double
Private Sub Backspace_Click()
If lbldisplay.Caption <> "" Then
lbldisplay.Caption = Mid(lbldisplay.Caption, 1, Len(lbldisplay.Caption) - 1)
End If
End Sub
Private Sub ce_Click()
lbldisplay.Caption = "0"
first = True
End Sub
Private Sub digit_Click(index As Integer)
On Error GoTo error
If cleardisp Then
lbldisplay.Caption = ""
cleardisp = False
End If
lbldisplay.Caption = lbldisplay.Caption & digit(index).Caption
Exit Sub
error:
lbldisplay.Caption = "error!" & Err.Description
End Sub

Private Sub equal_Click()
On Error GoTo error
Select Case operation
Case "+"
res = Str(res + Val(lbldisplay.Caption))
Case "-"
res = Str(res - Val(lbldisplay.Caption))
Case "*"
res = Str(res * Val(lbldisplay.Caption))
Case "/"
res = Str(res / Val(lbldisplay.Caption))
End Select
lbldisplay.Caption = Str(res)
first = True
Exit Sub
error:
lbldisplay.Caption = "error!" & Err.Description
End Sub
Private Sub Form_Load()
cleardisp = True
first = True
lbldisplay.Caption = "0"
End Sub
Private Sub off_Click()
End
End Sub
Private Sub operator_Click(index As Integer)
On Error GoTo error
If first Then
res = lbldisplay.Caption
operation = operator(index).Caption
cleardisp = True
first = False
Exit Sub
End If

Select Case operation
Case "+"
res = Str(res + Val(lbldisplay.Caption))
Case "-"
res = Str(res - Val(lbldisplay.Caption))
Case "*"
res = Str(res * Val(lbldisplay.Caption))
Case "/"
res = Str(res / Val(lbldisplay.Caption))
End Select
operation = operator(index).Caption
lbldisplay.Caption = Str(res)
cleardisp = True
Exit Sub
error:
lbldisplay.Caption = "error!" & Err.Description
End Sub
Private Sub PLUS_MINUS_Click()
On Error GoTo error
lbldisplay.Caption = Str(-1 * Val(lbldisplay.Caption))
first = True
cleardisp = True
Exit Sub
error:
lbldisplay.Caption = "error......!!" & Err.Description
End Sub
Private Sub sqrt_Click()
lbldisplay.Caption = Sqr(lbldisplay.Caption)
first = True
cleardisp = True
End Sub

LISTBOX SORTING

AIM:To sort a list of items using listbox

CODE

Form1
Private Sub Add1_Click()
Dim listitem As String
listitem = InputBox("Enter item to add to the list")
If Trim(listitem) <> "" Then
List1.AddItem listitem
End If
End Sub
Private Sub Add2_Click()
Dim listitem As String
listitem = InputBox("Enter item to add to the list")
If Trim(listitem) <> "" Then
List2.AddItem listitrem
End If
End Sub
Private Sub Backward_Click()
Dim i As Integer
For i = List2.ListCount - 1 To 0 Step -1
If List2.Selected(i) Then
List1.AddItem List2.List(i)
List2.RemoveItem i
End If
Next i
End Sub
Private Sub Clear1_Click()
List1.Clear
End Sub
Private Sub Forward_Click()
Dim i As Integer
For i = List1.ListCount - 1 To 0 Step -1
If List1.Selected(i) Then
List2.AddItem List1.List(i)
List1.RemoveItem i
End If
Next i
End Sub
Private Sub Remove1_Click()
Dim i As Integer
For i = List1.ListCount - 1 To 0 Step -1
If List1.Selected(i) Then
List1.RemoveItem i
End If
Next i
End Sub
Private Sub SelectAll1_Click()
Dim i As Integer
For i = List1.ListCount - 1 To 0 Step -1
List1.Selected(i) = True
Next i
End Sub
Private Sub SelectAll2_Click()
Dim i As Integer
For i = List2.ListCount - 1 To 0 Step -1
List2.Selected(i) = True
Next i
End Sub

COLOUR BOX USING COMBOX

AIM:To Display colours using combo box

CODE



Form 1
Dim i As Integer
Private Sub blue_Change()
colour.BackColor = RGB(Val(red.Text), Val(green.Text), Val(blue.Text))
colour.Caption = Chr(10) & Chr(10) & Chr(10) & Chr(10) & Chr(10) & "red="
& red.Text & Chr(10) & "green=" & green.Text & Chr(10) & "blue=" &
blue.Text
End Sub
Private Sub blue_Click()
colour.BackColor = RGB(Val(red.Text), Val(green.Text), Val(blue.Text))
colour.Caption = Chr(10) & Chr(10) & Chr(10) & Chr(10) & Chr(10) & "red="
& red.Text & Chr(10) & "green=" & green.Text & Chr(10) & "blue=" &
blue.Text
End Sub
Private Sub Form_Load()
For i = 0 To 255 Step 10
red.AddItem i
Next i
red.ListIndex = 1
For i = 0 To 255 Step 10
green.AddItem i
Next i
green.ListIndex = 1
For i = 0 To 255 Step 10
blue.AddItem i
Next i

blue.ListIndex = 1
redlabel.BackColor = RGB(255, 0, 0)
greenlabel.BackColor = RGB(0, 255, 0)
bluelabel.BackColor = RGB(0, 0, 255)
colour.BackColor = RGB(Val(red.Text), Val(green.Text), Val(blue.Text))
colour.Caption = Chr(10) & Chr(10) & Chr(10) & Chr(10) & Chr(10) & "red="
& red.Text & Chr(10) & "green=" & green.Text & Chr(10) & "blue=" &
blue.Text
End Sub
Private Sub green_Change()
colour.BackColor = RGB(Val(red.Text), Val(green.Text), Val(blue.Text))
colour.Caption = Chr(10) & Chr(10) & Chr(10) & Chr(10) & Chr(10) & "red="
& red.Text & Chr(10) & "green=" & green.Text & Chr(10) & "blue=" &
blue.Text
End Sub
Private Sub green_Click()
colour.BackColor = RGB(Val(red.Text), Val(green.Text), Val(blue.Text))
colour.Caption = Chr(10) & Chr(10) & Chr(10) & Chr(10) & Chr(10) & "red="
& red.Text & Chr(10) & "green=" & green.Text & Chr(10) & "blue=" &
blue.Text
End Sub
Private Sub red_Change()
colour.BackColor = RGB(Val(red.Text), Val(green.Text), Val(blue.Text))
colour.Caption = Chr(10) & Chr(10) & Chr(10) & Chr(10) & Chr(10) & "red="
& red.Text & Chr(10) & "green=" & green.Text & Chr(10) & "blue=" &
blue.Text
End Sub
Private Sub red_Click()
colour.BackColor = RGB(Val(red.Text), Val(green.Text), Val(blue.Text))
colour.Caption = Chr(10) & Chr(10) & Chr(10) & Chr(10) & Chr(10) & "red="
& red.Text & Chr(10) & "green=" & green.Text & Chr(10) & "blue=" &
blue.Text
End Sub

CHECK BOX

AIM: To create a form for check box operation

CODE

Form 1
Dim i As Integer
Private Sub Check_Click(Index As Integer)
Message.Caption = "YOU GOT"
For i = 0 To 5
If Check(i).Value = 1 Then
Message.Caption = Message.Caption & Chr(10) & Check(i).Caption
End If
Next i
End Sub
Private Sub Clear_Click()
For i = 0 To 5
Check(i).Value = False
Next i
Message.Caption = ""
End Sub
Private Sub Exit_Click()
End
End Sub


NUMBER PROGRAM

AIM:To check whether the given number is even,odd,armstrong ,fibonacci,factorial ,prime and
to display its square,square root,sum of digits and its reverse
CODE

Form 1
Private Sub Clear_Click(Index As Integer)
Dim i As Integer
For i = 0 To 9
OptionButton(i).Value = False
Next i
Number.Text = ""
Display.Caption = ""
Display.Visible = False
Number.SetFocus
End Sub
Private Sub Exit_Click(Index As Integer)
End
End Sub
Private Sub Form_Load()
Dim i As Integer
Display.Visible = False
For i = 0 To 9
OptionButton(i).Value = False
Next i
End Sub
Private Sub OptionButton_Click(Index As Integer)
Dim Temp As Integer, Sum As Integer, Rev As Integer, Digit As Integer, a As
Integer, b As Integer, c As Integer, i As Integer, Fact As Double, Flag As
Boolean
If IsNumeric(Number.Text) = False Then
MsgBox "Please Enter Number"
Display.Caption = ""
Exit Sub

ElseIf Val(Number.Text) < 0 Then
MsgBox "Please Enter a Positive number"
Exit Sub
ElseIf Len(Number.Text) > 4 Then
MsgBox "Enter a number upto 4 digits"
Exit Sub
End If
Display.Visible = True
Select Case Index
Case 0
If Val(Number.Text) Mod 2 = 0 Then
Display.Caption = Number.Text & "is even"
Else
Display.Caption = Number.Text & "not even"
End If
Case 1
If Val(Number.Text) Mod 2 = 1 Then
Display.Caption = Number.Text & "is odd"
Else
Display.Caption = Number.Text & "is not odd"
End If
Case 2
Temp = Val(Number.Text)
Sum = 0
While Temp > 0
Digit = Temp Mod 10
Sum = Sum + Digit ^ 3
Temp = Int(Temp / 10)
Wend
If Sum = Val(Number.Text) Then
Display.Caption = Number.Text & "is an armstrong number"
Else
Display.Caption = Number.Text & "is not an armstrong number"
End If

Case 3
a = 1: b = 0
While (c < Val(Number.Text))
c = a + b: a = b: b = c
Wend
If c = Val(Number.Text) Then
Display.Caption = Number.Text & "is a Fibonacci number"
Else
Display.Caption = Number.Text & "not a fibonacci number"
End If
Case 4
Fact = 1: i = 1
While Fact < Val(Number.Text)
Fact = Fact * i: i = i + 1
Wend
If Fact = Val(Number.Text) Then
Display.Caption = Number.Text & "is a perfect factorial"
Else
Display.Caption = Number.Text & "is not a perfect factorial"
End If
Case 5
Flag = True
For i = 2 To Sqr(Val(Number.Text))
If Val(Number.Text) Mod i = 0 Then
Flag = False
Exit For
End If
Next i
If Flag Then
Display.Caption = Number.Text & "is a prime number"
Else
Display.Caption = Number.Text & "is not a prime number"
End If
Case 6
Temp = Val(Number.Text)
Sum = 0
While Temp > 0
Digit = Temp Mod 10
Sum = Sum + Digit
Temp = Int(Temp / 10)
Wend

Display.Caption = "Sum of the individual digits of" & Number.Text & "is" &
Str(Sum)
Case 7
Display.Caption = "Square of " & Number.Text & " is " &
Str(Val(Number.Text)) ^ 2
Case 8
Display.Caption = "square root of" & Number.Text & "is " &
Str(Sqr(Val(Number.Text)))
Case 9
Temp = Val(Number.Text)
Rev = 0
While Temp > 0
Digit = Temp Mod 10
Rev = Rev * 10 + Digit
Temp = Int(Temp / 10)
Wend
Display.Caption = "Reverse of " & Number.Text & "is" & Str(Rev)
End Select
End Sub

STOPWATCH

AIM:To create a stopwatch

CODE
Form 1
Dim starttime
Private Sub cmdstart_Click()
starttime = Now
Timer1.Enabled = True
End Sub
Private Sub cmdstop_Click()
Timer1.Enabled = False
End Sub
Private Sub display_Click()
starttime = Now
End Sub
Private Sub exit_Click()
End
End Sub
Private Sub Form_Load()
display.BackColor = RGB(0, 255, 255)
display.ForeColor = RGB(0, 0, 255)
End Sub
Private Sub Timer1_Timer()
display.Caption = Format$(Now - starttime, "hh : mm : ss")
End Sub

O/P

SUM OF N NUMBERS USING ARRAY



AIM:To find the sum of n numbers using array

CODE
Form 1
Private Sub clear_Click()
Text1.Text = ""
End Sub
Private Sub end_Click()
End
End Sub
Private Sub sum_Click()
Dim i, a, n, sum As Integer
sum = 0
a=1
n = Val(Text1.Text)
Do While a <= n
sum = sum + a
a=a+1
Loop
MsgBox "The Result is" & sum
End Sub


KEYBOARD AND MOUSE EVENTS

AIM: To create a form for showing Keyboard and Mouse events
CODE
Form 1
Private Sub Clear_Click()
Dim i As Integer
message.Caption = ""
For i = 0 To 6
Day(i).Value = False
Next i
End Sub
Private Sub Day_KeyPress(Index As Integer, KeyAscii As Integer)
Dim temp As String, i As Integer
temp = ""
message.Caption = ""
message.Visible = True
If KeyAscii = 13 Then
For i = 0 To 6
If Day(i).Value = True Then temp = Day(i).Caption
Next i
message.Caption = Day(Index).Caption
End If
End Sub
Private Sub Day_MouseMove(Index As Integer, Button As Integer, Shift As
Integer, X As Single, Y As Single)
Dim temp As String, i As Integer
temp = ""
message.Caption = ""
message.Visible = True
For i = 0 To 6
If Day(i).Value = True Then temp = Day(i).Caption
Next i
message.Caption = Day(Index).Caption
End Sub
Private Sub Exit_Click()
End
End Sub

SIMPLE AND COMPOUND INTEREST

AIM:To prepare a form for calculating simple and compound interest
CODE

FORM 1
Private Sub Command1_Click()
End
End Sub
Private Sub Command2_Click()
Dim p, n, r As Integer
p = Val(Text1.Text)
n = Val(Text2.Text)
r = Val(Text3.Text)
si = (p * n * r) / 100
Text4.Text = si
End Sub
Private Sub Command3_Click()
p = Val(Text1.Text)
n = Val(Text2.Text)
r = Val(Text3.Text)
ci = p * (1 + (r / 100) ^ n)
Text4.Text = ci
End Sub


o/p