Visual Basic Programs For Mca

Program No. : - 1 Name: - Gaurav Saxena Class: - MCA (3rd Sem.) Statement: - Write a program to design a calculator using Control Array.

Roll No. : - 1308727 Page No. :-_______

Dim Operand1, Operand2 As Double Dim Operator As String Dim ClearDisplay As Boolean Private Sub ClearBttn_Click() Display.Caption = "" End Sub Private Sub Digits_Click(Index As Integer) If ClearDisplay Then Display.Caption = "" ClearDisplay = False End If Display.Caption = Display.Caption + Digits(Index).Caption End Sub Private Sub Div_Click() Operand1 = Val(Display.Caption) Operator = "/" Display.Caption = "" End Sub Private Sub DotBttn_Click() If ClearDisplay Then Display.Caption = "" ClearDisplay = False End If If InStr(Display.Caption, ".") Then Exit Sub Else Display.Caption = Display.Caption + "." End If End Sub Private Sub Minus_Click() Operand1 = Val(Display.Caption) Operator = "-" Display.Caption = "" End Sub Private Sub Over_Click() If Val(Display.Caption) <> 0 Then Display.Caption = 1 / Val(Display.Caption) End Sub Private Sub Plus_Click() Operand1 = Val(Display.Caption)

Operator = "+" Display.Caption = "" End Sub Private Sub PlusMinus_Click() Display.Caption = -Val(Display.Caption) End Sub Private Sub Times_Click() Operand1 = Val(Display.Caption) Operator = "*" Display.Caption = "" End Sub INPUT AND OUTPUT:-

Program No. : - 2 Name: - Gaurav Saxena Roll No. : - 1308727 rd Class: - MCA (3 Sem.) Page No. :-_______ Statement: - Write a Program to design an interface using option buttons & frame control for Currency Conversion System. Private Sub Command1_Click() Dim a As Single, b As Single a = CSng(Text1.Text) If (Option1.Value = True) Then If (Option5.Value = True) Then a=a Text2.Text = a Else If (Option6.Value = True) Then b = a / 46 Text2.Text = b Else If (Option7.Value = True) Then b = a / 55 Text2.Text = b Else If (Option8.Value = True) Then b = a / 70 Text2.Text = b End If End If End If End If End If If (Option2.Value = True And Option5.Value = True) Then b = a * 46 Text2.Text = b End If If (Option2.Value = True And Option6.Value = True) Then b=a Text2.Text = b End If If (Option2.Value = True And Option7.Value = True) Then b = a * 1.19 Text2.Text = b End If If (Option2.Value = True And Option8.Value = True) Then b = a * 1.34 Text2.Text = b End If

If (Option3.Value = True And Option5.Value = True) Then b = a * 55 Text2.Text = b End If If (Option3.Value = True And Option6.Value = True) Then b = a / 1.19 Text2.Text = b End If If (Option3.Value = True And Option7.Value = True) Then b=a Text2.Text = b End If If (Option3.Value = True And Option8.Value = True) Then b = a / 1.21 Text2.Text = b End If If (Option4.Value = True And Option5.Value = True) Then b = a * 70 Text2.Text = b End If If (Option4.Value = True And Option6.Value = True) Then b = a * 1.32 Text2.Text = b End If If (Option4.Value = True And Option7.Value = True) Then b = a * 1.21 Text2.Text = b End If If (Option4.Value = True And Option8.Value = True) Then b=a Text2.Text = b End If End Sub Private Sub Command2_Click() Text1.Text = " " Text2.Text = " " End Sub Private Sub Command3_Click() End End Sub

Output:-

