Visual Basic 6.0 Program

1)Write a VB program to check whether given number is perfect or not by

using ‘msgbox’.

SLIP 18_1)
Private Sub cmdprefect_Click()

Dim n As Integer
Dim i As Integer

   Dim sum As Integer
   n = Val(txtnumber.Text)
   For i = 1 To n \ 2
If n Mod i = 0 Then
sum = sum + i
   End If
Next
   If sum = n Then
MsgBox "Numbe is perfect"
Else
   MsgBox "Number is not perfect"
   End If

2)Write a VB Program to find sum of digit of a given number till it reduces
to single digit.
Accept input through textbox and Display the output in
Message Box (using function)
slip2.1

Private Sub Cmdsum_Click()

ans = display()

MsgBox ("Ansis "&ans)

End Sub

Public Function display() As Integer

s = 0

n = Val(Text1.Text)

While n > 9

s = 0

While n > 0

r = n Mod 10

s = s + r

n = n \ 10

Wend

n = s

Wend

display = s

End Function

3) Write a VB program to accept a number from user and calculate sum of

even digits of a given number.

slip11)

Private Sub cmdEven_Click()

Dim number As Integer

n = Val(txtnumber.Text)
   Dim rem As Integer
   Dim sum As Integer
   While n > 0
rem = n Mod 10
n = n \ 10
   If rem Mod 2 = 0 Then
   sum = sum + rem
   End If
Wend
txtanswer.Text = "Sum of even digisis :" & sum
         End Sub

4) Write a VB program to display the reverse of a given number using
function.
SLIP 6_1)
Private Sub cmdReverse_Click()
          Call Reverse
   End Sub

'function Defination
                 Function Reverse()
                 Dim n As Integer
                 Dim rem As Integer
                 Dim sum As Integer
                 num = Val(txtnumber.Text)
                While num > 0
                 remr = num Mod 10
                 sum = sum * 10 + rem
                 num = num \ 10
                Wend
   txtresult.Text = sum
End Function

5) Write a VB program to find Armstrong numbers between 1 to 1000 and
display it onto the form using function.

        Private Sub cmdAmstrong_Click()
              Print "Amstrong Numbers are"
              Call Amstrongnum
       End Sub

       Public Function Amstrongnum()
             Dim n As Integer
             Dim i As Integer
             Dim rem As Integer
             Dim sum As Integer
             For i = 2 To 1000
             n = i
             sum = 0
              While n > 0
                  rem = n Mod 10
                  sum = sum + (rem * rem * rem)
                  number = number \ 10
           Wend
           If i = sum Then
                 Print i
           End If
        Next
        End Function

6) Write program in VB to find factorial of a number using ‘msgbox’.
    SLIP 19_1)

Private Sub cmdFacto_Click()
                Dim f As Integer
                 f = 1
               Dim i As Integer
Dim n As Integer
   n = Val(txtnumber.Text)
For i = 1 To n
   f = f * i
                    Next
   MsgBox "Factorial is "& f
End Sub

7) Write a VB program to display the reverse of a given number using function.

SLIP 6_1

'Function Call

Private Sub cmdReverse_Click()

Call Reverse

End Sub

'Function Defination

Function Reverse()

Dim n As Integer

Dim rem As Integer

Dim sum As Integer

n = Val(txtnumber.Text)

While n > 0

rem = n Mod 10

sum = sum * 10 + rem

n = n \ 10

Wend

txtsum.Text = sum

End Function

8) Write a VB program to display all even and odd numbers from an array.

SLIP 17_1

Private Sub Cmdevenodd_Click()

Dim arr(6) As Integer

Dim i As Integer

For i = 0 To 6

arr(i) = Val(InputBox("Enter Array elements"))

Next i

For i = 0 To 6

If arr(i) Mod 2 = 0 Then

Print "Even No : " & arr(i)

Else

Print "Odd No: " &arr(i)

End If

End Sub

9) Write a VB program to convert a temperature from Celsius to Fahrenheit

and vice versa.

SLIP 20_1

Dim temp As Integer

