Wednesday, 18 September 2013

GUI Program to demonstrate String Function

Private Sub Command1_Click()
Dim s As String
s = Text1.Text
Text2.Text = UCase(s)
Text3.Text = LCase(s)
Text4.Text = Len(s)
Text5.Text = StrReverse(s)
Text6.Text = Left(s, 5)
Text7.Text = Right(s, 5)
Text8.Text = Mid(s, 6, 5)
Text9.Text = String(10, "a")
Text10.Text = Replace(s, " ", "$$$$$")
End Sub

GUI Program to demonstrate Param array

Private Sub Command1_Click()
Dim a() As Integer
Call parray(100, 200, 300, 400, 100)
End Sub
Private Sub parray(ParamArray a())
Dim i As Integer
Dim sum As Integer
For i = 0 To UBound(a())
sum = sum + a(i)
Next i
Label1.Caption = "THe sum of array no's" & sum
End Sub

Private Sub Command2_Click()
Label1.Caption = " "
End Sub

Private Sub Command3_Click()
End
End Sub

GUI Program to demonstrate Dynamic array

Private Sub Command1_Click()
Dim a() As Integer
Dim i, n As Integer
Dim sum As Integer
sum = 0
n = InputBox("Enter the size of array")
Print "The size of array is" & n
ReDim a(n) As Integer
Print "The contents of array are"
For i = 1 To n
a(i) = InputBox("Enter array elements")
Print a(i)
sum = sum + a(i)
Next i
Print "The sum of array elements is" & sum
End Sub

Private Sub Command2_Click()
End
End Sub

GUI Program to demonstrate Scroll Control

Private Sub Form_Load()
Print "font size demo"
End Sub

Private Sub HScroll1_Change()
Form1.BackColor = vbYello
End Sub

Private Sub HScroll2_Change()
Form1.FontSize = "20"
Print "Font size demo"
Form1.FontSize = "30"
Print "font size demo"
End Sub

GUI Program to demonstrate Function array

Private Sub Command1_Click()
Dim v As Variant, x As Integer
v = Array(7, 5, 6, 9, 3, 0)
Print "Variant array value are:"
For x = LBound(v) To UBound(v)
Print v(x)
Next x
Print
v = Array("hello", "hai", "bye")
Print "Variant array value are:"
For x = LBound(v) To UBound(v)
Print v(x)
Next x
Print
v = Array("1.1", "2.2", "3.3", "4.4")
Print "Variant array value are:"
For x = LBound(v) To UBound(v)
Print v(x)
Next x
Print
End Sub

GUI Program to Validate User name and password

Private Sub Command1_Click()
If Text1.Text = "student" And Text2.Text = "dept123" Then
MsgBox "valid username and password", , "login"
Me.Hide
Else
MsgBox "invalid password,try again!", , "login"
End If
End Sub

Private Sub Command2_Click()
Me.Hide
End Sub

GUI Program to Demonstrate Timer control

Public mintcount As Integer
Private Sub Command1_Click()
Timer1.Enabled = True
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
mintcount = mintcount + 1
Label1.Caption = "timer count is:" & mintcount
End Sub

GUI Program to Demonstrate Nested on Error

Private Sub Command1_Click()
Dim num As Single
Dim den As Single
On Error GoTo inputhandler
num = Text1.Text
den = Text2.Text
On Error GoTo dividebyzerohandler
Label3.Caption = "Result is:" & num / den
Exit Sub
dividebyzerohandler:
Label3.Caption = "attempted to divide by zero"
Exit Sub
inputhandler:
Label3.Caption = "attempted to input non-numeric data"
End Sub

Private Sub Command2_Click()
Text1.Text = " "
Text2.Text = " "
Label3.Caption = " "
End Sub

GUI Program to Demonstrate Filter Function

Private Sub Command1_Click()
Dim a(9) As String
Dim s() As String
Dim i As Integer
For i = 0 To List1.ListCount - 1
a(i) = List1.List(i)
Next i
s = Filter(a, "visual basic 6", True)
For i = 0 To UBound(s)
List2.AddItem (s(i))
Next i
s = Filter(a, "visual basic 6", False)
For i = 0 To UBound(s)
List3.AddItem (s(i))
Next i
End Sub

Private Sub Command2_Click()
End
End Sub

Private Sub form_load()
List1.AddItem ("java")
List1.AddItem ("visual basic 6")
List1.AddItem ("visual basic 5")
List1.AddItem ("c++")
List1.AddItem ("visual basic 6")
List1.AddItem ("visual basic 5")
List1.AddItem ("visual c++")
List1.AddItem ("visual basic 6")
End Sub

GUI Program to Demonstrate Split Function

Private Sub Command1_Click()
Dim s1 As String
Dim a() As String
Dim i As Integer
s1 = Text1.Text
Label2.Caption = " "
a = Split(s1)
For i = LBound(a) To UBound(a)
Label2.Caption = Label2.Caption & a(i) & vbCrLf
Next i
End Sub

Private Sub Command2_Click()
End
End Sub

GUI Program to Demonstrate Date difference and Date Add