Program No. : - 3 Name: - PANKAJ Roll No. : - 1308755 rd Class: - MCA (3 Sem.) Page No. :-_______ Statement: - Write a Program to design an interface having two list box and perform the following operations on the box:1. Shift item from one list to another. 2. Shift all items from one list to another. 3. Copy any selected item to another list box. 4. Copy all items to another list box. 5. Drag items from one list box to another. Private Sub Form_Load() Combo1.AddItem "Pascal" Combo1.AddItem "Fortran" Combo1.AddItem "Basic" Combo1.AddItem "C" Combo1.AddItem "C++" Combo1.AddItem "Visual Basic" Combo1.AddItem "Visual C++" Combo1.AddItem "Java" Combo1.Text = "Front End Tools" Combo2.AddItem "MS-Access" Combo2.AddItem "Oracle" Combo2.AddItem "SQL Server" Combo2.AddItem "Sybase" Combo2.AddItem "Ingres" Combo2.AddItem "Unify" Combo2.AddItem "IBM DB2" Combo2.AddItem "MY SQL" Combo2.Text = "Back End Tools" End Sub Private Sub Combo1_Click() List1.AddItem Combo1.List(Combo1.ListIndex) End Sub Private Sub Combo2_Click() List1.AddItem Combo2.List(Combo2.ListIndex) End Sub Private Sub Command1_Click() If List1.ListCount = 0 Then MsgBox "List Box 1 is Empty" Exit Sub End If

If List1.ListIndex < 0 Then MsgBox "Please Select Any Item from List1" Else List2.AddItem List1.List(List1.ListIndex) List1.RemoveItem List1.ListIndex End If End Sub Private Sub Command2_Click() If List1.ListCount = 0 Then MsgBox "List Box 1 is Empty" Exit Sub End If While List1.ListCount <> 0 List2.AddItem List1.List(List1.Selected(0)) List1.RemoveItem List1.Selected(0) Wend End Sub Private Sub Command3_Click() If List2.ListCount = 0 Then MsgBox "List Box 2 is Empty" Exit Sub End If If List2.ListIndex < 0 Then MsgBox "Please Select Any Item from List2" Else List1.AddItem List2.List(List2.ListIndex) List2.RemoveItem List2.ListIndex End If End Sub Private Sub Command4_Click() If List2.ListCount = 0 Then MsgBox "List Box 2 is Empty" Exit Sub End If While List2.ListCount <> 0 List1.AddItem List2.List(List2.Selected(0)) List2.RemoveItem List2.Selected(0) Wend End Sub

Output

Program No. : -11 Name: - Gaurav Saxena Roll No. : - 1308727 Output:rd Class: - MCA (3 Sem.) Page No. :-_______ Statement: - Design an application which display following information of a student(using oracle) like stud_rollno, stud_regno, stud_name, stud_address, stud_contactno, stud_class, marks in 5 different subjects, total and percentage. Also perform following operations using ADODB: a) Insert a new record. b) Delete a record. c) Modify/update a record. d) Search a record. Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Dim rs1 As ADODB.Recordset Private Sub cmdadd_Click() txtroll.Text = " " txtname.Text = " " txtmarks.Text = " " txtroll.SetFocus End Sub Sub display() txtroll.Text = rs.Fields(0) txtname.Text = rs.Fields(1) txtmarks.Text = rs.Fields(2) End Sub Private Sub cmddelete_Click() Dim sql As String Dim s As Integer s = InputBox("enter the roll no to be deleted") sql = "delete from student719 where rollno=" & CInt(s) cn.Execute (sql) MsgBox "1 record deleted" Call recordset_refresh End Sub Private Sub cmdexit_Click() End End Sub Private Sub cmdfirst_Click() rs.MoveFirst Call display End Sub

Private Sub cmdlast_Click() rs.MoveLast Call display End Sub Private Sub cmdmodify_Click() Dim i As Integer i = InputBox("enter the roll no to be deleted") rs.MoveFirst While rs.EOF If rs.Fields(0) = i Then modify1 Exit Sub End If rs.MoveNext Wend End Sub Private Sub cmdnext_Click() rs.MoveNext If rs.EOF Then rs.MovePrevious End If Call display End Sub Private Sub cmdprev_Click() rs.MovePrevious If rs.BOF Then rs.MoveFirst Call display End Sub Private Sub cmdsave_Click() Dim sql As String sql = "insert into student719 values(" & CInt(txtroll.Text) & ",'" & txtname.Text & "'," & CSng(txtmarks.Text) & ")" cn.Execute (sql) MsgBox "1 record created" Call recordset_refresh txtroll.Text = " " txtname.Text = " " txtmarks.Text = " " txtroll.SetFocus End Sub

