Runtime Visual Basic and access Database Connectivity | Retrieving values in Visual basic from Access

Private Sub Form_Load()
Adodc1.ConnectionString = "provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\demo\pop.mdb;Persist Security Info=False"
Adodc1.RecordSource = "select * from pop
Set Text1.DataSource = Adodc1
Set Text2.DataSource = Adodc1
End Sub



Private Sub Command1_Click()
On Error Resume Next
Adodc1.Recordset.AddNew
With Adodc1.Recordset
.Fields(0) = Text1.Text
.Fields(1) = Text2.Text
End With
Adodc1.Recordset.Save
Adodc1.Recordset.Close
End Sub

fibonacci series in visual basic

Dim i, f1, f2, f3, n As Integer
Private Sub Command1_Click()
n = Text1.Text
i = 3
While (i <= n)
f3 = f1 + f2
f1 = f2
f2 = f3
Next
Print f3
End Sub

Visual Basic connectivity data grid

Dim x As Integer
Private Sub Command1_Click()
x = Text1.Text
Data1.RecordSource = "select * from employees where EmployeeID =" & x
Data1.Refresh
End Sub

Visual basic Database connectivity with Oracle

Dim sql As String
Dim rs1 As New Adodb.Recordset
Dim cn As New Adodb.Connection

Private Sub Command1_Click()
rs1.AddNew
rs1.Fields("rno").Value = Text1.Text
rs1.Fields("name").Value = Text2.Text
rs1.Update
End Sub

Private Sub Form_Load()
Set rs1 = New Adodb.Recordset
cn = New Adodb.Connection
cn.CursorLocation = adUseClient
cn.Open "provider=msdaora.1;", "scott", "tiger"
sql = "select * from pop"
rs1.Open sql, cn, adOpenDynamic, adLockOptimistic
End Sub

creating popup menu in vb6, right click menu in vb6

Private Sub Form_MouseUp(Button As Integer, Shift As _
Integer, X As Single, Y As Single)
If Button = 2 Then

PopupMenu mnuFile

End If
End Sub

MSFLEX in visual basic

Public cn As ADODB.Connection
Public rs As ADODB.Recordset
Private Sub Command1_Click()
MS.Rows = 1
Text3.Text = ""
Dim cmd As ADODB.Command
Dim cmdtxt As String
cmdtxt = ""
Me.MousePointer = vbHourglass
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=pop.mdb;Persist Security Info=False"
cn.Open
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
Set cmd = New ADODB.Command
cmd.CommandType = adCmdText
Set cmd.ActiveConnection = cn
If Option1.Value = True Then
cmdtxt = "Select * from abc where name=" & "'" & Text1.Text + "'" + " order by rno"
Else
If Option2.Value = True Then
cmdtxt = "Select * from abc where rno=" & "'" & Text1.Text + "'" + " order by rno"
End If
End If
cmd.CommandText = cmdtxt
cmd.Prepared = True
Set rs = cmd.Execute
Me.MousePointer = 0
''''''''''''''''''''''''''
Dim r As Integer
r = 1
''''''''''''''''''''''''''Code For entering Data in MSFLEXgrid
Do While Not Me.rs.EOF
MS.AddItem Me.rs.Fields("RNO").Value
MS.Row = r
MS.Col = 1
MS.Text = Me.rs.Fields("name").Value
'MS.Col = 2

r = r + 1
Me.rs.MoveNext
Loop
''''''''''''''
Text3.Text = r - 1
Command2.Enabled = False


If Text3.Text = 0 Then MsgBox "not found"
End Sub

InputBox in vb6

Private Sub Command1_Click()
stranswer = InputBox("what is ur name", "get name")
If (stranswer = "pop") Then
MsgBox "hello " + stranswer
Else
MsgBox stranswer + " Shut up!"
End If
End Sub

Area of circle vb tutor.

Dim r, b, pi As Integer
Private Sub Command1_Click()
pi = 3.14
r = Text1.Text
b = pi * (r * r)
Label2.Caption = "The Area is " & b
End Sub



Private Sub Command3_Click()
Text1.Text = ""
Label2.Caption = ""
End Sub

Making a form invisible, but leaving (showing) the controls visible

This involves using the SetWindowLong API function with the following parameters, GWL_EXSTYLE and WS_EX_TRANSPARENT as constants.

the syntax of the function using the paramters is

dim intresult as long

intresult = setwindowlong(me.hwnd, gwl_exstyle, ws_ex_transparent)

this will make the form referenced by me.hwnd transparent so that the background can be seen but the controls can still be accessed.

Program to Display a Form without a Titlebar. (Hide Title Bar)

Often, an application needs a special window without a title bar, the horizontal
bar at the top of a window that contains the title of the window. For instance, a splash screen or a custom context sensitive menu are nothing more than VB forms without title bars. To make a form appear without a title bar set the following design-time and run-time properties.

Properties that must be set at design-time, they are read-only at
run-time:

ControlBox=False ' Turns off Control-menu: Restore, Move, Size,
Minimize, Maximize, Close
MaxButton=False ' Turns off Maximize button
MinButton=False ' Turns off Minimize button






ShowInTaskbar=False ' Hides window in Taskbar

'Properties that can be set at either run-time or design-time:

Caption="" ' Blanks window title

