Единообразная обработка элементов управления

[alibek]

Вообщем, NET NET-ом, но и о насущном забывать не надо

Появилась у меня очередная программка в жанре "складской учет".
Дошло дело до форм и тут опять обычная история.

Связанные контролы я почему-то не люблю (сам не знаю, почему, но вот стараюсь не использовать). А значит, надо писать код, который будет заполнять элементы управления значениями при открытии формы, выгружать эти значения в источник данных при закрытии формы, а также попутно обслуживать эти элементы управления таким сервисом, как выделение текстовых полей при получении фокуса, автопоиск (и автоподстановка) для ComboBox-ов и т.п.
Форм таким много, все они разные и использовать кучу однообразного кода утомляет.

И вот решил я сделать такую штуку (правда заранее скажу, что идея не моя).

Итак, пишу данный код в инициализацию формы (Form_Load или где еще):

Код: Выделить всё

Dim objFormControls As FormControls
Set objFormControls = New FormControls
objFormControls.Add "Name", txtName, lblName, fctString
objFormControls.Add "Type", cmbType, lblType, fctReference
objFormControls.Add "Changed", dtpChanged, lblChanged, fctDateTime
...
objFormControls.Add "Notes", txtNotes, lblNotes, fctString
...
With objFormControls("Type")
  Set .RefDataSource = rsTypes
  .RefFieldID = "ID"
  .RefFieldValue = "Title"
End With
...
objFormControls("Changed").Locked = True
...
Set objFormControls.DataSource = rsData
...
objFormControls.Refresh


В этом случае загрузка/выгрузка данных становится тривиальной операцией. Либо rsData будет открытым и спозиционированным рекордсетом (и тогда при сохранении данных достаточно сделать rsData.Update), либо rsData будет рекордсетом отвязанным и тогда надо будет его снова присоединить и выполнить пакетное обновление. Либо просто вручную перенести данные из отвязанного рекордсета в БД.

FormControls представляет собой класс-коллекцию из FormControlItem, а так же ряд дополнительных методов, свойств и событий.
FormControlItem представляет собой отдельное поле, связанное с элементом управления. Данное поле при необходимости может использоваться автономно от основной коллекции.

Вообщем, должна хорошая штука получиться.

Вот, к примеру, список событий у FormControls:

Код: Выделить всё

Public Event Click(Field As FormControlField)
Public Event DblClick(Field As FormControlField)
Public Event DropDown(Field As FormControlField)
Public Event CloseUp(Field As FormControlField)
Public Event Scroll(Field As FormControlField)
Public Event ItemCheck(Field As FormControlField, ByVal Index As Long)
Public Event ItemSelect(Field As FormControlField, ByVal Index As Long)
Public Event Change(Field As FormControlField)
Public Event KeyDown(Field As FormControlField, ByRef KeyCode As Integer, ByRef Shift As Integer)
Public Event KeyPress(Field As FormControlField, ByRef KeyAscii As Integer)
Public Event KeyUp(Field As FormControlField, ByRef KeyCode As Integer, ByRef Shift As Integer)
Public Event GotFocus(Field As FormControlField)
Public Event LostFocus(Field As FormControlField)
Public Event CustomData(Field As FormControlField, ByVal Value, ByRef Result As Variant)
Public Event Validate(Field As FormControlField, ByRef Cancel As Boolean)


[Andrey Fedorov]

Кстати, я как-то писал что сие дело у меня уже лет так 6 реализовано и работает - в виде отдельного компонента...

Так что то что оно действительно удобно - это факт.

[Andrey Fedorov]

Вот, к примеру, список событий у FormControls:

Вот кодик одной из форм:

Код: Выделить всё

Option Explicit

Public m_ID_ВидаДоговораDef As Long, m_ID_ПрУслуги As Long, m_bReadOnly As Boolean

Dim WithEvents ExEdit As AFControlsEx.ExEdit

Private Sub ExEdit_AfterUpdate()
    m_ID_ПрУслуги = ExEdit.Recordset!ID_ПрУслуги
End Sub

Private Sub Form_Load()
    Dim s As String

    Set ExEdit = New AFControlsEx.ExEdit
    With ExEdit
        Set .Form = Me
       
        .Source = "SELECT * FROM tblПрУслуги WHERE ID_ПрУслуги=" & m_ID_ПрУслуги
       
        .AddTextbox(txID_ВидаДоговора, , "ID_ВидаДоговора").DefaultValue = m_ID_ВидаДоговораDef
        .AddTextbox txПрУслуга, lbПрУслуга, "ПрУслуга"
        .AddComboBox cbID_ЕдИзм, lbID_ЕдИзм, "ID_ЕдИзм", True, ExTableOrQuery, "SELECT ID_ЕдИзм, ЕдИзм FROM tblЕдИзм ORDER BY 2"
       
        Set .OkButton = btOK
        Set .CancelButton = btCancel
        .Recordset.LockType = IIf(m_bReadOnly, adLockReadOnly, adLockOptimistic)
        .ReadOnly = m_bReadOnly
        .Read
       
        If .NewRecord Then
            If .ReadOnly Then Unload Me: Exit Sub
            s = "Новая запись"
        Else
            s = IIf(.ReadOnly, "Только просмотр", "Изменение")
        End If
        Caption = Caption & " - {" & s & "}"
    End With
    m_ID_ПрУслуги = 0
End Sub


Соответственно у ExEdit есть такие события как BeforeUpdate/AfterUpdate. Туда-же привязаны кнопки OK и Cancel.
На автомате ведется проверка правильности ввода и откат изменений по Escape а-ля Access.