Private Sub Command1_Click()
List1.AddItem ("now:" & Now)
List1.AddItem ("now+3years:" & DateAdd("yyyy", 3, Now))
List1.AddItem ("dys b/w now and 12/31/13" & DateDiff("d", Now, "12/31/13"))
List1.AddItem ("days b/w 1/1/13 and now" & DateDiff("d", "1/1/13", Now))
List1.AddItem ("days b/w 1/1/13 and 12/31/13:" & DateDiff("d", "1/1/13", "12/31/13"))
End Sub

Private Sub Command2_Click()
End
End Sub

GUI Program to Demonstrate ComboBox

Private Sub Command1_Click()
Dim item As String
item = InputBox("Enter the name of cars")
Combo1.AddItem (item)
Label1.Caption = "Number of cars:" & Combo1.ListCount
End Sub

Private Sub Command2_Click()
If Combo1.ListCount <> 0 And Combo1.ListIndex <> -1 Then
Combo1.RemoveItem (Combo1.ListIndex)
Label1.Caption = "Number of cars:" & Combo1.ListCount
Else
MsgBox "invalid"
End If
End Sub

Private Sub Command3_Click()
Combo1.Clear
Label1.Caption = "Number of cars:" & Combo1.ListCount
End Sub

Private Sub Command4_Click()
End
End Sub

GUI Program to demonstrate Linear search

Private Sub Command1_Click()
Dim item As String
item = InputBox("Enter the elements")
List1.AddItem (item)
End Sub

Private Sub Command2_Click()
List1.Clear
Text1.Text = " "
End Sub

Private Sub Command3_Click()
Dim key As String
Dim flag As String
Dim i As Integer
key = Text1.Text
flag = False
For i = 0 To List1.ListCount - 1
If key = List1.List(i) Then
flag = True
Exit For
End If
Next i
If flag = True Then
MsgBox "SUCCESSFULL SEARCH"
Else
MsgBox "UNSUCCESSFULL SEARCH"
End If
End Sub

Private Sub Command4_Click()
End
End Sub

GUI Program to Demonstrate Control Array

Private Sub Command10_Click()
Text1.Text = " "
Text2.Text = " "
End Sub

Private Sub Command11_Click()
Text1.Text = Text1.Text & Index
End Sub

Private Sub Command12_Click()
Dim code As Long
code = Text1.Text
Select Case code
    Case 0 To 100
    Text2.Text = "Access Denied"
    Beep
    
    Case 1645 To 1989
    Text2.Text = Now & "Technicians"
    
    Case 8345
    Text2.Text = Now & "custodians"
    
    Case 55875
    Text2.Text = Now & "Special Services"
    
    Case 999898
    Text2.Text = Now & "Chief Scientists"
    
    Case 1000007 To 1000008
    Text2.Text = Now & "Scientists"
    
    Case Else
    Text2.Text = Now & "Access Denied"
    End Select
End Sub

GUI Program to demonstrate Function Procedure

Private Sub Command1_Click()
Dim radius As Single
Dim area As Single
radius = Val(Text1.Text)
area = findarea(radius)
Text2.Text = Str(area)
End Sub
Private Function findarea(r As Single) As Single
Dim a As Single
a = 3.142 * r * r
findarea = a
End Function

Private Sub Command2_Click()
End
End Sub

GUI program to find minimum of 3 numbers

Private Sub Command1_Click()
Dim num1 As Integer
Dim num2 As Integer
Dim num3 As Integer
num1 = Val(Text1.Text)
num2 = Val(Text2.Text)
num3 = Val(Text3.Text)
Call minimum(num1, num2, num3)
End Sub
Private Sub minimum(n1 As Integer, n2 As Integer, n3 As Integer)
Dim min As Integer
min = n1
If n2 < min Then
min = n2
End If
If n3 < min Then
min = n3
End If
Text4.Text = Str(min)
End Sub

Private Sub Command2_Click()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
End Sub

Private Sub Command3_Click()
End
End Sub

GUI Program to Process arbitrary number of grades

Private Sub cmdenter_Click()
Dim grade,total,count As Integer
Dim average As Single

total=0
grade=0
average=0

grade=InputBox("Enter the grades (-1 to end)")

Do While grade<>-1
count=count+1
total=total+grade
grade=InputBox("Enter the grades(-1 to end)")
Loop

If count<>0 Then
average=total/count
Else
average=0
End If

Text1.Text=Str(average)
End Sub

Private Sub cmdexit_Click()
End
End Sub

GUI Program to Compare two integer Numbers

Private Sub cmdenter_Click()
Dim n1,n2 As Integer

n1=InputBox("Enter the first number","first")
n2=InputBox("Enter the first number","second")

If n1=n2 Then
Label1.Caption=n1 & "is equal to" & n2
Else
If n1>n2 Then
Label1.Caption=n1 & "is not equal to" & n2 & vbCrlf & n1 & "is greater than" & n2
Else
Label1.Caption=n1 & "is not equal to" & n2 & vbCrlf & n1 & "is lesser than" & n2 
End If
End If
End Sub

Private Sub cmdexit_Click()
End
End Sub