Program to Determines the number of workdays within a date range.

I used implicit If Statements (IIF) because they take less lines of code, and this procedure is convoluted enough without making is bigger! In case you aren't familiar with them, they are a hold-over from VBA.
The first argument is the expression, the second is what to do if it's true, the third is what to do if it's false.
The first part determines the number of days between 2 dates. The second part determines the number of whole weeks because each whole week has a Saturday & a Sunday in it.
The last part determines if the range spanned a weekend but not a whole week so it can subtract the weekend out.

Private Sub FindWorkDays()
Dim A1 As Date
Dim A2 As Date
Dim iWorkDays As Integer

A1 = Text1.Text
A2 = Text2.Text

iWorkDays = A2 - A1 + 1 - Int((A2 - A1 + 1) / 7) * 2 - _
IIf(Int((A2 - A1 + 1) / 7) = (A2 - A1 + 1) / 7, 0, _
IIf(WeekDay(A2) <>
IIf((WeekDay(A1) = 1 Or WeekDay(A2) = 7), 1, 0)

Label1.Caption = iWorkDays

End Sub

How To Pause your application for a length of time without a timer control in vb (Visual basic)

First put this code either in a module as a private function on a form



Public Declare Sub Sleep Lib "kernel32.dll"
(ByVal dwMilliseconds As Long)


Then when you want to pause something just do this

Sleep 1000 'Pause for 1 second

Simple Hostel Management system Project In Visual basic

Dim hrs As Recordset

Private Sub add_Click()
clr
hrs.AddNew
End Sub

Private Sub delete_Click()
a = MsgBox("Do you want to delete record?", vbQuestion + vbYesNo, "Record Deletion")
If a = vbYes Then
st = "delete * from Hostel_Data Where d_no = " & Val(tno) & ""
DB.Execute (st)
hrs.MoveNext
display
End If
End Sub

Private Sub first_Click()
hrs.MoveFirst
display
End Sub

Private Sub Form_Load()
Module1.hostel
Set hrs = DB.OpenRecordset("Hostel_Data", dbOpenTable)
End Sub

Private Function clr()
tno = Empty
tname = Empty
tadd = Empty
trent = Empty
End Function
Private Function display()
tno = hrs.Fields("d_no")
tname = hrs.Fields("d_name")
tadd = hrs.Fields("d_address")
trent = hrs.Fields("d_rent")
End Function

Private Sub last_Click()
hrs.MoveLast
display
End Sub

Private Sub modify_Click()
hrs.Edit
hrs.Fields("d_no") = Val(tno)
hrs.Fields("d_name") = Trim(tname)
hrs.Fields("d_address") = Trim(tadd)
hrs.Fields("d_rent") = Val(trent)
hrs.Update
MsgBox "Record Modified Successfully"
End Sub

Private Sub next_Click()
hrs.MoveNext
If hrs.EOF = True Then
hrs.MoveLast
End If
display
End Sub
S
Private Sub previous_Click()
hrs.MovePrevious
If hrs.BOF = True Then
hrs.MoveFirst
End If
display
End Sub

Private Sub save_Click()
hrs.Fields("d_no") = Val(tno)
hrs.Fields("d_name") = Trim(tname)
hrs.Fields("d_address") = Trim(tadd)
hrs.Fields("d_rent") = Val(trent)
hrs.Update
MsgBox "The record has been succesfully saved"
End Sub

Program showing Recordset ADODC Add, Update Example

Dim crs As Recordset
Private Sub add_Click()
clr
crs.AddNew
End Sub

Private Sub delete_Click()
a = MsgBox("Do you want to delete record?", vbQuestion + vbYesNo, "Record Deletion")
If a = vbYes Then
st = "delete * from courses Where c_id = " & Val(tid) & ""
DB.Execute (st)
crs.MoveNext
display
End If
End Sub
Private Sub first_Click()
crs.MoveFirst
display
End Sub

Private Sub Form_Load()
Module.courses
Set crs = DB.OpenRecordset("courses", dbOpenTable)
End Sub

Private Function clr()
tid = Empty
tname = Empty
tfees = Empty
tseats = Empty
End Function

Private Function display()
tid = crs.Fields("c_id")
tname = crs.Fields("c_name")
tfees = crs.Fields("c_fees")
tseats = crs.Fields("c_seats")
End Function

Private Sub last_Click()
crs.MoveLast
display
End Sub

Private Sub modify_Click()
crs.Edit
crs.Fields("c_id") = Val(tid)
crs.Fields("c_name") = Trim(tname)
crs.Fields("c_fees") = Val(tfees)
crs.Fields("c_seats") = Val(tseats)
crs.Update
MsgBox "Record Modified Successfully"
End Sub



Private Sub next_Click()
crs.MoveNext
If crs.EOF = True Then
crs.MoveLast
End If
display
End Sub

Private Sub pre_Click()
crs.MovePrevious
If crs.BOF = True Then
crs.MoveFirst
End If
display
End Sub

Private Sub save_Click()
crs.Fields("c_id") = Val(tid)
crs.Fields("c_name") = Trim(tname)
crs.Fields("c_fees") = Val(tfees)
crs.Fields("c_seats") = Val(tseats)
crs.Update
MsgBox "The record has been succesfully saved"
End Sub