[alibek]

Да, типа этого.
Только у меня это коллекция, чтобы сразу всю форму можно было обслуживать. Хотя можно и по одному полю.

[Andrey Fedorov]

Да, типа этого.
Только у меня это коллекция, чтобы сразу всю форму можно было обслуживать. Хотя можно и по одному полю.

Вообще-то у меня ExEdit - класс обслуживающий все контролы формы, которые в него были добавлены. Так что очень похоже на твой вариант.

[Antonariy]

Многие пользуются подобными классами. У меня тоже есть свой вариант.

Код: Выделить всё

Public Sub SetDataSource(frm As Form, bind As clsBindingCollection, rs As ADODB.Recordset, Optional TagVal As String = "*")
Dim c As Control
    Set bind = New clsBindingCollection
    For Each c In frm.Controls
        If c.Tag = TagVal Then bind.Add c
    Next c
    Set bind.DataSource = rs
End Sub

clsBindingCollection:

Код: Выделить всё

Option Explicit

Dim WithEvents rsData As ADODB.Recordset
Dim mCol As Collection

Public Property Get Count() As Long
    Count = mCol.Count
End Property

Public Property Get ItemValue(Index) As Variant
    ItemValue = GetValue(mCol.Item(Index))
End Property

Public Property Get ItemDefSize(Index) As Long
    Dim lSize As Long
    GetValue mCol.Item(Index), lSize
    ItemDefSize = lSize
End Property

Public Property Get Item(Index) As Object
    On Error Resume Next
    Set Item = mCol.Item(Index)
End Property

Public Sub Add(ctrl As Object)
    mCol.Add ctrl, ctrl.DataField
    If Not rsData Is Nothing Then SetValue ctrl, rsData.Fields(ctrl.DataField).Value
End Sub

Public Sub Remove(ctrl As Long)
    mCol.Remove ctrl
End Sub

Public Property Set DataSource(rhs As ADODB.Recordset)
    Set rsData = rhs
    UpdateControls
End Property

Public Property Get DataSource() As ADODB.Recordset
    Set DataSource = rsData
End Property

Public Sub UpdateDataSource()
Dim X As Long
Dim bm As Object
Dim lLen As Long
Dim lDefLen As Long
Dim vValue As Variant
    On Error Resume Next
    For X = 0 To rsData.Fields.Count - 1
        Set bm = mCol.Item(rsData.Fields(X).Name)
        If Not bm Is Nothing Then
            vValue = GetValue(bm, lLen)
            If VarType(vValue) = vbString And bm.DataField = vbNullString Then
                lDefLen = rsData.Fields(X).DefinedSize
                If lLen > lDefLen Then vValue = Left$(vValue, lDefLen)
            End If
            rsData.Fields(X).Value = vValue
        End If
        Set bm = Nothing
    Next X
End Sub

Private Sub UpdateControls()
Dim X As Long
Dim bm As Object
    On Error Resume Next
    For X = 0 To rsData.Fields.Count - 1
        Set bm = mCol.Item(rsData.Fields(X).Name)
        If Not bm Is Nothing Then SetValue bm, rsData.Fields(X).Value
        Set bm = Nothing
    Next X
End Sub

Private Sub SetValue(ctrl As Object, Value As Variant)
On Error GoTo errh
    Select Case TypeName(ctrl)
        Case "TextBox"
            ctrl.Text = StrFromRS(Value)
        Case "DataCombo", "ctlDirectory"
            ctrl.BoundText = StrFromRS(Value)
        Case "CalendarControl", "DTPicker"
            ctrl.Value = Value
        Case "CheckBox"
            If IsNull(Value) Then
                ctrl.Value = 0
            ElseIf Value Then
                ctrl.Value = 1
            Else
                ctrl.Value = 0
            End If
        Case "ComboBox"
            On Error Resume Next 'for null case
            ctrl.ListIndex = Value
        Case Else
            Err.Raise 9999
    End Select
    Exit Sub
errh:
    Debug.Print "SetValue - !!!!ATTENTION!!!!"
    Err.Raise 9999
End Sub

Private Function GetValue(ByRef ctrl As Object, Optional ByRef lLen As Long) As Variant
    Select Case TypeName(ctrl)
        Case "TextBox"
            GetValue = Trim(ctrl.Text)
        Case "DataCombo", "ctlDirectory"
            GetValue = IIf(ctrl.BoundText = "", 0, ctrl.BoundText)
        Case "CalendarControl", "DTPicker", "CheckBox"
            GetValue = ctrl.Value
        Case "ComboBox"
            GetValue = ctrl.ListIndex
        Case Else
            Err.Raise 9999
    End Select
End Function

Private Sub Class_Initialize()
    Set mCol = New Collection
End Sub

Private Sub Class_Terminate()
    Set rsData = Nothing
    Set mCol = Nothing
End Sub

Private Sub rsData_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
    If adReason = adRsnMove Or adRsnMoveFirst Or adRsnMoveLast Or adRsnMoveNext Or adRsnMovePrevious Or adRsnAddNew Or adRsnDelete Then UpdateControls
End Sub

Форма:

Код: Выделить всё

Dim Binding As clsBindingCollection
Private Sub FillForm()
    rsData.Open ....
    SetDataSource Me, Binding, rsData
End Sub

Private Sub cmdSave_Click()
    Binding.UpdateDataSource
    rsData.UpdateBatch...
End Sub

Ключевое отличие - возможность через Tag задать несколько групп элементов, связанных с разными источниками данных. Плюс наличие Add-In'а, позволяющего драг-дропом из таблицы или представления проставлять значения Tag и DataField.