Private Sub Cmdctof_Click()

temp = Val(txtctof.Text)

Dim F As Integer

F = temp * 9 / 5 + 32

lblanswer.Caption = "Temp in F is "& F

End Sub

Private Sub Cmdftoc_Click()

temp = Val(txtctof.Text)

Dim C As Integer

C = (temp - 32) * 5 / 9

lblanswer.Caption = "Temp in C is "& C

End Sub

10) Write a VB Program to find transpose of a matrix.

SLIP 29_1

Private Sub cmdtranspose_Click()

Dim a(2, 2) As Integer

Dim b(2, 2) As Integer

Dim j As Integer

Dim i As Integer

For i = 0 To 2

For j = 0 To 2

a(i, j) = Val(InputBox("Enter array element"))

Next i

For i = 0 To 2

For j = 0 To 2

b(j, i) = a(i, j)

Next i

Print "Matrix A is "

For i = 0 To 2

For j = 0 To 2

Print a(i, j);

Print ""

Next i

Print "Transpose of matrix A is"

For i = 0 To 2

For j = 0 To 2

Print b(i, j)

Print ""

Next i

End Sub

11)Write a VB Program to display Fibonacci series up to given term (Accept term

using Input Box )and display Fibonacci series on to the form.

Slip5.1

Private Sub Cmdfibbo_Click()

n = InputBox("Enter The Term")

a = 0

b = 1

Print "Fibonacci Series is : "

Print a

Print b

For i = 1 To n - 2

c = a + b

a = b

b = c

Print c

End Sub

12) Write a VB Program to accept a number from user and check whether

it is palindrom or not (Accept number using input box ) and

display result using message box.

Slip8.1

Private Sub Cmdpalindrom_Click()

Dim no As Integer

Dim no2 As Integer

Dim sum As Integer

no = Val(Text1.Text)

no2 = no

While no

r = no Mod 10

sum = sum * 10 + r

no = no \ 10

Wend

If no2 = sum Then

MsgBox ("Number is palindrome")

Else

MsgBox ("Number is not palindrome")

End If

End Sub

13)Write a VB program to enter two positive numbers, calculate the sum of

the products of each pair of digits occupying the same position in the two

numbers. Display the result on to the form.

Example:If first number is 45 and second number is 534, then output will be

32(0*5+4*3+5*4=32) Slip17.1

Private Sub Cmdsum_Click()

Dim no1 As Integer

Dim no2 As Integer

Dim r1 As Integer, r2 As Integer, sum As Integer

no1 = Val(Text1.Text)

no2 = Val(Text2.Text)

While no1 Or no2

r1 = no1 Mod 10

r2 = no2 Mod 10

prod = r1 * r2

sum = sum + prod

no1 = no1 \ 10

no2 = no2 \ 10

Wend

Print "Sum of Product is "; sum

End Sub

14)Write a VB program to accept Input from Textbox. Check whether

given input is alphabet or number. If it is alphabet check that it is in

uppercase or lowercase. Display appropriate result using msgbox.

Slip23.1

Private Sub Cmdcheck_Click()

Dim no As String

no = Text1.Text

If Asc(no) < 91 And Asc(no) > 64 Then

MsgBox ("The given character is alphabet in UppercasLetter")

ElseIfAsc(no) < 123 And Asc(no) > 96 Then

MsgBox ("The given character is alphabet in Lowercaseletter")

ElseIfAsc(no) < 58 And Asc(no) > 47 Then

MsgBox ("The given character is number")

Else

MsgBox ("Enter Valid Input")

End If

End Sub

15) Write a VB program to find sum of first and last digits of a given
number. Display the output using msgbox

Private Sub cmdsum_Click()
n = Val(txtnumber1.Text)
re = n Mod 10
count = Len(n)

   For i = 1 To count Step 1
   If i < count Then
   n = n\10
End If
   Next
   Sum = num + re
   lblanswer.Caption = "Answer" & Sum
    End Sub

16)Write a VB Program to find the root of quadratic equation.

