LaB

Calculator:
Option Explicit
Dim operand1 As Double, operand2 As Double
Dim op1 As Double, op2 As Double
Dim operator As String
Dim cleardisplay As Boolean

Private Sub cmdclear_Click()
display.Caption = ""
End Sub

Private Sub cmddiv_Click()
op1 = Val(display.Caption)
operator = "/"
display.Caption = ""
End Sub

Private Sub cmddot_Click()
If InStr(display.Caption, ".") Then
Exit Sub
Else
display.Caption = display.Caption + "."
End If
End Sub

Private Sub cmdequal_Click()
Dim result As Double
op2 = Val(display.Caption)
If operator = "+" Then
result = add(ByVal op1, ByVal op2)
End If
If operator = "-" Then
result = subtract(ByVal op1, ByVal op2)
End If
If operator = "*" Then
result = mul(ByVal op1, ByVal op2)
End If
If operator = "/" Then
result = div(ByVal op1, ByVal op2)
End If
display.Caption = result
End Sub

Private Sub cmdminus_Click()
op1 = Val(display.Caption)
operator = "-"
display.Caption = ""
End Sub

Private Sub cmdmul_Click()
op1 = Val(display.Caption)
operator = "*"
display.Caption = ""
End Sub

Private Sub cmdplus_Click()
op1 = Val(display.Caption)
operator = "+"
display.Caption = ""
End Sub

Private Function add(ByVal operand1 As Double, ByVal operand2 As Double) As Double
add = operand1 + operand2
End Function

Private Sub digit_Click(Index As Integer)
If cleardisplay Then
display.Caption = ""
cleardisplay = False
End If
display.Caption = display.Caption + digit(Index).Caption
End Sub


Private Function subtract(ByVal operand1 As Double, ByVal operand2 As Double) As Double
subtract = operand1 - operand2
End Function

Private Function mul(ByVal operand1 As Double, ByVal operand2 As Double) As Double
mul = operand1 * operand2

End Function

Private Function div(ByVal operand1 As Double, ByVal operand2 As Double) As Double
div = operand1 / operand2

End Function


Alarm Clock:
Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub cmdset_Click()
Label2.Caption = Text1.Text
End Sub

Private Sub cmdstart_Click()
Timer1.Enabled = True
End Sub



Private Sub Text1_GotFocus()
Text1.Text = "00:00:00"
End Sub

Private Sub Timer1_Timer()
If Format(Time, "hh:mm:ss") = Label2.Caption Then
'beep
MsgBox ("good moring")
End If

End Sub

Private Sub Timer2_Timer()
Label1.Caption = Format(Time, "hh:mm:ss")
End Sub

Employee Details:
Private Sub cmdclear_Click()
Text1.Text = " "
Text2.Text = " "
Text3.Text = " "
Text4.Text = " "
Text5.Text = " "
Text6.Text = " "
Text7.Text = " "
Text8.Text = " "
Text9.Text = " "
Text1.SetFocus

End Sub

Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub cmdresult_Click()
Dim bp, da, hra, ded, gp, np As Integer
If Text1.Text = " " Or Text2.Text = " " Or Text3.Text = " " Or Text4.Text = " " Then
MsgBox "fieids cannot be left blank"
Text1.SetFocus
End If
bp = Val(Text4.Text)
Select Case bp
Case 0 To 2000
da = 2 / 100 * bp
hra = 3 / 100 * bp
ded = 50
Text5.Text = Val(da)
Text6.Text = Val(hra)
Text7.Text = Val(ded)
Case 2000 To 5000
da = 4 / 100 * bp
hra = 5 / 100 * bp
ded = 100
Text5.Text = Val(da)
Text6.Text = Val(hra)
Text7.Text = Val(ded)
Case 5001 To 10000
Text7.Text = Val(ded)
Case ls > 10000
da = 8 / 100 * bp
hra = 9 / 100 * bp
ded = 1500
Text5.Text = Val(da)
Text6.Text = Val(hra)
Text7.Text = Val(ded)
Case Else
MsgBox "enter the basic pay"
End Select
gp = bp + da + hra
Text8.Text = Val(gp)
np = gp - ded
Text9.Text = Val(np)
End Sub



Private Sub Text4_KeyPress(KeyAscii As Integer)
If (KeyAscii < 48 And KeyAscii > 46 And KeyAscii <> 8) Or (KeyAscii > 57) Then
KeyAscii = 0
MsgBox "enter numeric value"
Text4.SetFocus
End If
End Sub

Student Details:

