MyDesign | Kod Arşivi - Anasayfaya Dön   No banner in farm
Anasayfa Araştır Forum Gelişmiş Arama Siteniz İçin En Hit İçerikler RSS İçerik Ekle Scriptler Destekleyenler Kadromuz Reklam İletişim Giriş Sayfası Yap  Sık Kullanılanlara Ekle
Bu Kategorinin En Yeni Kodları:


Bu Kategorinin En Çok Görüntülenen Kodları:






Arama:
Gelişmiş Arama


No banner in farm



En Çok Görüntülenen Kodlar:


Üye Girişi:
 Üye Ol



Anasayfa > VisualBasic > Kodlar

Veritabanından Bilgi Çekmek

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

Kategori : VisualBasic
Gönderen : LonG
Telif :
Tarih : 31 May�s 2005
Örnek Dosya : İndir
Okunma Sayısı : 11173
Puan
: 7,8 / 10 (5 Oy)
Puan Verin :
Google Bookmarks  del.icio.us  Digg  Yahoo! MyWeb  Windows Live  Furl
 
 
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
 
 

Veritabanından Bilgi Çekmek için yazılan yorumlar

Henüz yorum eklenmedi.

Yorum ekleyin

Anasayfa > VisualBasic > Kodlar > Veritabanından Bilgi Çekmek
Kategoriler:


Forum:



Bağlantılar:



    En Son Yorumlanan İçerikler:


    Murat Yavuz | Site Haritası | Gizlilik Bildirimi | 54.145.83.79 | 0,14 Saniye
    © Copyright 2004-2018 MyDesign | Kod Arşivi. Tüm Hakları Saklıdır.
    MyDesign | Kod Arşivi, en iyi görünüm için, 1024x768 ve üzeri çözünürlük tavsiye eder.