Visual Programming

Program 1: DATA BASE Option Explicit Private Sub cmd_add_Click() On Error GoTo Label1: Adodc1.Recordset.AddNew Label1: MsgBox " sorry row cannot be empty" End Sub Private Sub cmd_del_Click() If MsgBox("are u sure u want to delete the record", vbYesNo + vbExclamation, "WARNNING") = vbYes Then Adodc1.Recordset.Delete Adodc1.Recordset.MoveNext End If End Sub Private Sub cmd_load_Click() Adodc1.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\sarir\Desktop\BCA5th.mdb;Persist Security Info=False" Adodc1.RecordSource = "select * from bca" Set DataGrid1.DataSource = Adodc1 End Sub Private Sub Cmd_next_Click() If Not Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveNext End If End Sub Private Sub cmd_prev_Click() If Not Adodc1.Recordset.BOF Then Adodc1.Recordset.MovePrevious End If End Sub

Private Sub Command1_Click() End End Sub Private Sub Form_Load() Adodc1.Visible = False DataGrid1.Width = Form1.Width End Sub Private Sub Timer1_Timer() Label1.ForeColor = RGB(Rnd() * 256, Rnd() * 256, Rnd() * 256) End Sub 2nd program AVI FILE Option Explicit Private Sub Command1_Click() MMControl1.Command = "play" End Sub Private Sub Command2_Click() MMControl1.Command = "pause" End Sub Private Sub Command3_Click() MMControl1.Command = "close" End Sub Private Sub Command4_Click() MMControl1.Command = "open" End Sub Private Sub Dir1_Change() File1.Path = Dir1.Path End Sub Private Sub Drive1_Change() Drive1.Path = Drive1.Drive End Sub Private Sub File1_Click() If Right(File1.Path, 3) = "mp3" Then MMControl1.FileName = File1.Path + File1.FileName Else

MMControl1.FileName = File1.Path + "/" + File1.FileName End If End Sub Private Sub Form_Load() MMControl1.hWndDisplay = Picture1.hWnd End Sub Private Sub MMControl1_PlayClick(Cancel As Integer) MMControl1.PlayEnabled = True End Sub 3rd program DATABSE CONN Option Explicit Private Sub Adodc1_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean) If MsgBox("SORRY ", vbOKOnly + vbQuestion, "warnning") = vbYes Then Adodc1.Recordset.Close End If End Sub Private Sub Cmd_add_Click() Adodc1.Recordset.AddNew End Sub Private Sub Cmd_del_Click() If MsgBox("ARE U SURE U WANT TO DELETE THE RECORD", vbQuestion + vbYesNo, "delete record") = vbYes Then Adodc1.Recordset.CancelUpdate Adodc1.Recordset.Delete Adodc1.Recordset.MoveNext End If End Sub

Private Sub cmd_last_Click() Adodc1.Recordset.MoveLast End Sub Private Sub Cmd_load_Click() 'Adodc1.CommandType = adCmdTable 'Adodc1.RecordSource = adCmdUnknown DataGrid1.Visible = True Adodc1.RecordSource = "select * from std_EXAM" Set DataGrid1.DataSource = Adodc1 End Sub Private Sub Cmd_next_Click()

If Not Adodc1.Recordset.EOF Then Adodc1.Recordset.MoveNext End If End Sub Private Sub cmd_prev_Click() Adodc1.Recordset.MovePrevious End Sub Private Sub Cmd_quit_Click() Unload Me End Sub Private Sub Cmd_upd_Click() Adodc1.Recordset.UpdateBatch End Sub Private Sub Form_Load() End Sub 4th program ENCRYPTION Encryption Option Explicit Private Sub Command1_Click() Text2.Enabled = False Dim leng, intval, i As Long Dim str As String str = Text3.Text leng = Len(str) For i = 1 To leng intval = Asc(Mid(str, i, leng)) + 2 Mid(str, i, leng) = Chr(intval) Next Text1.Text = str End Sub Private Sub Command1_GotFocus() Command2.Enabled = False

End Sub Private Sub Command1_LostFocus() Command2.Enabled = True

