Save, Edit and Delete Example into Access Database Using VB6.0

Featured

‘——————————————————————-

‘ Instraction For Safe Project Load

‘ Components Add Your Project

‘ 1) Add Microsoft ADO Data Control 6.0 (OLEDB)

‘ 2) Add Microsoft Windows Commom Controls-2.6 Your Project

‘——————————————————————-

Dim db As ADODB.Connection

Dim rst As ADODB.Recordset

Dim id As Integer

Private Sub Form_Load()

‘Open Database Connection

Set db = New ADODB.Connection

db.Open “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\s4sajoy SampleCode\SampleDB.mdb;Persist Security Info=False”

Set rst = New ADODB.Recordset

rst.Open “select * from tblSample Order By SerialNo DESC”, db, adOpenStatic, adLockOptimistic, adCmdText

If rst.RecordCount = 0 Then

id = 1

Else

id = rst(“SerialNo”) + 1

End If

rst.Close

lblID.Caption = id

End Sub

 

Private Sub cmdAdd_Click()

If Trim(txtName.Text) = “” Then

MsgBox “input name”, vbInformation

Else

Set rst = New ADODB.Recordset

rst.Open “select * from tblSample”, db, adOpenStatic, adLockOptimistic, adCmdText

rst.AddNew

rst(“SerialNo”) = CInt(lblID.Caption)

rst(“Date”) = DTPicker1.Value

rst(“Name”) = Trim(txtName.Text)

rst.Update

rst.Close

MsgBox “One Person Added.” & Chr(13) & “Nmae : ” & Trim(txtName.Text), vbInformation

id = id + 1

lblID.Caption = id

DTPicker1.Value = Date

txtName.Text = “”

txtName.SetFocus

End If

End Sub

Private Sub cmdUpdate_Click()

If Trim(txtID.Text) = “” Then

MsgBox “input id no”

txtID.SetFocus

Else

Set rst = New ADODB.Recordset

rst.Open “UPDATE tblSample SET tblSample.Date = #” & DTPicker1.Value & “#, tblSample.Name = ‘” & txtName.Text & “‘ WHERE tblSample.SerialNo=” & txtID.Text, db, adOpenStatic, adLockOptimistic, adCmdText

MsgBox “One Row Updated”

End If

End Sub

Private Sub cmdDelete_Click()

If Trim(txtID.Text) = “” Then

MsgBox “input id no”

txtID.SetFocus

Else: Set rst = New ADODB.Recordset

rst.Open “Delete * From tblSample Where SerialNo=” & txtID.Text, db, adOpenStatic, adLockOptimistic, adCmdText

MsgBox “Delete Successfull”

End If

End Sub

Download [Sample Code]

Advertisements

Sample Database Connection using ADODB in VB 6.0

‘First Create A Database Connection, Use A Module For DBConnection

Public db As ADODB.Connection

Public Sub DBConnection()

Set db = New ADODB.Connection

db.Open “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Sample Code\SampleDB.mdb;Persist Security Info=False”
‘For Password Protected Database
‘ db.Open “Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\Sample Code\SampleDB.mdb;Jet OLEDB:Database Password=yourPassword;”

End Sub

Gradient draw using VB 6.0

Gradient

Public r1 As Integer, g1 As Integer, b1 As Integer
Public r2 As Integer, g2 As Integer, b2 As Integer

Public Sub DrawGradient(frm As Form)

Dim R As Integer, G As Integer, B As Integer
Dim i As Integer
frm.Cls
For i = 0 To 100
R = r1 – (((r1 – r2) / 100) * i)
G = g1 – (((g1 – g2) / 100) * i)
B = b1 – (((b1 – b2) / 100) * i)
frm.Line (0, (frm.ScaleHeight / 100) * i)-(frm.ScaleWidth, (frm.ScaleHeight / 100) * i), RGB(R, G, B)
Next i
End Sub
Public Sub WhiteBlue(frm As Form)
r1 = 255
g1 = 255
b1 = 255

r2 = 245
g2 = 200
b2 = 63

frm.Cls
Call DrawGradient(frm)
End Sub

Private Sub Form_Load()

Call WhiteBlue(frmStartUp)

End Sub

Menu Color Using VB 6.0

Untitled

