Attribute VB_Name = "System"
Option Compare Database
Option Explicit

Sub checkSize(F As Form, Optional s)  'S is a Subform
'ROUTINE : checkSize
'PURPOSE : resize subform on Resize event of main form
'INPUT   : Form F: form that fires Resize
'           subform S: name of subform control to be co-sized
'OUTPUT  : .
'USES    : .
'EFFECT  : .

Dim nh As Single, nS As Single, nHS As Single
Dim flag As Integer
On Error GoTo err_checkSize
   If IsMissing(s) Then
      nS = 0
      nHS = 0
   Else
      nS = s.Top * 2
      nHS = s.Height
   End If
   flag = 1
   nh = F.InsideHeight - F.Section(acHeader).Height
   If nh < nS Then
      flag = 2
      F.InsideHeight = nS + F.Section(acHeader).Height + 1
   Else
      If nh < nHS Then
         If Not IsMissing(s) Then s.Height = nh - nS
         F.Section(acDetail).Height = nh
      Else
         F.Section(acDetail).Height = nh
         If Not IsMissing(s) Then s.Height = nh - nS
      End If
   End If
exit_checkSize:
   Exit Sub
err_checkSize:
   Select Case Err
   Case 2462 'invalid section number
      Select Case flag
      Case 1
         nh = F.InsideHeight
      Case 2
         F.InsideHeight = nS + 1
      End Select
      Resume Next
   Case Else
      Standaardfout
      Resume exit_checkSize
   End Select
End Sub

Sub LogRecord(Mij As Form, Optional cTag = "")
'ROUTINE : logrecord
'PURPOSE : store changed data
'INPUT   : Form Mij: form with changes (so, a current record)
'           cTag, optional: action name (like insert, delete)
'OUTPUT  : .
'USES    : GetSysItem, LogItem, Treated, (FieldToLog)
'EFFECT  : .

'store changed form in log table
'form calls this routine:
'
'Private Sub Form_AfterInsert()
'   logrecord Me, "insert"
'   me!USysCreatedBy = currentuser
'End Sub
'
'Private Sub Form_BeforeUpdate(Cancel As Integer)
'   logrecord Me
'   Me!usysmodifiedAt = Now
'   Me!usysmodifiedBy = currentuser
'End Sub
'
'Private Sub Form_Delete(Cancel As Integer)
'   logrecord Me, "delete"
'End Sub

Dim C As Control, cPrefix As String
Dim cUsedTable As String, cPrimaryField As String
Dim holdDate As Variant
On Error GoTo err_logrecord
   DoCmd.Hourglass True
   'source table name is stored in Form.Tag
   cUsedTable = "t" & Mij.Tag
   Set rs = CurrentDb.OpenRecordset("USysLog", dbOpenDynaset)
   cPrimaryField = CurrentDb.TableDefs(cUsedTable).Indexes("PrimaryKey").Fields(0).Name
   cPrefix = cUsedTable & "(" & Mij(cPrimaryField) & ")"
   For Each C In Mij.Section(acDetail).Controls
      If C.ControlSource <> "" Then
         If cTag <> "" Then
            'log with action name
            LogItem cPrefix & C.Name, CStr(cTag), Treated(C.Value, C)
         'for general use, comment the first line and uncomment the second:
         ElseIf C.OldValue <> C.Value And FieldToLog(Mij.Tag, C) Then
         'ElseIf C.OldValue <> C.Value Then
            'log changes
            LogItem cPrefix & C.Name, Treated(C.OldValue, C), Treated(C.Value, C)
         End If
      End If
next_logrecord:
   Next
exit_logrecord:
   If rs.RecordCount > GetSysItem("logmaxsize") Then
      rs.AbsolutePosition = GetSysItem("logsegsize")
      holdDate = rs!moddate
      rs.Close
      DoCmd.RunSQL "delete from usyslog where moddate<" & holdDate
   End If
   DoCmd.Hourglass False
   rs.Close
   Exit Sub
err_logrecord:
   Select Case Err
   Case 438 'property not applicable
      Resume next_logrecord
   Case Else
      Select Case Standaardfout
      Case vbAbort
         Resume exit_logrecord
      Case vbRetry
         Resume
      Case vbIgnore
         Resume Next
      End Select
   End Select
End Sub

Sub LogItem(ByVal cField As String, cOld As String, cNew As String)
'ROUTINE : logItem
'PURPOSE : part of logrecord: store changed field
'INPUT   : cField: name of changed field
'           cOld: old/former value
'           cNew: new/current value
'OUTPUT  : .
'USES    : Standaardfout
'EFFECT  : .

'write change to log table
On Error GoTo err_logitem
   rs.AddNew
   rs!moduser = CurrentUser
   rs!modfield = cField
   rs!modoldval = cOld
   rs!modnewval = cNew
   rs.Update
exit_logitem:
   Exit Sub
err_logitem:
   Select Case Err
   Case 91, 3420 'invalid object reference
      Set rs = CurrentDb.OpenRecordset("USysLog", dbOpenDynaset)
      Resume
   Case Else 'dunno
      Select Case Standaardfout
      Case vbAbort
         Resume exit_logitem
      Case vbRetry
         Resume
      Case vbIgnore
         Resume Next
      End Select
   End Select
End Sub

Function Standaardfout(Optional cFlag) As Long
'ROUTINE : Standaardfout
'PURPOSE : supply uniform but general error message to user, to catch errors I do not foresee
'INPUT   : cFlag, optional: trace point (has to be coded)
'OUTPUT  : long: {vbAbort, vbRetry, vbIgnore}
'USES    : .
'EFFECT  : .

Dim cMsg As String
   DoCmd.Hourglass False
   DoCmd.Echo True
   If IsMissing(cFlag) Then
      cMsg = "Error " & Err.Number
   Else
      cMsg = "Error " & Err.Number & " at " & cFlag
   End If
   Standaardfout = MsgBox(cMsg & ": " & Err.Description, vbAbortRetryIgnore)
'how to use this :
exit_: ' append routine label
   Exit Function
err_: ' append routine label
   Select Case Err
   Case 0 ' you use your own recognized errors here
   Case Else
      Select Case Standaardfout
      Case vbAbort
         Resume exit_ ' append routine label
      Case vbRetry
         Resume
      Case vbIgnore
         Resume Next
      End Select
   End Select
End Function

Function Treated(ByVal vInput As Variant, cItem As Control) As String
'ROUTINE : Treated
'PURPOSE : null-waarden vermijden in logrecord
'INPUT   : .
'OUTPUT  : .
'USES    : .
'EFFECT  : .

On Error GoTo err_treated
   If IsNull(vInput) Then
      Treated = "..."
   Else
      If cItem.RowSource <> "" Then
         Treated = cItem.Column(1)
      End If
next_treated:
   End If
exit_treated:
   Exit Function
err_treated:
   Select Case Err
   Case 438 'no such property
      Treated = vInput
      Resume next_treated
   Case Else
      Select Case Standaardfout
      Case vbAbort
         Resume exit_treated
      Case vbRetry
         Resume
      Case vbIgnore
         Resume Next
      End Select
   End Select
End Function

Function FieldToLog(ByVal cTable As String, ByVal C As Control) As Boolean
   FieldToLog = DLookup("islog", "USys_q_EntAtt", "entity='" & cTable & "' and attribute='" & C.ControlSource & "'")
End Function