End Sub Private Sub Command2_Click() Text1.Enabled = False Dim leng, intval, i As Long Dim str As String str = Text3.Text leng = Len(str) For i = 1 To leng intval = Asc(Mid(str, i, leng)) - 2 Mid(str, i, leng) = Chr(intval) Next Text2.Text = str End Sub Private Sub Command2_GotFocus() Command2.Enabled = True End Sub Private Sub Command2_LostFocus() Command1.Enabled = False End Sub Private Sub Command3_Click() Text1.Text = "" Text2.Text = "" Text3.Text = "" End Sub Private Sub Text3_Change() If Text3.Text = "" Then Command1.Enabled = True Command2.Enabled = True End If End Sub Private Sub Timer1_Timer() Label1.ForeColor = RGB(Rnd() * 256, Rnd() * 256, Rnd() * 256) End Sub Program 5th ‘ FONT Option Explicit Private Sub Combo1_Click() If Text1.Text = "" Then MsgBox "plz enter the text in text box", vbApplicationModal + vbDefaultButton1, "Alert" Else

CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth 'CommonDialog1.Action = 4 If Combo1.ListIndex = 0 Then If Text1.Font.Bold = True Then Text1.Font.Bold = False Else Text1.Font.Bold = CommonDialog1.FontBold End If ElseIf Combo1.ListIndex = 1 Then If Text1.Font.Italic = True Then Text1.Font.Bold = False Else Text1.Font.Italic = True End If ElseIf Combo1.ListIndex = 2 Then If Text1.Font.Strikethrough = True Then Text1.Font.Strikethrough = False Else Text1.Font.Strikethrough = True End If ElseIf Combo1.ListIndex = 3 Then If Text1.Font.Underline = True Then Text1.Font.Underline = False Else Text1.Font.Underline = True End If ElseIf Combo1.ListIndex = 4 Then CommonDialog1.Action = 3 Text1.ForeColor = CommonDialog1.Color End If End If

End Sub Private Sub Combo2_Click() If Text1.Text = "" Then MsgBox "PLZ enter the text in the text box" Else CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth CommonDialog1.Action = 4 Text1.Font = CommonDialog1.FontName End If End Sub Private Sub Combo3_Click() If Text1.Text = "" Then MsgBox "PLZ enter the text in the text box" Else

CommonDialog1.Flags = cdlCFEffects Or cdlCFBoth CommonDialog1.Action = 4 Text1.Font = CommonDialog1.FontSize End If End Sub Private Sub Command1_Click() Text1.Text = "" End Sub Program 6 FRACTIONAL Option Explicit Dim n, m, k, j As Double Private Sub Command1_Click() n = Val(Text1.Text) m = n \ 1 'this division for taking inetger part of quotien

If n > m Then n=n-m Else m=m-n End If If n > 0 And n < 1 Then MsgBox "WELCOME!!! UR INPUT IS CORRECT" Else MsgBox "SORRY PLZ ENTER CORRECT INPUT" End If

End Sub Private Sub Command3_Click() Text1.Text = "'" Me.Cls

End Sub Private Sub Form_Load()

End Sub Program 7 MOVING AN IAMGE Dim pos As Integer Private Sub Command1_Click() Image1.Left = 12000 If Command1.Caption = "start" Then Command1.Caption = "stop" Timer1.Enabled = True Else Command1.Caption = "start" Timer1.Enabled = False Exit Sub End If End Sub Private Sub Command2_Click() Image1.Left = 100 If Command2.Caption = "Right" Then Command2.Caption = "halt" 'Call Timer2_Timer Timer2.Enabled = True

Else Command2.Caption = "Right" Timer2.Enabled = False

End If

End Sub Private Sub Form_Load() Timer1.Interval = 20

Timer2.Enabled = False Timer1.Enabled = False Image1.Top = 3665 End Sub Private Sub Timer1_Timer() Image1.Left = Image1.Left - 30 If Image1.Left <= -760 Then Image1.Left = 12000 End If

End Sub Private Sub Timer2_Timer() If Image1.Left <= 12000 Then Image1.Left = Image1.Left + 20

Else Image1.Left = 100

End If

End Sub Program 8 LOGIN

