VB Code

1. BackColor Change

Private Sub CMDBLACK_Click()

Form1.BackColor = vbBlack

End Sub

Private Sub CMDBLUE_Click()

Form1.BackColor = vbBlue

End Sub

Private Sub CMDCYAN_Click()

Form1.BackColor = vbCyan

End Sub

Private Sub CMDGREEN_Click()

Form1.BackColor = vbGreen

End Sub

Private Sub CMDMAGENTA_Click()

Form1.BackColor = vbMagenta

End Sub

Private Sub CMDRED_Click()

Form1.BackColor = vbRed

End Sub

Private Sub CMDWHITE_Click()

Form1.BackColor = vbWhite

End Sub

Private Sub CMDYELLOW_Click()

Form1.BackColor = vbYellow

End Sub

3. Book Sales

 

Private Sub Command1_Click()

Text3.Text = Val(Text1.Text) * Val(Text2.Text)

Text5.Text = Val(Text3.Text) * Val(Text4.Text) / 100

Text6.Text = Val(Text3.Text) - Val(Text5.Text)

End Sub

Private Sub Command2_Click()

Text1.Text = ""

Text2.Text = ""

Text4.Text = ""

End Sub

4. Date and Time

Private Sub cmddate_Click()

lbl.Caption = Date

End Sub

Private Sub cmddt_Click()

lbl.Caption = Date + Time

End Sub

Private Sub CmdTime_Click()

lbl.Caption = Time

End Sub

5. Simple Calculator

Private Sub CMDC_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

End Sub

Private Sub CMDD_Click()

Text3.Text = Val(Text1.Text) / Val(Text2.Text)

End Sub

Private Sub CMDM_Click()

Text3.Text = Val(Text1.Text) - Val(Text2.Text)

End Sub

Private Sub CMDMU_Click()

Text3.Text = Val(Text1.Text) * Val(Text2.Text)

End Sub

Private Sub CMDP_Click()

Text3.Text = Val(Text1.Text) + Val(Text2.Text)

End Sub

6. Circle

if button = 1 then

circle (x, y), 250, rgb(rnd * 255, rnd * 255, rnd * 255)

elseif button = 2 then

me.refresh

end if

7. StopWatch

Private Sub Form_Load()

Text1.Text = 0

Text2.Text = 0

Text3.Text = 1

End Sub

Private Sub cmdplay_Click()

Timer1.Enabled = True

End Sub

Private Sub cmdstop_Click()

Timer1.Enabled = False

End Sub

Private Sub Timer1_Timer()

text1.backcolor = vbred

text2.backcolor = vbyellow

text3.backcolor = vbgreen

text3.text = val(text3.text) + 1

if val(text3.text) = 60 then

text2.text = val(text2.text) + 1

text3.text = 1

end if

if val(text2.text) = 60 then

text1.text = val(text1.text) + 1

text2.text = 0

end if

End Sub

8. Leap Year

Private Sub Command1_Click()

Dim b i b As b Integer

i = Val(Text1.Text)

If b i b Mod b 4 = 0 Then

MsgBox "This b is b a b leap b year"

Else

MsgBox " This b is b not b a b leap b year "

End If

End Sub

Private Sub Command2_Click()

Text1.Text = ""

End Sub

9. Loan Calculator

Private Sub cmdclear_Click()

txtamount.Text = ""

txtrate.Text = ""

txtdur.Text = ""

txtdisp.Text = ""

End Sub

Private Sub cmdshow_Click()

Dim a, b, c, d, e as variant

a = txtamount.Text

b = txtrate.Text

c = txtdur.Text

d = Val(Val(a) * Val(b) / 100)

e = (d / 12) * Val(c)

txtdisp.Text = e

End Sub

10. Letters Count

Private Sub CMDSHOW_Click()

LBL.Caption = Str(Len(Text1.Text))

End Sub

11. Student Result

Private Sub CMDSHOW_Click()

text3.text = val(text1.text) + (text2.text)

if text3.text = "“ then

msgbox "please enter the marks"

elseif text3.text >= 90 then

text4.text = "aa"

elseif  text3.text >= 80 then

text4.text = "a+"

elseif  text3.text >= 70  then

text4.text = "a"

elseif  text3.text >= 60  then

text4.text = "b+"

elseif  text3.text >= 50  then

text4.text = "b"

elseif  text3.text >= 40  then

text4.text = "c"

elseif  text3.text < 40  then

text4.text = "d"

end if

End Sub

Private Sub CMDCLEAR_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

End Sub

Private Sub CMDCLOSE_Click()

End

End Sub

12. Digital Clock

Private Sub Timer1_Timer()

Lbl.Caption = Time

End Sub

Private Sub Timer2_Timer()

Lbl.Cation = Date

End Sub

13. Traffic Light

Private Sub cmdplay_Click()

Timer1.Enabled = True

End Sub

Private Sub cmdstop_Click()

Timer1.Enabled = False

End Sub

Private Sub Timer1_Timer()

if shape1.visible then

shape2.visible = true

shape3.visible = false

