IRCForumları - IRC ve mIRC Kullanıcılarının Buluşma Noktası
  sohbet

Yeni Konu aç Cevapla
 
LinkBack Seçenekler Stil
Alt 21 Temmuz 2008, 19:30   #1
Çevrimdışı
Yardımcı Admin
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
IF Ticaret Sayısı: (0)
IF Ticaret Yüzdesi:(%)
Veritabanından Bilgi Çekmek




alıntıdır

PHP Kod:   Kodu kopyalamak için üzerine çift tıklayın!
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 IntegerUnloadMode 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 


__________________
[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]

[Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...]
 
Alıntı ile Cevapla

IRCForumlari.NET Reklamlar
sohbet odaları sohbet odaları Benimmekan Mobil Sohbet
Cevapla

Etiketler
bilgi, cekmek, veritabanından


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

Yetkileriniz
Konu Acma Yetkiniz Yok
Cevap Yazma Yetkiniz Yok
Eklenti Yükleme Yetkiniz Yok
Mesajınızı Değiştirme Yetkiniz Yok

BB code is Açık
Smileler Açık
[IMG] Kodları Açık
HTML-Kodu Kapalı
Trackbacks are Kapalı
Pingbacks are Açık
Refbacks are Açık


Benzer Konular
Konu Konuyu Başlatan Forum Cevaplar Son Mesaj
Proteinlerle ilgili bilgi, Protein hakkında bilgi PySSyCaT Sağlık Köşesi 0 24 Ocak 2015 23:15
Visual Basic - Veritabanindan Bilgi Çekmek yoSun Visual Basic 0 13 Haziran 2011 22:59