Private Sub Command1_Click() If Text1.Text = "" Or Text2.Text = "" Then MsgBox "PLZ ENTER THE TEXT", vbMsgBoxSetForeground, "WARNING" ElseIf Text1.Text = "sarir" And Text2.Text = "123" Then MsgBox "u have logged sucessfully "

Else MsgBox "sorry!! enter the correct password", vbInformation, "WARNNING" End If End Sub Private Sub Command2_Click() If MsgBox(" u want to logout", vbYesNo + vbMsgBoxSetForeground, "logout") = vbYes Then End End If End Sub Private Sub Form_Load() Text1.Text = "enter the username:" Text2.Text = "enter the password:" End Sub Private Sub Text1_GotFocus() Text1.Text = "" Text2.Text = "" End Sub Program 9th WODR CONVERSION Option Explicit Private Sub Command1_Click() Text2.Text = "" Dim q, n, r, b As Integer n = Val(Text1.Text) If n = 1000 Then Text2.Text = "one thousand" ElseIf Text1.Text = "" Or Val(Text1.Text) > 1000 Or Val(Text1.Text) = 0 Then MsgBox "plz enter a number from 1 to 10000", vbOKOnly, "warnning" Text1.Text = "" Command1.Enabled = False End If If Val(Text1.Text) >= 100 Then q = n / 100 r = n Mod 100 If q >= 1 And q < 2 Then Text2.Text = "one Hundred" ElseIf q >= 2 And q < 3 Then Text2.Text = "Two Hundred" ElseIf q >= 3 And q < 4 Then Text2.Text = "Three hundred" ElseIf q >= 4 And q < 5 Then Text2.Text = "Four Hundred'" ElseIf q >= 5 And q < 6 Then Text2.Text = "Five Hundred"

ElseIf q >= 6 And q < 7 Then Text2.Text = "Six Hundred" ElseIf q >= 7 And q < 8 Then Text2.Text = "Seven Hundred" ElseIf q >= 8 And q < 9 Then Text2.Text = "Eight hundred" ElseIf q >= 9 And q < 10 Then Text2.Text = "Nine Hundred" End If n=r End If If n < 100 And n >= 10 Then q = n \ 10 r = n Mod 10 b=q If q = 0 Or q < 1 Then Text2.Text = Text2.Text + "" ElseIf q >= 2 And q < 3 Then Text2.Text = Text2.Text + "Twenty" ElseIf q >= 3 And q < 4 Then Text2.Text = Text2.Text + "Thirty" ElseIf q >= 4 And q < 5 Then Text2.Text = Text2.Text + "Fourty" ElseIf q >= 5 And q < 6 Then Text2.Text = Text2.Text + "Fifty" ElseIf q >= 6 And q < 7 Then Text2.Text = Text2.Text + "Sixty" ElseIf q >= 7 And q < 8 Then Text2.Text = Text2.Text + "Seventy" ElseIf q >= 8 And q < 9 Then Text2.Text = Text2.Text + "Eighty" ElseIf q >= 9 And q < 10 Then Text2.Text = Text2.Text + "Ninety" End If n=r End If If n < 10 Then q=n If b = 0 And q = 0 Then Text2.Text = Text2.Text + "" ElseIf b = 1 And q = 0 Then Text2.Text = Text2.Text + "Ten" ElseIf b = 1 And q = 1 Then Text2.Text = Text2.Text + "Eleven" ElseIf b = 1 And q = 2 Then Text2.Text = Text2.Text + "twelve" ElseIf b = 1 And q = 3 Then Text2.Text = Text2.Text + "Thirteen" ElseIf b = 1 And q = 4 Then Text2.Text = Text2.Text + "Fourteen" ElseIf b = 1 And q = 5 Then Text2.Text = Text2.Text + "Fifteen" ElseIf b = 1 And q = 6 Then