Private Sub calculate_Click()
Dim a As Integer
    If (Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "") Then
        MsgBox "field should not be left blank"
        Exit Sub
    End If
        a = Val(Text3) + Val(Text4) + Val(Text5)
        Label10.Caption = a
        b = a / 3
        Label11.Caption = b
    If (b < 40) Then
        Label12.Caption = "FAIL"
    ElseIf (b < 60) Then
        Label12.Caption = "SECOND"
    ElseIf (b < 75) Then
        Label12.Caption = "FIRST"
    Else
        Label12.Caption = "DISTINCTION"
    End If
End Sub

Private Sub Clear_Click()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Label10.Caption = ""
Label11.Caption = ""
Label12.Caption = ""
Text1.SetFocus
End Sub


Private Sub exit_Click()
Unload Me
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Text1.Text <> "" Then
        Text2.SetFocus
    ElseIf (KeyAscii < 65 And KeyAscii <> 8 And KeyAscii <> 32) Or (KeyAscii > 90 And KeyAscii < 97) Or (KeyAscii > 122) Then
        KeyAscii = 0
        MsgBox "enter letter only"
    End If
End Sub


Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 And Text2.Text <> "" Then
        Text3.SetFocus
    ElseIf (KeyAscii < 65 And KeyAscii <> 8 And KeyAscii <> 32) Or (KeyAscii > 90 And KeyAscii < 97) Or (KeyAscii > 122) Then
        KeyAscii = 0
        MsgBox "enter letter only"
    End If
End Sub


Private Sub Text3_Change()
    If Val(Text3.Text) > 100 Then
        MsgBox "marks range from 0 to 100"
    Text3.Text = ""
    End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Text3.Text <> "" Then
        Text4.SetFocus
    ElseIf (KeyAscii < 48 And KeyAscii <> 8) Or KeyAscii > 57 Then
        KeyAscii = 0
        MsgBox "enter Digits only"
    End If
End Sub

Private Sub Text4_Change()
        If Val(Text4.Text) > 100 Then
            MsgBox "marks range from 0 to 100"
        Text4.Text = ""
        End If
End Sub

Private Sub Text4_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Text4.Text <> "" Then
        Text5.SetFocus
    ElseIf (KeyAscii < 48 And KeyAscii <> 8) Or KeyAscii > 57 Then
        KeyAscii = 0
        MsgBox "enter Digits only"
    End If
End Sub

Private Sub Text5_Change()
        If Val(Text5.Text) > 100 Then
            MsgBox "marks range from 0 to 100"
        Text5.Text = ""
        End If
End Sub

Private Sub Text5_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 And Text5.Text <> "" Then
        calculate.SetFocus
    ElseIf (KeyAscii < 48 And KeyAscii <> 8) Or KeyAscii > 57 Then
        KeyAscii = 0
        MsgBox "enter Digits only"
    End If
End Sub

User Login:
Dim rs As New ADODB.Recordset
Dim conn As New ADODB.Connection


Private Sub cmdexit_Click()
MsgBox "do u really want to exit", vbInformation + vbOKOnly, "table1"
If vbOK Then
End
End If
End Sub

Private Sub cmdlogin_Click()
If Text1.Text = " " Then
MsgBox "enter the username", vbInformation + vbOKOnly, "table1"
Text1.SetFocus
Exit Sub
End If
If Text2.Text = " " Then
MsgBox "enter the password", vbInformation + vbOKOnly, "table1"
Text2.SetFocus
Exit Sub
End If
If Text1.Text <> "" And Text2.Text <> "" Then
If rs.State = 1 Then
rs.Close
Else
rs.Open "select * from table1 where username='" & Text1 & "' and  password='" & Text2 & "'", conn, adOpenDynamic, adLockOptimistic, adCmdText
End If
If rs.EOF = True Then
MsgBox "invalid username and password", vbCritical + vbOKOnly, "table1"
Text1.Text = " "
Text2.Text = " "
Text1.SetFocus
Else
MsgBox "username and password correct", vbInformation + vbOKOnly, "table1"
End If
End If
End Sub

Private Sub Form_Load()
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Users\user2\user99.mdb;Persist Security Info=False"
End Sub
Library Database:
Private Sub cmdexit_Click()
End
End Sub

Private Sub Combo1_click()
If Combo1.Text <> "" Then
Adodc1.RecordSource = "select *from table1 where isbn ='" & Combo1.Text & "'"
Adodc1.Refresh
End If
End Sub

Private Sub Combo2_click()
If Combo2.Text <> "" Then
Adodc1.RecordSource = "select *from table1 where author ='" & Combo2.Text & "'"
Adodc1.Refresh
End If
End Sub

Private Sub Combo3_Click()
If Combo3.Text <> "" Then
Adodc1.RecordSource = "select *from table1 where titile='" & Combo3.Text & "'"
Adodc1.Refresh
End If
End Sub