Private Sub cmdqroot_Click()
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim r1 As Double
Dim r2 As Double
Dim uroot As Integer
a = Val(txtnumber1.Text)
b = Val(txtnumber2.Text)
c = Val(txtnumber3.Text)
   uroot = Math.Sqr(b * b - 4 * a * c)
   Print uroot
   r1 = (-b + uroot) / (2 * a)
   r2 = (-b - uroot) / (2 * a)
txtr1.Text = r1
txtr2.Text = r2
   End Sub

17)Write a VB Program to accept birth date through textbox from
user and calculate age. (Use Message box to display result)

Private Sub cmdagecalculate_Click()

Bdate = txtbdate.Text

MsgBox ("Current Age is :" &Getage(Bdate))

End Sub

'Function Defination

Public Function Getage(Bdate As Variant) As String

Dim yr As Integer, mon As Integer, d As Integer

Dim cdt As Date

Dim ans As String

gdt = CDate(Bdate)

If gdt> Now Then Exit Function

yr = Year(gdt)

Print yr

mon = Month(gdt)

Print mon

d = Day(gdt)

Print d

yr = Year(Date) - yr

mon = Month(Date) - mon

d = Day(Date) - d

ans = yr& " years" &mon& " month" & d & " day "

Getage = ans

End Function

18)Write a VB a program to accept a string from user if the string

contain any integer number that getreplaced by *.

Private Sub cmdreplace_Click()

Dim s As String

Dim s1 As String

s = txtstring.Text

s1 = Replace(s, "9", "*")

s1 = Replace(s1, "8", "*")

s1 = Replace(s1, "7", "*")

s1 = Replace(s1, "6", "*")

s1 = Replace(s1, "5", "*")

s1 = Replace(s1, "4", "*")

s1 = Replace(s1, "3", "*")

s1 = Replace(s1, "2", "*")

s1 = Replace(s1, "1", "*")

s1 = Replace(s1, "0", "*")

txtans.Text = s1

End Sub

19)Write a menu driven program in VB for

i. Addition

ii. Subtraction

iii. Multiplication

iv. Division

Private Sub cmdsubmit_Click()

Dim n, a, b, s As Integer

a = Val(InputBox("Enter 1st Number:"))

b = Val(InputBox("Enter 2nd Number:"))

n = Val(InputBox("Enter Your Choice"))

Select Case n

Case 1

s = a + b

labans = "Addition is : " & s

Case 2

s = a - b

labans = "Subraction is : " & s

Case 3

s = a * b

labans = "Multiplication is : " & s

Case 4

s = a / b

labans = "Division is:" & s

End Select

End Sub

21) Design a calculator in VB, Which has Two extra command buttons to

check factorial of given number and to check whether entered number is even or odd

Dim op As Integer

Dim n1 As Double

Dim n2 As Double

Private Sub cmaadd_Click()

n1 = CDbl(Text1.Text)

Text1.Text = " "

op = 1

End Sub

Private Sub cmd0_Click()

Text1.Text = Text1.Text & 0

End Sub

Private Sub cmd1_Click()

Text1.Text = Text1.Text & 1

End Sub

Private Sub cmd2_Click()

Text1.Text = Text1.Text & 2

End Sub

Private Sub cmd3_Click()

Text1.Text = Text1.Text & 3

End Sub

Private Sub cmd4_Click()

Text1.Text = Text1.Text & 4

End Sub

Private Sub cmd5_Click()

Text1.Text = Text1.Text & 5

End Sub

Private Sub cmd6_Click()

Text1.Text = Text1.Text & 6

End Sub

Private Sub cmd7_Click()

Text1.Text = Text1.Text & 7

End Sub

Private Sub cmd8_Click()

Text1.Text = Text1.Text & 8

End Sub

Private Sub cmd9_Click()

Text1.Text = Text1.Text & 9

End Sub

Private Sub cmdc_Click()

Text1.Text = " "

End Sub

Private Sub cmddot_Click()

Text1.Text = Text1.Text & "."

End Sub

Private Sub cmdeo_Click()

n1 = CDbl(Text1.Text)