shape1.visible = false

lbl.caption = "start the engine"

elseif shape2.visible then

shape3.visible = true

shape2.visible = false

shape1.visible = false

lbl.caption = "go......"

elseif shape3.visible then

shape1.visible = true

shape2.visible = false

shape3.visible = false

lbl.caption = "please wait"

end if

End Sub

14. QB Color

Static i As integer

Me.BackColor = QBColor(i)

i = i + 1

i = i Mod 16

15. Shape Style Change

Static i as integer

Shape1.FillStyle = (i)

i = i + 1

i = i mod 8

16. Calculator

dim f, s, r, op as variant

dim c as boolean

Private Sub CMDEQUL_Click()

s = val(text1.text)

if op = "+" then

r = f + s

elseif op = "*" then

r = f * s

elseif op = "/" then

r = f / s

elseif op = "-" then

r = f - s

end if

c = true

text1.text = r

End Sub

Private Sub Command1_Click(Index As Integer)

if c = true then

text1.text = ""

text1.text = text1.text + command1(index).caption

c = false

else

text1.text = text1.text + command1(index).caption

end if

End Sub

Private Sub CMDCLEAR_Click()

Text1.Text = ""

End Sub

Private Sub CMDMUL_Click()

F = Val(Text1.Text)

Text1.Text = ""

OP = "*"

End Sub

Private Sub CMDDIV_Click()

F = Val(Text1.Text)

Text1.Text = ""

OP = "/"

End Sub

Private Sub CMDPLUS_Click()

F = Val(Text1.Text)

Text1.Text = ""

OP = "+"

End Sub

Private Sub CMDMIN_Click()

F = Val(Text1.Text)

Text1.Text = ""

OP = "-"

End Sub

17. CDL Box

Private Sub CMDBACK_Click()

CD1.ShowColor

Text1.BackColor = CD1.Color

End Sub

Private Sub CMDFORE_Click()

CD1.ShowColor

Text1.ForeColor = CD1.Color

End Sub

Private Sub CMDSYSTEM_Click()

Text1.ForeColor = vbBlack

Text1.BackColor = vbWhite

End Sub

18. Font Style Change

Private Sub CHKB_Click()

if chkb.value = 1 then

text1.fontbold = true

else

text1.fontbold = false

end if

End Sub

Private Sub CHKI_Click()

if chki.value = 1 then

text1.fontitalic = true

else

text1.fontitalic = false

end if

End Sub

Private Sub CHKU_Click()

if chku.value = 1 then

text1.fontunderline = true

else

text1.fontunderline = false

end if

End Sub

Private Sub OPT10_Click()

if opt10.value = true then

text1.fontsize = 10

end if

End Sub

Private Sub OPT14_Click()

if opt14.value = true then

text1.fontsize = 14

end if

End Sub

Private Sub OPT20_Click()

if opt20.value = true then

text1.fontsize = 20

end if

End Sub

Private Sub OPTC_Click()

if optc.value = true then

text1.alignment = 2

end if

End Sub

Private Sub OPTL_Click()

if optl.value = true then

text1.alignment = 0

end if

End Sub

Private Sub OPTR_Click()

if optr.value = true then

text1.alignment = 1

end if

End Sub 

19. Temperature Convert

Private Sub Form_Load()

vsc1.Max = 212

vsc1.Min = 32

vsc1.SmallChange = 1

End Sub

Private Sub vsc1_Change()

Dim c, f As integer

F = vsc1.Value

Text1.Text = F

c = ((F - 32) * 5) / 9

Text2.Text = int(c)

End Sub

20. Log in Form

Private Sub Timer1_Timer()

if pb1.value <> 100 then

pb1.value = pb1.value + 1

else

timer1.enabled = false

form1.hide

form2.show

end if

End Sub

Private Sub cmdcnc_Click()

txtu.Text = ""

txtp.Text = ""

End Sub

Private Sub cmdstr_Click()

if txtu.text = "salar“ and txtp.text = "123“ then

timer1.enabled = true

else

timer1.enabled = false

msgbox "check username & password"

end if

End Sub

Private Sub Form_Load()

Timer1.Enabled = False

End Sub

21. Textbox Locked and Unlocked

Private Sub cmdlock_Click()

Text1.Locked = True

MsgBox "this text is locked"

End Sub

Private Sub cmdunlock_Click()

Text1.Locked = False

MsgBox "this text is unlocked"

End Sub

22. Salary Sheet

Private Sub cmdshow_Click()

label12.caption = val(text6.text) * (text2.text) / 100

label13.caption = val(text6.text) * (text3.text) / 100

label14.caption = val(text6.text) * (text4.text) / 100

label15.caption = val(text6.text) + (label12.caption)+(label13.caption) + (label14.caption)

label16.caption = val(text6.text) * (text5.text) / 100

label17.caption = val(label15.caption) - (label16.caption)

End Sub

Private Sub cmdclear_Click()

text1.text = ""

text2.text = ""

text3.text = ""

text4.text = ""

text5.text = ""

text6.text = ""