Private Sub Option1_Click()
If Option1.Value = True Then
Combo1.Visible = True
Combo2.Visible = False
Combo3.Visible = False
End If
End Sub


Private Sub Option2_Click()
If Option2.Value = True Then
Combo1.Visible = False
Combo2.Visible = True
Combo3.Visible = False
End If




End Sub

Private Sub Option3_Click()
If Option3.Value = True Then
Combo1.Visible = False
Combo2.Visible = False
Combo3.Visible = True
End If


End Sub

Encryption And Decryption



Private Sub Command1_Click()
X = encryptdecrypt(Text1.Text, True)
MsgBox (X)
Text2.Text = X

End Sub

Private Sub Command2_Click()
X = encryptdecrypt(Text2.Text, False)
MsgBox (X)

End Sub

Private Sub Command3_Click()
Text1.Text = ""
Text2.Text = ""

End Sub


Private Sub Command4_Click()
Unload Me

End Sub

Public Function encryptdecrypt(ByVal strval, ByVal blndec As Boolean) As String
Dim int1, int2, int3 As Integer
str1 = strval
int1 = Len(str1)
int2 = 1
Randomize
Do While int2 <> (int1 + 1)
str2 = Mid(str1, int2, 1)
If blndec = True Then
int3 = Asc(str2) - 3
Else
int3 = Asc(str2) + 3
End If
str3 = Chr(int3)
str4 = str4 & str3
int2 = int2 + 1
Loop
encryptdecrypt = str4

End Function
Part B

1.Load an Image
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub

Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
Image1.Picture = LoadPicture("C:\Users\user4\Downloads\tenor.gif")
End Sub

Private Sub Form_Load()
File1.Pattern = "*.jpg;*.bmp;*.ico;*.gif;*.wmf"
End Sub
2.Scroll Bar
Private Sub cmdexit_Click()
Unload Me
End Sub

Private Sub HScroll1_Change()
txt1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
txt1.ForeColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
End Sub

Private Sub HScroll2_Change()
txt1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
txt1.ForeColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
End Sub

Private Sub HScroll3_Change()
txt1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
txt1.ForeColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)
End Sub

3.API Viewer
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Pointapi) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Sub cmdexit_click()
Unload Me
End Sub
Private Sub cmdclick_click()
Dim ptapi As Pointapi
retval = MoveToEx(Picture1.hdc, 20, 20, ptapi)
retval = LineTo(Picture1.hdc, 100, 80)
End Sub

Type Pointapi
x As Long
y As Long
End Type

Sequential Search
Private Sub cmddisp_Click()
Dim no As Integer
Grid1.Clear
Grid1.TextMatrix(0, 0) = "slno"
Grid1.TextMatrix(0, 1) = "name"
Grid1.TextMatrix(0, 2) = "address"
Grid1.TextMatrix(0, 3) = "state"
Grid1.TextMatrix(0, 4) = "city"
Grid1.TextMatrix(0, 5) = "pincode"
Grid1.TextMatrix(0, 6) = "phoneno"
Open "C:\Users\user3\Documents\shilpa.txt" For Input As #1
no = 1
slno = 1
While Not EOF(1)
Grid1.Rows = Grid1.Rows + 1
Input #1, v1, v2, v3, v4, v5, v6
Grid1.TextMatrix(no, 0) = slno
Grid1.TextMatrix(no, 1) = v1
Grid1.TextMatrix(no, 2) = v2
Grid1.TextMatrix(no, 3) = v3
Grid1.TextMatrix(no, 4) = v4
Grid1.TextMatrix(no, 5) = v5
Grid1.TextMatrix(no, 6) = v6
no = no + 1
slno = slno + 1
Wend
Close #1
End Sub

Private Sub cmdwrite_Click()
Open "C:\Users\user3\Documents\shilpa.txt" For Append As #1
Write #1, txtname, txtaddr, txtstate, txtcity, txtpin, txtphone
Close #1
clrtext

End Sub



Private Sub Form_Load()
Grid1.ColWidth(0) = 550
Grid1.ColWidth(1) = 1000
Grid1.ColWidth(2) = 1500
Grid1.ColWidth(3) = 1200
Grid1.ColWidth(4) = 1200
Grid1.ColWidth(5) = 1200
Grid1.ColWidth(6) = 1100
End Sub

Private Sub clrtext()
txtname.Text = " "
txtaddr.Text = " "
txtstate.Text = " "
txtcity.Text = " "
txtpin.Text = " "
txtphone.Text = " "

End Sub

Mouse Pointer

Cstring strMessage;
strMessage.Format("Mouse pointer=(%d %d),point.x,point.y);
m_strnmae=strMessage
UpdateData(FALSE)
CDialog::OnMouseMove(nFlags,point)