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

alıntıdır
PHP- Kodu:
   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