Veritabanından Bilgi Çekmek

 
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

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

veritabanından bilgi � ekmek