Text2.Text = Text2.Text + "Sixteen" ElseIf b = 1 And q = 7 Then Text2.Text = Text2.Text + "seventeen" ElseIf b = 1 And q = 8 Then Text2.Text = Text2.Text + "Eighteen" ElseIf b = 1 And q = 9 Then Text2.Text = Text2.Text + "Nineteen" ElseIf q = 0 And q < 1 Then Text2.Text = Text2.Text + "" ElseIf q = 1 Then Text2.Text = Text2.Text + "ONE" ElseIf q = 2 Then Text2.Text = Text2.Text + "TWo" ElseIf q = 3 Then Text2.Text = Text2.Text + "Three" ElseIf q = 4 Then Text2.Text = Text2.Text + "Four" ElseIf q = 5 Then Text2.Text = Text2.Text + "Five" ElseIf q = 6 Then Text2.Text = Text2.Text + "Six" ElseIf q = 7 Then Text2.Text = Text2.Text + "Seven" ElseIf q = 8 Then Text2.Text = Text2.Text + "Eight" ElseIf q = 9 Then Text2.Text = Text2.Text + "Nine" End If End If Command1.Enabled = False End Sub Private Sub Command2_Click() Unload Me End Sub Private Sub Command3_Click() Text1.Text = "" Text2.Text = "" Command1.Enabled = False Text2.SetFocus End Sub Private Sub Form_Load() Command1.Enabled = False End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer) If (KeyAscii >= 23 And KeyAscii <= 47) Or _ (KeyAscii >= 91 And KeyAscii <= 96) Or _ (KeyAscii >= 97 And KeyAscii <= 122) Or _ (KeyAscii >= 123 And KeyAscii <= 126) Or _ (KeyAscii >= 58 And KeyAscii <= 64) Then KeyAscii = 0 Else Command1.Enabled = True End If

End Sub Program 9 Option Explicit Private Sub Command1_Click() avi FILE CONTAING audio MMControl1.Command = "play" End Sub Private Sub Command2_Click() CommonDialog1.ShowOpen MMControl1.FileName = CommonDialog1.FileName MMControl1.Command = "open" End Sub Private Sub Command3_Click() MMControl1.Command = "close" End Sub Private Sub Command4_Click() MMControl1.Command = "pause" End Sub Private Sub Form_Load() MMControl1.hWndDisplay = Picture1.hWnd End Sub Private Sub MMControl1_StatusUpdate() Label1.Caption = MMControl1.Position End Sub Program 10 color throughout the window Option Explicit Dim i As Long

Private Sub Command1_Click() Timer1.Enabled = True End Sub Private Sub Command2_Click() Timer1.Enabled = False End Sub Private Sub Form_Load() Label1.Visible = False Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Print , ; Label1.Caption; , Label1.Caption; , Label1.Caption Form1.ForeColor = RGB(Rnd() * 256, Rnd() * 256, Rnd() * 256) i=i+1 If i > 30 Then Form1.Cls Timer1.Enabled = False Timer1.Enabled = True i=0 End If End Sub Program 11 topmost

Option Explicit Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal ByVal cy As Long, ByVal wFlags As Long) As Long 'Public Declare Function SetWindowPos Lib "user32" (ByVal hwnd As hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal ByVal cy As Long, ByVal wFlags As Long) As Long

Long, ByVal cx As Long, Long, ByVal cx As Long,

Const HWND_TOPMOST = -1 Const SWP_SHOWWINDOW = &H40 Const SWP_DRAWFRAME = &H20

Private Sub Form_Load() Dim intval As Long intval = SetWindowPos(Me.hwnd, HWND_TOPMOST, 200, 200, 200, 200, SWP_SHOWWINDOW Or SWP_DRAWFRAME)

End Sub Program 13 random back color of form and random forecolor of label Option Explicit Private Sub Command1_Click() Timer1.Enabled = True End Sub Private Sub Command2_Click() Timer1.Enabled = False End Sub Private Sub Form_Load() Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Label1.ForeColor = RGB(Rnd() * 256, Rnd() * 256, Rnd() * 256) Form1.BackColor = RGB(Rnd() * 256, Rnd() * 256, Rnd() * 256) End Sub

Project 19 “label box movement Option Explicit Private Sub Command1_Click() Label1.Left = 15000 Timer1.Enabled = True End Sub Private Sub Command2_Click() Timer1.Enabled = False End Sub Private Sub Form_Load() Timer1.Enabled = False End Sub Private Sub Timer1_Timer() Label1.Left = Label1.Left - 200 If Label1.Left < -600 Then

Label1.Left = 15000 End If End Sub