label12.caption = ""

label13.caption = ""

label14.caption = ""

label15.caption = ""

label16.caption = ""

label17.caption = ""

End Sub

23. Age Calculator

Private Sub CMDCLEAR_Click()

TXTDATE.Text = ""

TXTDOB.Text = ""

TXTDISP.Text = ""

End Sub

Private Sub CMDSHOW_Click()

dim y as integer

dim m as integer

dim d as integer

dim d1 as date

dim d2 as date

d1 = txtdate.text

d2 = txtdob.text

d = d1 - d2

y = int(d / 365)

d = d mod 365

m = int(d / 30)

d = d mod 30

txtdisp.text = y & "year" & m & "month" & d & "day"

End Sub

24. Queries

Private Sub Form_Load()

COME.Additem ("CITA")

COME.Additem ("DITA")

COME.Additem ("CFAS")

COME.Additem ("DFAS")

COME.Additem ("ADITA")

COME.Text = "CITA"

End Sub

Private Sub CMDC_Click()

End

End Sub

Private Sub CMDA_Click()

if COME.Listindex = 0 Then

LBLD.Caption = "6 MONTH"

LBLF.Caption = "2000"

LBLT.Caption = "FND,WIN,WORD,EXCEL,POWER POINT"

Elseif COME.Listindex = 1 Then

LBLD.Caption = "12 MONTH"

LBLF.Caption = "5000"

LBLT.Caption = "CITA+,VB,ACCESS,INTERNET,SAD"

Elseif COME.Listindex = 2 Then

LBLD.Caption = "6 MONTH"

LBLF.Caption = "2000"

LBLT.Caption = "FND,WIN,WORD,TALLY,GST"

Elseif COME.Listindex = 3 Then

LBLD.Caption = "12 MONTH"

LBLF.Caption = "5000"

LBLT.Caption = "CFAS+,FACT,BUSY,EXCEL,POWER POINT"

Elseif COME.Listindex = 4 Then

LBLD.Caption = “6 MONTH"

LBLF.Caption = "3000"

LBLT.Caption = "HTML, C++, JAVA SCRIPT, INTERNET"

End if

End Sub

25. Large Number Checking

Private Sub cmdshow_Click()

dim x, y, z as integer

x = text1.text

y = text2.text

z = text3.text

if x > y and z < x then

text4.text = "1st number is large"

elseif y > x and z < y then

text4.text = "2nd number is large"

elseif z > x then

text4.text = "3rd number is large"

end if

End Sub

Private Sub cmdclcar_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

Text4.Text = ""

End Sub

26. Picture Copy, Cut and Paste

Private Sub cmdcopy_Click()

Clipboard.SetData Picture1.Picture

End Sub

Private Sub cmdcut_Click()

Clipboard.SetData Picture1.Picture

Picture1.Visible = False

End Sub

Private Sub cmdclear_Click()

Picture2.Picture = LoadPicture()

End Sub

Private Sub cmdpaste_Click()

Picture2.Picture = Clipboard.GetData

End Sub

Private Sub cmdrefresh_Click()

Picture1.Visible = true

End Sub

27. Windows Maximize, Minimize and Restore

Private Sub optmax_Click()

if optmax.value = true then

form1.windowstate = 2

end if

End Sub

Private Sub optmin_Click()

if optmin.value = true then

form1.windowstate = 1

end if

End Sub

Private Sub optres_Click()

if optres.value = true then

form1.windowstate = 0

end if

End Sub

28. General, Even and Odd number

Private Sub cmdg_Click()

dim i as integer

for i = 0 to 100

text1.text = text1.text + str(i) + ""

next

End Sub

Private Sub cmde_Click()

dim p as integer

for p = 0 to 100 step 2

text2.text = text2.text + str(p) + ""

next

End Sub

Private Sub cmdo_Click()

dim s as integer

for s = 1 to 100 step 2

text3.text = text3.text + str(s) + ""

next

End Sub

Private Sub cmdc_Click()

Text1.Text = ""

Text2.Text = ""

Text3.Text = ""

End Sub

29. Phone Book

Private Sub Cmdadd_Click()

if txtn.text="" or txtp.text="" then

txtn.text=""

txtp.text=""

else

lstn.additem txtn.text

lstp.additem txtp.text

txtn.text=""

txtp.text=""

end if

End Sub

Private Sub Cmdremove_Click()

if lstn.listindex = lstp.listindex then

lstn.removeitem lstn.listindex

lstp.removeitem lstp.listindex

else

msgbox "remove not possible try again"

end if

End Sub

30. Restaurant

Private Sub cmdadd_Click()

if lstavl.listindex >= 0 then

lstord.additem lstavl.list(lstavl.listindex)

lstavl.removeitem lstavl.listindex

end if

txtord.text = "" + lstord.list(0) + lstord.list(1)

End Sub

Private Sub cmdremove_Click()

lstavl.additem lstord.list(lstord.listindex)

lstord.removeitem (lstord.listindex)

txtord.text = "" + lstord.list(0) + lstord.list(1)

End Sub