Visual Basic - Veritabanindan Bilgi Çekmek - IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası

yoSun · 13 Haziran 2011, 22:59

Veritabanından bilgileri alan ve ekleme, silme, düzenleme gibi temel işlemleri yapan program örneği.

Kod:
Option Explicit
Private WithEvents mObjrec As clsData 'Declare Class Object
Dim mstrUniqVal1 As String 'Variable to Store AreaName before Edit Operation

Private Sub Form_Load()
Call Sub_OpenForm
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If mObjrec.AddFlag Or mObjrec.EditFlag Then
glngTmp = MsgBox("Do you Want to Exit Without Save Changes?", vbQuestion + vbYesNo)
If glngTmp = vbYes Then
Call Fun_Cancel
Else
Cancel = True
Exit Sub
End If
End If
Set frmArea = Nothing
End Sub

Private Sub mobjRec_MoveComplete()
'This will display the current record position for this recordset
MsgBar "Record: " & CStr(mObjrec.AbsolutePosition), False
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
If mObjrec.AddFlag Or mObjrec.EditFlag Then
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB**"
End If
If KeyAscii = 27 Then
Call Fun_Cancel
End If
ElseIf mObjrec.AddFlag = False And mObjrec.EditFlag = False Then
If KeyAscii = 27 Then Unload Me
End If
End Sub

Private Sub Sub_OpenForm()
On Error GoTo AreaErr
Me.Height = 3060
Me.Width = 3800
Set mObjrec = New clsData
With mObjrec
.SQL = "SELECT areacode,areaname FROM area ORDER BY areaname"
.ConString = gstrConn
.IndexField = "AREANAME"
.RSOpen
End With
Dim txtObj As Object
For Each txtObj In Me.txtFields
txtObj.DataMember = "Primary"
Set txtObj.DataSource = mObjrec
Next
txtFields(0).DataField = "AreaCode"
txtFields(1).DataField = "AreaName"
FraObject.Enabled = False
Exit Sub
AreaErr:
MsgBox Err.Description
End Sub

Private Sub Form_Keydown(KeyCode As Integer, Shift As Integer)
If mObjrec.AddFlag Or mObjrec.EditFlag Then Exit Sub
Select Case KeyCode
Case vbKeyEscape
Unload Me
Case vbKeyEnd
mObjrec.Move "LAST"
Case vbKeyHome
mObjrec.Move "FIRST"
Case vbKeyUp, vbKeyPageUp
If Shift = vbCtrlMask Then
mObjrec.Move "FIRST"
Else
mObjrec.Move "PRIOR"
End If
Case vbKeyDown, vbKeyPageDown
If Shift = vbCtrlMask Then
mObjrec.Move "LAST"
Else
mObjrec.Move "NEXT"
End If
End Select
End Sub

Public Sub DataAny(fv_opt As String)
Select Case fv_opt
Case "ADD"
mObjrec.Data "ADD"
FraObject.Enabled = True
txtFields(1).SetFocus
MsgBar "Add Record", False
Case "EDIT"
mObjrec.Data "EDIT"
FraObject.Enabled = True
mstrUniqVal1 = UCase(txtFields(1))
txtFields(1).SetFocus
MsgBar "Edit Record", False
Case "SAVE"
gstrSQL = "select count(*) from area where ucase(areaname)='" & UCase(Trim(txtFields(1))) & "'"
gblnChkUnique = mObjrec.CheckUnique(txtFields(1), mstrUniqVal1, gstrSQL)
If gblnChkUnique = True Then
MsgBox "AreaName Already Exists!", vbOKOnly + vbCritical
SendKeys "{HOME**+{END**"
txtFields(1).SetFocus
TBEnable frmmdi, gstrAddEditTB
Exit Sub
End If
gstrSQL = "Select max(areacode)+1 from area"
txtFields(0) = Fun_GetValue(gstrSQL)
mObjrec.Data "SAVE"
FraObject.Enabled = False
MsgBar "Record Saved", False
Case "CANCEL"
txtFields(0).DataChanged = False
txtFields(1).DataChanged = False
mObjrec.Data "CANCEL"
FraObject.Enabled = False
MsgBar "Cancelled Operation", False
End Select
End Sub

Public Sub Find()
gstrSQL = InputBox("Enter AreaName to Find", "Find Area")
If Len(Trim(gstrSQL)) > 0 Then
gstrSQL = "AreaName='" & Trim(gstrSQL) & "'"
mObjrec.Find gstrSQL
End If
End Sub

Public Sub Delete()
glngTmp = MsgBox("Do you Want to Delete Current Record?", vbYesNo + vbQuestion)
If glngTmp = vbYes Then
mObjrec.Delete
End If
End Sub

Public Sub MoveAny(fv_opt As String)
mObjrec.Move fv_opt
End Sub

Private Sub txtFields_Change(Index As Integer)
Select Case Index
Case 1
frmmdi.tlbToolBar.Buttons("Save").Enabled = Len(Trim(txtFields(1))) > 0
End Select
End Sub

Benzer Konular
Konu	Konuyu Başlatan	Forum	Cevaplar	Son Mesaj
Visual Basic	PySSyCaT	Bilgisayar Sözlüğü	0	24 Ocak 2016 21:52
Visual Basic Hakkında Geniş Bilgi	TUNAHAN	Visual Basic	1	25 Eylül 2013 15:24
Visual Basic	Cry	Bilgisayar Donanımı	0	19 Eylül 2011 17:48

Konuyu Toplam 1 Üye okuyor. (0 Kayıtlı üye ve 1 Misafir)

Etiketlenen Kullanıcılar
Etiketlemek istediğiniz kullanıcılar arasına virgül koyunuz. Örnek: nokta,sukunet,NucLear

5846 sayılı Fikir ve Sanat Eserleri Kanunu gereğince sitemizde telif hakkı bulunan mp3,video v.b. eserlerin paylaşımı yasaktır. Yasal işlem olması halinde paylaşan kişi yada kişilerin bilgileri gerekli kuruma verilecektir.