Private Sub Form_Load() Set cn = New ADODB.Connection cn.ConnectionString = "provider=msdaora.1;password=tiger;user id=scott;data source=oracle" cn.Open Call recordset_refresh MsgBox "connection created" End Sub Sub recordset_refresh() Set rs = New ADODB.Recordset rs.Open "select * from student719", cn, adOpenKeyset, adLockOptimistic End Sub Sub modify1() txtroll.Text = rs.Fields(0) txtname.Text = rs.Fields(1) txtmarks.Text = rs.Fields(2) End Sub

Output:-

Program No. : - 10 Name: - Gaurav Saxena Roll No. : - 1308727 rd Class: - MCA (3 Sem.) Page No. :-_______ Statement: - : Use DAO(Data Access Object) to connect the applications with database(in MS ACCESS) named ‘employee’ having table ‘emp_info’ with fields emp_id, emp_name, basic_salary, house rent allowance, provident fund, dearance allowance, net_salary,tax. Also performs operations as given below: a) Insert a new record. b) Delete a record. c) Modify/update a record. d) Move on first, next, previous and last record. Private Sub Command1_Click() Text11.Text = (Val(Text7.Text) + Val(Text8.Text) / 100 + Val(Text8.Text) / 100) Val(Text10.Text) Text12.Text = Val(Text10.Text) * 20 / 100 End Sub Private Sub Command2_Click() Data1.Recordset.MoveFirst Text8.Text = "" Text9.Text = "" Text10.Text = "" Text11.Text = "" Text12.Text = "" End Sub Private Sub Command3_Click() Data1.Recordset.MovePrevious If Data1.Recordset.BOF = True Then Data1.Recordset.MoveLast End If Text8.Text = "" Text9.Text = "" Text10.Text = "" Text11.Text = "" Text12.Text = "" End Sub Private Sub Command4_Click() Data1.Recordset.MoveNext If Data1.Recordset.EOF = True Then Data1.Recordset.MoveFirst

End If Text8.Text = "" Text9.Text = "" Text10.Text = "" Text11.Text = "" Text12.Text = "" End Sub Private Sub Command5_Click() Data1.Recordset.MoveLast Text8.Text = "" Text9.Text = "" Text10.Text = "" Text11.Text = "" Text12.Text = "" End Sub Private Sub Command6_Click() Data1.Recordset.AddNew Text8.Text = "" Text9.Text = "" Text10.Text = "" Text11.Text = "" Text12.Text = "" End Sub Private Sub Command7_Click() Data1.Recordset.Update MsgBox ("Record Successfully Update") End Sub Private Sub Command8_Click() Data1.Recordset.Delete MsgBox ("Record Successfully Deleted") End Sub Private Sub Command9_Click() End End Sub Private Sub Command10_Click() End End Sub

Output:-

Program No. : - 12 Name: - Gaurav Saxena Roll No. : - 1308727 rd Class: - MCA (3 Sem.) Page No. :-_______ Statement: - Write a program to create book database and prepare report using Microsoft flex grid control. Dim con As ADODB.Connection Dim rs As ADODB.Recordset Private Sub Form_Load() Set cn = New ADODB.Connection Set rs = New ADODB.Recordset cn.ConnectionString = "provider=microsoft.jet.oledb.4.0;Data Source=d:\book.mdb" cn.Open rs.Open "Select * from book1", cn, adOpenStatic, adLockOptimistic r=1 MSFlexGrid1.TextMatrix(0, 1) = "Book Code" MSFlexGrid1.TextMatrix(0, 2) = "Book Name" MSFlexGrid1.TextMatrix(0, 3) = "publisher" MSFlexGrid1.TextMatrix(0, 4) = "Price" MSFlexGrid1.TextMatrix(0, 5) = "Subject" MSFlexGrid1.TextMatrix(0, 6) = "Edition" While Not rs.EOF For f = 0 To 5 MSFlexGrid1.TextMatrix(r, f + 1) = rs.Fields(f) Next rs.MoveNext r=r+1 Wend End Sub

OUTPUT:

Form1

