End Property
Private Sub Class_Initialize()
Set mrec = New Recordset
End Sub
Private Sub Class_Terminate()
CloseRecs
End Sub
Public Sub OpenRecs()
On Error GoTo onErr
Set mrec.ActiveConnection = gBase.Conn
mrec.Open mstrQuery, , adOpenKeyset, adLockOptimistic, adCmdText
Exit Sub
onErr:
Err.Raise ueFileNotExist, , "Не открывается запрос " & vbCrLf _
& mstrQuery & vbCrLf _
& "в БД " & gBase.File
End Sub
' закрытие описания
Public Sub CloseRecs()
If mrec Is Nothing Then Exit Sub
If mrec.State = adStateOpen Then
mrec.Close
End If
End Sub
Option Explicit
Private Const strList As String = "dgd"
Private Const strFirst As String = "txtStudy"
Private Const strLast As String = "txtName"
Private WithEvents rec As Recordset
Attribute rec.VB_VarHelpID = -1
Private ctlMark As Control
Private edstForm As EditState
' загрузка и выгрузка формы
Private Sub Form_Load()
Set rec = gClientStudy.Recs
Set dgd.DataSource = rec
dgd.Columns(0).Width = dgd.Width - lngDgdBorderWidth
Set ctlMark = txtStudy
edstForm = estView
doFormAlign Me
Me.Caption = gstrClientStudyTitle
gfrmMain.mnuEdit.Enabled = True
doEditListOn
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set ctlMark = Nothing
Set gfrmClientStudy = Nothing
End Sub
Private Sub Form_Terminate()
If gfrmMain.ActiveForm Is Nothing Then
gfrmMain.mnuEdit.Enabled = False
End If
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case vbKeyReturn
KeyAscii = 0
Select Case Me.ActiveControl.Name
Case strLast
If edstForm = estAdd Then
SendKeys "{INSERT}"
End If
doGoList
Case Else
doGoNext
End Select
Case vbKeyEscape
KeyAscii = 0
Select Case Me.ActiveControl.Name ' имя активного поля
Case strList
doGoMark
Case Else
edstForm = estCancel
doGoList
End Select
End Select
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyF9
KeyCode = 0
doGoFirst
Case vbKeyF10
KeyCode = 0
doGoLast
Case vbKeyF12
KeyCode = 0
Select Case Me.ActiveControl.Name
Case strList
Case Else
doGoList
End Select
Case vbKeyInsert
KeyCode = 0
Select Case Me.ActiveControl.Name ' имя активного поля
Case strList
doAddBlank
Case Else
End Select
End Select
End Sub
Private Sub dgd_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyDelete
KeyCode = 0
doDelete
End Select
End Sub
' перемещение фокуса
Private Sub dgd_GotFocus()
On Error GoTo onErr
Select Case edstForm
Case estCancel, estView
doFill
Case estUpdate
doUpdate
Case estAdd
doAddRec
End Select
dgd.MarqueeStyle = dbgHighlightRow
doEditListOn
Exit Sub
onErr:
gGen.ErrMsg
gBase.Conn.Errors.Clear
doGoMark
End Sub
Private Sub dgd_LostFocus()
dgd.MarqueeStyle = dbgNoMarquee
doEditFieldsOn
End Sub
Private Sub txtStudy_LostFocus()
Set ctlMark = txtStudy
End Sub
Private Sub txtName_LostFocus()
Set ctlMark = txtName
End Sub
Public Sub doMarkUpdate()
If edstForm <> estAdd Then
edstForm = estUpdate
End If
End Sub
Private Sub rec_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, _
ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum,
ByVal pRecordset As ADODB.Recordset)
If edstForm <> estAdd Then doFill
End Sub
' операции с записями
Public Sub doFill()
If rec.EOF Or rec.BOF Then Exit Sub
txtStudy.Text = rec!Study & ""
txtName.Text = rec!Name & ""
edstForm = estView
End Sub
Public Sub doUpdate()
Dim strNameSave As String
Dim lngStudySave As Long
On Error GoTo onErr
doCheck
lngStudySave = rec!Study
strNameSave = rec!Name
rec!Study = txtStudy.Text
rec!Name = txtName.Text
rec.Update
edstForm = estView
Exit Sub
onErr:
Select Case Err.Number
Case dbeEmptyOrRepField
rec!Study = lngStudySave
rec!Name = strNameSave
Set ctlMark = txtStudy
Err.Raise ueInput, , "Повторение значения" & vbCrLf & _
"в Коде Факультета или в Факультете"
Case Else
Err.Raise Err.Number, , Err.Description
End Select
End Sub
Public Sub doCheck()
If Not IsNumeric(txtStudy.Text) Then
Set ctlMark = txtStudy
Err.Raise ueInput, , "Код Факультета должен быть числовым"
End If
If CLng(txtStudy.Text) = lngErrCode Then ' Код типа - не 0
Set ctlMark = txtStudy
Err.Raise ueInput, , "Код Факультета должен быть задан"
End If
If Trim(txtName.Text) = "" Or Trim(txtName.Text) = strErrString Then
Set ctlMark = txtName
Err.Raise ueInput, , "Факультет должен быть задан"
End If
End Sub
Public Sub doAddBlank()
txtStudy.Text = ""
txtName.Text = ""
edstForm = estAdd
doGoFirst
End Sub
Public Sub doAddRec()
On Error GoTo onErr
doCheck
rec.AddNew Array("Study", "Name"), Array(CLng(txtStudy.Text), CStr(txtName.Text))
Exit Sub
onErr:
Select Case Err.Number
Case dbeEmptyOrRepField
rec!Study = lngErrCode
rec!Name = strErrString
rec.Update
rec.Delete
Set ctlMark = txtStudy
Err.Raise ueInput, , "Повторение значения" & vbCrLf & _
Case Else
Err.Raise Err.Number, , Err.Description
End Select
End Sub
Public Sub doDelete()
On Error GoTo onErr
doDelRec
Exit Sub
onErr:
gGen.ErrMsg
rec.Resync adAffectAllChapters
doGoList
End Sub
Public Sub doDelRec()
On Error GoTo onErr
rec.Delete
If rec.RecordCount = 0 Then doAddBlank
Exit Sub
onErr:
Select Case Err.Number
Case dbeDelLinkRec
Err.Raise ueDelLinkRec, , _
Case Else
Err.Raise Err.Number, , Err.Description
End Select
End Sub
' перемещение курсора
Public Sub doGoNext()
SendKeys "{TAB}"
End Sub
Public Sub doGoList()
dgd.SetFocus
End Sub
Public Sub doGoFirst()
txtStudy.SetFocus
End Sub
Public Sub doGoLast()
txtName.SetFocus
End Sub
Public Sub doGoMark()
ctlMark.SetFocus
End Sub