‘——————–For Mnue Colour———————————————————————-
Private Const MIM_BACKGROUND As Long = &H2
Private Const MIM_APPLYTOSUBMENUS As Long = &H80000000

Private Type MENUINFO
cbSize As Long
fMask As Long
dwStyle As Long
cyMax As Long
hbrBack As Long
dwContextHelpID As Long
dwMenuData As Long
End Type

Private Declare Function DrawMenuBar Lib “user32″ _
(ByVal hWnd As Long) As Long

”’Private Declare Function GetSubMenu Lib “user32″ _
”'(ByVal hMenu As Long, ByVal nPos As Long) As Long
”’
”’Private Declare Function GetMenu Lib “user32″ _
”'(ByVal hWnd As Long) As Long

Private Declare Function SetMenuInfo Lib “user32” _
(ByVal hMenu As Long, _
mi As MENUINFO) As Long

Private Declare Function CreateSolidBrush Lib “gdi32” _
(ByVal crColor As Long) As Long
‘———————–Menu Color End———————————————————————

‘*********** Menu Colour **********
Private Sub ManuColour()
Dim mi As MENUINFO

With mi
.cbSize = Len(mi)

.fMask = MIM_BACKGROUND
.hbrBack = CreateSolidBrush(RGB(255, 255, 255))
SetMenuInfo GetMenu(Me.hWnd), mi ‘main menu bar
.fMask = MIM_BACKGROUND Or MIM_APPLYTOSUBMENUS
.hbrBack = CreateSolidBrush(RGB(139, 201, 242))
SetMenuInfo GetSubMenu(GetMenu(Me.hWnd), 0), mi ‘File menu (item 0)
.hbrBack = CreateSolidBrush(RGB(139, 201, 242))
SetMenuInfo GetSubMenu(GetMenu(Me.hWnd), 1), mi ‘Edit menu (item 1)
.hbrBack = CreateSolidBrush(RGB(139, 201, 242))
SetMenuInfo GetSubMenu(GetMenu(Me.hWnd), 2), mi ‘Select menu (item 2)
.hbrBack = CreateSolidBrush(RGB(139, 201, 242))
SetMenuInfo GetSubMenu(GetMenu(Me.hWnd), 3), mi ‘Select menu (item 2)
End With
DrawMenuBar Me.hWnd
End Sub

Set Icon in Menu Using VB 6.0

Untitled

‘———————–Mnue Icon Declaration————————————————————–
Private Declare Function ShellAbout Lib “shell32.dll” Alias “ShellAboutA” (ByVal hWnd As Long, _
ByVal szApp As String, _
ByVal szOtherStuff As String, _
ByVal hIcon As Long) As Long

Private Declare Function GetMenu Lib “user32” _
(ByVal hWnd As Long) As Long

Private Declare Function GetSubMenu Lib “user32” _
(ByVal hMenu As Long, ByVal nPos As Long) As Long

Private Declare Function SetMenuItemBitmaps Lib “user32” _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, _
ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long

Const MF_BYPOSITION = &H400&
‘—————————–End Mnue Icon Declaration——————————————————-

Private Sub SetMenuIcon()
On Error Resume Next
Dim hMenu As Long
Dim hSubMenu As Long
Dim Ret As Long
‘Get main menu ID
hMenu = GetMenu(hWnd)


‘MENU FILE

‘Get sub menu 0 (File items)
hSubMenu = GetSubMenu(hMenu, 0)

‘set bitmap to menu item, by ordinal
Ret = SetMenuItemBitmaps(hSubMenu, 0, MF_BYPOSITION, iNew.Picture, iNew.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION, iCut.Picture, iCut.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 2, MF_BYPOSITION, iOpen.Picture, iOpen.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 4, MF_BYPOSITION, iCurrency.Picture, iCurrency.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 5, MF_BYPOSITION, iCopy.Picture, iCopy.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 6, MF_BYPOSITION, iSalaryAdjust.Picture, iSalaryAdjust.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 7, MF_BYPOSITION, iCurrency.Picture, iCurrency.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 8, MF_BYPOSITION, iSalaryAdjust.Picture, iSalaryAdjust.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 9, MF_BYPOSITION, iOpen.Picture, iOpen.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 10, MF_BYPOSITION, iEmp.Picture, iEmp.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 12, MF_BYPOSITION, iSalaryAdjust.Picture, iSalaryAdjust.Picture)
‘Skip the separator (it’s 10)
Ret = SetMenuItemBitmaps(hSubMenu, 14, MF_BYPOSITION, iExit.Picture, iExit.Picture)


