Master 95 #1/MASTER95_1.iso/microsof/vbasic4/vb4-6.cab/muopt.frm

Visual Basic Form | 1995-07-26 | 5.7 KB | 190 lines

VERSION 4.00
Begin VB.Form frmMUOptions
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Multi User Settings"
   ClientHeight    =   810
   ClientLeft      =   270
   ClientTop       =   2565
   ClientWidth     =   9105
   Height          =   1215
   HelpContextID   =   2016089
   Icon            =   "MUOPT.frx":0000
   Left            =   210
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   810
   ScaleWidth      =   9105
   Top             =   2220
   Width           =   9225
   Begin VB.CommandButton cmdFreeLocks
      Caption         =   "&Free Locks"
      Height          =   375
      Left            =   7920
      TabIndex        =   5
      Top             =   45
      Width           =   1095
   End
   Begin VB.CommandButton cmdRowsPerPage
      Caption         =   "&Add RowsPerPage Prop"
      Height          =   375
      Left            =   6000
      TabIndex        =   4
      Top             =   40
      Width           =   1935
   End
   Begin VB.TextBox txtDelay
      Height          =   285
      Left            =   1200
      TabIndex        =   1
      Top             =   480
      Width           =   495
   End
   Begin VB.OptionButton optLocking
      Caption         =   "Optimistic - Lock occurs on Update"
      Height          =   255
      Index           =   1
      Left            =   1800
      TabIndex        =   3
      Top             =   480
      Width           =   4095
   End
   Begin VB.CommandButton cmdClose
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Height          =   375
      Left            =   7920
      TabIndex        =   7
      Top             =   405
      Width           =   1095
   End
   Begin VB.CommandButton cmdSet
      Caption         =   "&Set for All Recordsets"
      Default         =   -1  'True
      Height          =   375
      Left            =   6000
      TabIndex        =   6
      Top             =   400
      Width           =   1935
   End
   Begin VB.OptionButton optLocking
      Caption         =   "Pessimistic - Lock occurs on Edit"
      Height          =   255
      Index           =   0
      Left            =   1800
      TabIndex        =   2
      Top             =   120
      Value           =   -1  'True
      Width           =   4095
   End
   Begin VB.TextBox txtRetryCnt
      Height          =   285
      Left            =   1200
      TabIndex        =   0
      Top             =   120
      Width           =   495
   End
   Begin VB.Label lblLabels
      Caption         =   "Delay:"
      Height          =   255
      Index           =   1
      Left            =   120
      TabIndex        =   9
      Top             =   480
      Width           =   735
   End
   Begin VB.Label lblLabels
      Caption         =   "Retry Count:"
      Height          =   255
      Index           =   0
      Left            =   120
      TabIndex        =   8
      Top             =   120
      Width           =   975
   End
Attribute VB_Name = "frmMUOptions"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdClose_Click()
  Unload Me
End Sub
Private Sub cmdRowsPerPage_Click()
  Dim tdf As TableDef
  Dim fld As Field
  Dim prp As Property
  Dim nRPPVal As Integer
  Dim i As Integer, ii As Integer
  SetHourglass
  'add the property to each table
  On Error Resume Next  'ignore error if it's there already
  For Each tdf In gdbCurrentDB.TableDefs
    If (tdf.Attributes And dbAttachedODBC) <> 0 Then GoTo SkipIt
    If (tdf.Attributes And dbSystemObject) <> 0 Then GoTo SkipIt
    If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
      If Left(tdf.Connect, 1) <> ";" Then
        'must not be a jet table so RowsPerPage doesn't apply
        GoTo SkipIt
      End If
    End If

    Set prp = tdf.CreateProperty("RowsPerPage", dbInteger, 0)
    tdf.Properties.Append prp
    'set the values of the property
    nRPPVal = 8    'start with overhead of 8 bytes
    For Each fld In tdf.Fields
      If fld.Type < dbLongBinary Then
        'this includes binary and memo fields
        nRPPVal = nRPPVal + fld.Size
      Else
        nRPPVal = nRPPVal + 4
      End If
    Next
    'assign the value using a 2k page / field total
    tdf.Properties("RowsPerPage").Value = 2048 \ nRPPVal
SkipIt:
  Next
  On Error GoTo RPPErr
  MsgBox "All Tables now have a user defined property" & _
         " called RowsPerPage that contains the number" & _
         " of rows that will fit into a 2k Jet page" & _
         " used in page locking. It is accessible through" & _
         " the Properties collection on Tables and" & _
         " Recordsets."
  Screen.MousePointer = vbDefault
  Exit Sub
RPPErr:
  ShowError
  Exit Sub
End Sub
Private Sub cmdSet_Click()
  On Error GoTo SETErr
  Dim rec As Recordset
  Dim i As Integer
  gnMURetryCnt = txtRetryCnt.Text
  gnMUDelay = txtDelay.Text
  gnMULocking = optLocking(0).Value
  'set the Lockedits prop for each open dynaset and table
  For Each rec In gdbCurrentDB.Recordsets
    If rec.Type <> dbOpenSnapshot Then
      rec.LockEdits = gnMULocking
    End If
  Next
  Exit Sub
SETErr:
  ShowError
  Exit Sub
End Sub
Private Sub cmdFreeLocks_Click()
  DBEngine.Idle dbFreeLocks
End Sub
Private Sub Form_Load()
  txtRetryCnt.Text = gnMURetryCnt
  txtDelay.Text = gnMUDelay
  optLocking(0).Value = gnMULocking
  Me.Left = 0
  Me.Top = frmMDI.Height - frmMUOptions.Height - 1820
End Sub