If n1 Mod 2 = 0 Then

Text1.Text = "Even"

Else

Text1.Text = "odd"

End If

End Sub

Private Sub cmdequal_Click()

Dim p As Integer

Dim i As Integer

p = 1

n2 = CDbl(Text1.Text)

If op = 1 Then

Text1.Text = n1 + n2

ElseIf op = 2 Then

Text1.Text = n1 - n2

ElseIf op = 3 Then

Text1.Text = n1 * n2

ElseIf op = 4 Then

Text1.Text = n1 / n2

ElseIf op = 5 Then

For i = 1 To n2

p = p * n1

Text1.Text = p

End If

End Sub

Private Sub cmdfact_Click()

Dim i As Long

Dim fact As Long

fact = 1

n1 = CDbl(Text1.Text)

For i = 1 To n1

fact = fact * i

Text1.Text = fact

End Sub

Private Sub cmdminus_Click()

n1 = CDbl(Text1.Text)

Text1.Text = " "

op = 2

End Sub

Private Sub cmdmul_Click()

n1 = CDbl(Text1.Text)

Text1.Text = " "

op = 3

End Sub

Private Sub cmdpow_Click()

n1 = CDbl(Text1.Text)

Text1.Text = " "

op = 5

End Sub

Private Sub Command2_Click()

n1 = CDbl(Text1.Text)

Text1.Text = " "

op = 4

End Sub

22)Write a VB Program to accept the number from the user in text box and display multiplication
table of that number into the list box.

Private Sub cmddisplay_Click()

Dim i, j, m As Integer

i = txtnumber.Text

m = 1

For j = 1 To 10

m = i * j

List1.AddItem (m)

End Sub

23)Write a VB Program for Dental Payment Form. Calculate total on selected options from
check boxes.

            Private Sub cmdcalculate_Click()

            Dim sum As Integer

            If Check1.Value = 1 Then

                        sum = sum + 35

            End If

            If Check2.Value = 1 Then

                        sum = sum + 150

            End If

            If Check3.Value = 1 Then

                        sum = sum + 800

            End If

            If Check5.Value = 1 Then

                        sum = sum + 50

            End If

            If Check6.Value = 1 Then

                        sum = sum + 85

            End If

            If Check4.Value = 1 Then

                        sum = sum + Val(Text1.Text)

            End If



lblans.Caption = sum

End Sub

24)Design an application that contains one Label and two combo boxes, one combo box contains any
text and second combo box contains color names. Write a VB Program to set caption and background
color to the label control from respective combo boxes

Private Sub Combo1_Click()

Label1.Caption = Combo1.Text

End Sub

Private Sub Combo2_Click()

            If Combo2.Text = "Red" Then

                        Label1.BackColor = vbRed

            ElseIf Combo2.Text = "Green" Then

                        Label1.BackColor = vbGreen

            Else

                        Label1.BackColor = vbBlue

            End If

End Sub

25)Write a VB Program to place three text boxes onto the form at run time. Enter different strings in

first and second textbox. On clicking to command button, concatenation of two strings should be

displayed in the third text box.

Dim WithEvents text1 As TextBox

Dim WithEvents text2 As TextBox

Dim WithEvents text3 As TextBox

Dim WithEventscmd As CommandButton

Private Sub Form_Load()

Set cmd = Controls.Add("vb.CommandButton", "cmd")

cmd.Left = 600

cmd.Top = 1000

cmd.Caption = "Concat"

cmd.Visible = True

Set text1 = Controls.Add("vb.textbox", "text1")

text1.Left = 100

text1.Top = 100

text1.Visible = True

Set text2 = Controls.Add("vb.textbox", "text2")

text2.Left = 1500

text2.Top = 100

text2.Visible = True

Set text3 = Controls.Add("vb.textbox", "text3")

text3.Left = 3000

text3.Top = 100

text3.Visible = True

End Sub

Private Sub cmd_click()

text3.Text = text1.Text + text2.Text

End Sub

Header Ads Widget

Visual Basic 6.0 Program

Post a Comment

1 Comments

Popular Posts