frmsetoptions.frm

《VB6数据库开发指南》所有的例程的源码

VERSION 5.00
Begin VB.Form frmSetOptions 
   Caption         =   "Set Options"
   ClientHeight    =   1725
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5850
   LinkTopic       =   "Form1"
   ScaleHeight     =   1725
   ScaleWidth      =   5850
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdDelete 
      Caption         =   "&Delete Key"
      Height          =   375
      Left            =   4380
      TabIndex        =   6
      Top             =   1260
      Width           =   1275
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "&Save Setting"
      Height          =   375
      Left            =   4380
      TabIndex        =   5
      Top             =   780
      Width           =   1275
   End
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "&Close"
      Default         =   -1  'True
      Height          =   375
      Left            =   4380
      TabIndex        =   4
      Top             =   180
      Width           =   1275
   End
   Begin VB.TextBox txtSetting 
      Height          =   315
      Left            =   1020
      TabIndex        =   3
      Top             =   780
      Width           =   2595
   End
   Begin VB.ComboBox cboKeys 
      Height          =   315
      Left            =   1020
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   180
      Width           =   2835
   End
   Begin VB.Label lblSetting 
      Caption         =   "Se&tting:"
      Height          =   195
      Left            =   180
      TabIndex        =   2
      Top             =   840
      Width           =   615
   End
   Begin VB.Label lblKey 
      Caption         =   "&Key:"
      Height          =   195
      Left            =   180
      TabIndex        =   0
      Top             =   240
      Width           =   435
   End
End
Attribute VB_Name = "frmSetOptions"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' form level variable used to store the selected parameter from the list
' in the keys combo box
Private m_lSelectedParameter As Long

' form level constant declarations used throughout the application to name
' the application and section when using the Get and Save settings methods
Private Const APPLICATION_TITLE = "VB6DBHT Chapter 11"
Private Const SECTION_NAME = "Jet 3.5"


Private Sub Form_Load()

    ' load all Jet Registry settings from application section fo the
    ' Windows Registry
    LoadJetRegistryInformation APPLICATION_TITLE, SECTION_NAME
    
    With cboKeys
    
        ' add all of the available parameters for the SetOption method
        
        .AddItem "dbPageTimeout"
        .AddItem "dbSharedAsyncDelay"
        .AddItem "dbExclusiveAsyncDelay"
        .AddItem "dbLockRetry"
        .AddItem "dbUserCommitSync"
        .AddItem "dbImplicitCommitSync"
        .AddItem "dbMaxBufferSize"
        .AddItem "dbMaxLocksPerFile"
        .AddItem "dbLockDelay"
        .AddItem "dbRecycleLVs"
        .AddItem "dbFlushTransactionTimeout"
        
        ' select the first item in the combo box control
        .ListIndex = 0
        
    End With
    
End Sub

Private Sub cboKeys_Click()

    Dim lDefaultSetting As Variant

    With cboKeys
    
        ' get a long value from the text version of the key
        m_lSelectedParameter = GetParameterFromKey(.Text)
        
        ' obtain the default setting for the key
        lDefaultSetting = GetDefaultKeySetting(.Text)
        
        ' display the current setting from the applications Registry
        ' settings if there is one, otherwise, display the default
        txtSetting = GetSetting(APPLICATION_TITLE, _
                                SECTION_NAME, _
                                .Text, _
                                lDefaultSetting)
    
    End With
    
End Sub

Private Sub cmdClose_Click()
    
    ' end the application
    Unload Me
    
End Sub

Private Sub cmdSave_Click()

' if there is an error, goto the code labeled by ERR_cmdSave_Click
On Error GoTo ERR_cmdSave_Click:

    ' constant declarations for expected errors
    Const ERR_TYPE_MISMATCH = 13
    Const ERR_RESERVED_ERROR = 3000
    
    ' attempt to set the DBEngine option for the given key
    ' an error will occur here if an incorrect setting data type is
    ' entered by the user
    DBEngine.SetOption m_lSelectedParameter, GetValueFromSetting(txtSetting)
    
    ' if the SetOption method was successful, then save the new setting
    ' value in the application Registry section
    SaveSetting APPLICATION_TITLE, SECTION_NAME, cboKeys.Text, txtSetting
    
    ' inform the user of the success
    MsgBox "Change has been made.", vbInformation, "Set Option"
    
Exit Sub

ERR_cmdSave_Click:

    Dim sMessage As String
    
    With Err
    
        Select Case .Number
        
            ' wrong data type entered for key setting
            Case ERR_TYPE_MISMATCH, ERR_RESERVED_ERROR:
                sMessage = "Value is of incorrect format."
                
            ' unexpected error, create a message from the error
            Case Else:
                sMessage = "ERROR #" & .Number & ": " & .Description
                
        End Select
    
    End With
    
    ' inform the user of the error
    MsgBox sMessage, vbExclamation, "ERROR"

    ' repopulate the setting text box with the current or default key
    ' setting and set focus to the text box
    
    cboKeys_Click
    txtSetting.SetFocus
    
End Sub

Private Sub cmdDelete_Click()

    ' remove the setting from the application section of the Windows
    ' Registry
    DeleteSetting APPLICATION_TITLE, SECTION_NAME, cboKeys.Text
    
    ' refresh the setting text box with the default value
    cboKeys_Click
        
    ' inform the user of the success
    MsgBox "Key has been deleted.", vbInformation, "Delete Key"
    
End Sub