‘ MENU EDIT

‘Get sub menu 1 (Edit items)
hSubMenu = GetSubMenu(hMenu, 1)
Ret = SetMenuItemBitmaps(hSubMenu, 0, MF_BYPOSITION, iEmp.Picture, iEmp.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION, iUnit.Picture, iUnit.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 2, MF_BYPOSITION, iDepartment.Picture, iDepartment.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 3, MF_BYPOSITION, iDesig.Picture, iDesig.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 5, MF_BYPOSITION, iAdd.Picture, iAdd.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 6, MF_BYPOSITION, iUnit.Picture, iUnit.Picture)

‘ MENU EDIT

‘Get sub menu 2 (Help items)
hSubMenu = GetSubMenu(hMenu, 2)
Ret = SetMenuItemBitmaps(hSubMenu, 0, MF_BYPOSITION, iPrint.Picture, iPrint.Picture)

‘Get sub menu 3 (Help items)
hSubMenu = GetSubMenu(hMenu, 3)
Ret = SetMenuItemBitmaps(hSubMenu, 0, MF_BYPOSITION, iHelp.Picture, iHelp.Picture)
Ret = SetMenuItemBitmaps(hSubMenu, 1, MF_BYPOSITION, iCut.Picture, iCut.Picture)

End Sub

Show Crystal Report Using VB 6.0 and Access Database

 

Write this code in VB6.0

Private Sub Command1_Click()

CrystalReport1.WindowState = crptMaximized
CrystalReport1.DiscardSavedData = True
CrystalReport1.ReportFileName = “DatabasePath”
CrystalReport1.DataFiles(0) = “ReportPath”

If you want to pass value from vb6.0 to Crystal Report

‘CrystalReport1.Formulas(0) = “FDate='” & fromDate & “‘”

Optional If you use password protected database
‘CrystalReport1.Password = Chr$(10) & “sanjoy-pakiza”

Optional If you use Selection Formula
‘CrystalReport1.SelectionFormula = “{tblEmployeePersonalInfo.EID}=” &  1
CrystalReport1.WindowShowPrintBtn = True
CrystalReport1.WindowShowPrintSetupBtn = True
CrystalReport1.Action = 1

End Sub

How to read twitter feed

HTML Code

<ul class=”twitter_post”>
<div id=”twitter-feed”></div>
</ul>

 

twitter-feed-reader.js

$(document).ready(function() {

loadLatestTweet();

});

//Twitter Parsers

String.prototype.parseURL = function() {

return this.replace(/[A-Za-z]+:\/\/[A-Za-z0-9-_]+\.[A-Za-z0-9-_:%&~\?\/.=]+/g, function(url) {

return url.link(url);

});

};

String.prototype.parseUsername = function() {

return this.replace(/[@]+[A-Za-z0-9-_]+/g, function(u) {

var username = u.replace(“@”,””)

return u.link(“http://twitter.com/”+username);

});

};

String.prototype.parseHashtag = function() {

return this.replace(/[#]+[A-Za-z0-9-_]+/g, function(t) {

var tag = t.replace(“#”,”%23″)

return t.link(“http://search.twitter.com/search?q=”+tag);

});

};

function parseDate(str) {

var v=str.split(‘ ‘);

return new Date(Date.parse(v[1]+” “+v[2]+”, “+v[5]+” “+v[3]+” UTC”));

}

function loadLatestTweet(){

var numTweets = 1;

var _url = ‘https://api.twitter.com/1/statuses/user_timeline/TweetID.json?callback=?&count=’+numTweets+’&include_rts=1&#8242;;

$.getJSON(_url,function(data){

for(var i = 0; i< data.length; i++){

var tweet = data[i].text;

var created = parseDate(data[i].created_at);

var createdDate = created.getDate()+’-‘+(created.getMonth()+1)+’-‘+created.getFullYear()+’ at ‘+created.getHours()+’:’+created.getMinutes();

tweet = tweet.parseURL().parseUsername().parseHashtag();

tweet += ‘

$(“#twitter-feed”).append(‘

‘+tweet+’

‘);

}

});

}