Program No. : - 4 Name: - Gaurav Saxena Roll No. : - 1308727 rd Class: - MCA (3 Sem.) Page No. :-_______ Statement: - Design a notepad applications using common dialog control with complete menus coding.

Private Sub Command1_Click() CommonDialog1.Filter = "Text files(*.txt)|*.txt" CommonDialog1.ShowOpen RichTextBox1.FileName = CommonDialog1.FileName RichTextBox1.SetFocus Exit Sub End Sub Private Sub Command2_Click() test = MsgBox("You Really Want To Save File ?", _ vbYesNo + vbQuestion, "Acknowledgement") If test = vbYes Then CommonDialog1.DefaultExt = "txt" 'CommonDialog1.Filter = "Text files(*.txt)|*.txt" CommonDialog1.ShowSave RichTextBox1.SaveFile (CommonDialog1.FileName) End If RichTextBox1.SetFocus End Sub Private Sub Command3_Click() CommonDialog1.Flags = cdlCFBoth + cdlCFEffects CommonDialog1.ShowFont RichTextBox1.SelFontName = CommonDialog1.FontName RichTextBox1.SelFontSize = CommonDialog1.FontSize RichTextBox1.SelBold = CommonDialog1.FontBold RichTextBox1.SelItalic = CommonDialog1.FontItalic RichTextBox1.SetFocus End Sub Private Sub Command4_Click() CommonDialog1.ShowColor RichTextBox1.SelColor = CommonDialog1.Color RichTextBox1.SetFocus End Sub Private Sub Command5_Click() Unload Me End Sub Private Sub Copy_Click()

Clipboard.SetText Common_Dialog.RichTextBox1.SelText Paste.Enabled = True End Sub Private Sub Cut_Click() Clipboard.SetText Common_Dialog.RichTextBox1.SelText Common_Dialog.RichTextBox1.SelText = "" Paste.Enabled = True End Sub Private Sub Exit_Click() End End Sub Private Sub Fomt_Click() CommonDialog1.Flags = cdlCFBoth + cdlCFEffects CommonDialog1.ShowFont RichTextBox1.SelFontName = CommonDialog1.FontName RichTextBox1.SelFontSize = CommonDialog1.FontSize RichTextBox1.SelBold = CommonDialog1.FontBold RichTextBox1.SelItalic = CommonDialog1.FontItalic RichTextBox1.SetFocus End Sub Private Sub Open_Click() CommonDialog1.Filter = "Text files(*.txt)|*.txt" CommonDialog1.ShowOpen RichTextBox1.FileName = CommonDialog1.FileName RichTextBox1.SetFocus Exit Sub End Sub Private Sub Paste_Click() Common_Dialog.RichTextBox1 = Clipboard.GetText End Sub Private Sub Save_Click() test = MsgBox("You Really Want To Save File ?", _ vbYesNo + vbQuestion, "Acknowledgement") If test = vbYes Then CommonDialog1.DefaultExt = "txt" CommonDialog1.Filter = "Text files(*.txt)|*.txt" CommonDialog1.ShowSave RichTextBox1.SaveFile (CommonDialog1.FileName) End If RichTextBox1.SetFocus

End Sub Private Sub Saveas_Click() CommonDialog1.ShowSave End Sub

Output

Program No. : - 5 Name: - Gaurav Saxena Roll No. : - 1308727 rd Class: - MCA (3 Sem.) Page No. :-_______ Statement: - Write a program to demonstrate dynamic menus appearance (i.e. add and remove the menus at runtime).

Dim rtitems As Variant Private Sub Command1_Click() rtitems = rtitems + 1 Load Gaurav(rtitems) Gaurav(rtitems).Caption = "dynamic menu item#" & Str(rtitems) End Sub Private Sub Command2_Click() If rtitems = 0 Then MsgBox "menu is already empty" Else Unload Gaurav(rtitems) rtitems = rtitems - 1 End If End Sub Private Sub fillmenu() Dim i As Integer Call emptymenu For i = 1 To 3 Load mnufileslist(i) mnufileslist(i).Caption = "file" & i Next i mnufileslist(0).Visible = False End Sub Private Sub emptymenu() Dim i As Integer mnufileslist(0).Visible = True For i = 1 To mnufileslist.UBound Unload mnufileslist(i) Next i End Sub Private Sub exit1_Click() Unload Me End Sub

Output:-

Program No. : - 9 Name: - Gaurav Saxena Roll No. : - 1308727 rd Class: - MCA (3 Sem.) Page No. :-_______ Statement: - Write a program to display date and time in a panel of status bar alternatively with an interval of 5 seconds using timer control. Dim a As Integer Private Sub Form_Load() Timer2.Enabled = False a=0 End Sub Private Sub Timer1_Timer() If a <= 5 Then sb1.Panels(1) = Time() a=a+1 Else sb1.Panels(1) = "" Timer1.Enabled = False a=0 Timer2.Enabled = True End If End Sub Private Sub Timer2_Timer() If a <= 5 Then sb1.Panels(2) = Date a=a+1 Else sb1.Panels(2) = "" Timer1.Enabled = True a=0 Timer2.Enabled = False End If End Sub

Output:-

Program No. : - 6 Name: - Gaurav Saxena Class: - MCA (3rd Sem.) Statement: - Write a program to convert a number into its text form. Dim a As Double, l As Integer, m As Double Dim temp As String Private Sub once(x As Double) Select Case (x) Case 1: ch = "One " Case 2: ch = "Two " Case 3: ch = "Three " Case 4: ch = "Four " Case 5: ch = "Five " Case 6: ch = "Six " Case 7: ch = "Seven " Case 8: ch = "Eight " Case 9: ch = "Nine " Case 10: ch = "Ten " Case 11: ch = "Eleven " Case 12: ch = "Twelve " Case 13: ch = "Thirteen " Case 14: ch = "Fourteen " Case 15: ch = "Fifteen " Case 16: ch = "Sixteen " Case 17: ch = "Seventeen " Case 18: ch = "Eighteen " Case 19: ch = "Nineteen " End Select

Roll No. : - 1308727 Page No. :-_______

Text2.Text = Text2.Text & ch End Sub Private Sub tens(x As Double) Select Case (x) Case 2: ch = "Twenty " Case 3: ch = "Thirty " Case 4: ch = "Fourty " Case 5: ch = "Fifty " Case 6: ch = "Sixty " Case 7: ch = "Seventy " Case 8: ch = "Eighty " Case 9: ch = "Ninety " End Select Text2.Text = Text2.Text & ch End Sub Private Sub gets(mm As Double) If mm <= 19 Then Call once(mm) Else Call tens(Mid(mm, 1, 1)) Call once(Mid(mm, 2, 1)) End If End Sub Private Sub Command1_Click() a = Text1.Text Text1.Text = a l = Len(Text1.Text) If a > 10000000 Then MsgBox "Please Enter Upto 1 Crore" Text1.Text = Empty Text2.Text = Empty Exit Sub ElseIf a = 10000000 Then

Text2.Text = "1 Crore" Exit Sub End If abc: Select Case (l) Case 7: m = Left(a, 2) gets (m) message (6) a = Mid(a, 3, 5) temp = a l = Len(temp) GoTo abc Case 6: Call once(Left(a, 1)) message (6) a = Mid(a, 2, 5) temp = a l = Len(temp) GoTo abc Case 5: m = Left(a, 2) gets (m) message (4) a = Mid(a, 3, 3) temp = a l = Len(temp) GoTo abc Case 4: Call once(Left(a, 1)) message (4) a = Mid(a, 2, 3) temp = a l = Len(temp) GoTo abc Case 3: Call once(Left(a, 1)) Call message(3) m = Mid(a, 2, 2) gets (m)

Case 2: gets (a) Case 1: Call once(a) End Select End Sub Private Sub message(i As Integer) Select Case (i) Case 6: Text2.Text = Text2.Text & "Lakhs " Case 4: Text2.Text = Text2.Text & "Thousand " Case 3: Text2.Text = Text2.Text & "Hundred " End Select End Sub Private Sub Command2_Click() Text1.Text = Empty Text2.Text = Empty Text1.SetFocus End Sub

Output:-