Visual Basic 6 Unleashed…sional Reference Edition)/Visual_Basic_6_Unleashed_Professional_Reference_Edition_Sams_1999.iso/Source/CHAP16/DataObj.ctl

Visual Basic Form | 1998-06-11 | 21.8 KB | 514 lines

VERSION 5.00
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.UserControl uctDOCtlDataGrid
   ClientHeight    =   3600
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4800
   ScaleHeight     =   3600
   ScaleWidth      =   4800
   Begin VB.ComboBox cmbEdit
      Appearance      =   0  'Flat
      Height          =   315
      Left            =   480
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   1320
      Visible         =   0   'False
      Width           =   1000
   End
   Begin MSDataGridLib.DataGrid grdDOCtl
      Height          =   3400
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   4600
      _ExtentX        =   8123
      _ExtentY        =   6006
      _Version        =   393216
      HeadLines       =   1
      RowHeight       =   15
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   1033
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0
         BeginProperty Column00
         EndProperty
         BeginProperty Column01
         EndProperty
      EndProperty
   End
Attribute VB_Name = "uctDOCtlDataGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "WizardYN" ,"Yes"
Attribute VB_Ext_KEY = "VBProjectName" ,"Project1"
Attribute VB_Ext_KEY = "DEDesignerName" ,"DataEnvironment1"
Attribute VB_Ext_KEY = "ConnectionName" ,"Connection1"
Attribute VB_Ext_KEY = "CommandName" ,"OrderInfo"
Attribute VB_Ext_KEY = "ClassType" ,"User Control"
Attribute VB_Ext_KEY = "DataClassName" ,"rsclsDataObjClass"
Attribute VB_Ext_KEY = "RootName" ,"uctDOCtlDataGrid"
Attribute VB_Ext_KEY = "UserControlType" ,"DataGrid"
'=============================================================
'Name: uctDOCtlDataGrid (The DataGrid UserControl object)
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: DataGrid UserControl object using a Data Object Wizard RecordSet class as a DataSource class.
'Comment:
'=============================================================
'The current datagrid control column
Private mlCurrentCol As Long
'Prohibits several operations the first time the datagrid control loads.
Private mbFirstTime As Boolean
'Prohibits showing the listbox control as the datagrid control loads for the first time.
Private mbShowCombo As Boolean
'Allows the datagrid control to be editable and displays the listbox control on columns with the Foreign Key attributes.
Public GridEditable As Boolean
'True if an error occurred in the DataSource class.
Private mbClassError As Boolean
'Create the datagrid control column constants
Private Const ORDERID_COLUMN As Long = 0
Private Const CUSTOMERID_COLUMN As Long = 1
Private Const CUSTOMERSCOMPANYNAME_COLUMN As Long = 2
Private Const ORDERDATE_COLUMN As Long = 3
Private Const PRODUCTID_COLUMN As Long = 4
Private Const UNITPRICE_COLUMN As Long = 5
Private Const QUANTITY_COLUMN As Long = 6
'Create parameter properties for the Select RecordSet class
'Create the Foreign Key Parameter properties for the RecordSet classes
'Use the Data Object Wizard RecordSet class as a DataSource class
Private WithEvents oDataObjClass As rsclsDataObjClass
Attribute oDataObjClass.VB_VarHelpID = -1
'Set the ManualInitialize property to false to automatically initialize or true to manually inititalize the UserControl object
Public ManualInitialize As Boolean
'The RecordSet Move event
Public Event MoveComplete(oDataSource As Object)
'Format the object for the datagrid control Boolean columns
Private oStdDataFormat As StdDataFormat
'Save the adImmediate property when the user moves off the row.
Public SaveMode As EnumSaveMode
Public Function InitDataObjClass(Optional oDataObjClass0 As Variant) As Object
'=============================================================
'Name: InitDataObjClass
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Initializes the datagrid control.
'Comment:
'=============================================================
    'Set flags to true on load.
    mbFirstTime = True
    mbShowCombo = True
    'Create Format object for the datagrid control Boolean columns
    Set oStdDataFormat = New StdDataFormat
    oStdDataFormat.Type = fmtBoolean
    oStdDataFormat.FalseValue = "False"
    oStdDataFormat.TrueValue = "True"
    On Error GoTo InitDataObjClassErr
    'Reset the DataSource class.
    Set oDataObjClass = Nothing
    'Use the Data Object Wizard RecordSet class as the DataSource class for the datagrid control
    If IsMissing(oDataObjClass0) Then
        'If the DataSource class was not passed as a parameter, create the DataSource class.
        Set oDataObjClass = New rsclsDataObjClass
    Else
        'Use the DataSource class passed as a parameter.
        Set oDataObjClass = oDataObjClass0
    End If
    'Set the RecordSet class Foreign Key parameter properties to the UserControl object values
    'Save the adImmediate property when the user moves off the row.
    oDataObjClass.SaveMode = Me.SaveMode
    'Set the source of data for the datagrid control
    mbClassError = False
    grdDOCtl.DataMember = "ORDERINFO"
    Set grdDOCtl.DataSource = oDataObjClass
    'If there is an error, exit the function.
    If mbClassError Then
        MsgBox "Cannot initialize grid control."
        Exit Function
    End If
    'Allow new records and deletes for the datagrid control
    If GridEditable Then
        grdDOCtl.AllowAddnew = True
        grdDOCtl.AllowDelete = True
        grdDOCtl.AllowUpdate = True
    Else
        grdDOCtl.AllowAddnew = False
        grdDOCtl.AllowDelete = False
        grdDOCtl.AllowUpdate = False
    End If
    'Show both scroll bars for the control.
    grdDOCtl.ScrollBars = dbgboth
    'Since the listbox control height cannot resize, force the same for the datagrid control RowHeight property.
    grdDOCtl.AllowRowSizing = False
    'Set the RowHeight property to make the listbox controls appear in the row of the datagrid control.
    grdDOCtl.RowHeight = 288
    'Hide columns not used in control
    grdDOCtl.Columns(COMPANYNAME_COLUMN).Width = 0
    'Column Headings for the datagrid control
    grdDOCtl.Columns(ORDERID_COLUMN).Caption = "OrderID"
    grdDOCtl.Columns(CUSTOMERID_COLUMN).Caption = "CustomerID"
    grdDOCtl.Columns(CUSTOMERSCOMPANYNAME_COLUMN).Caption = "CompanyName"
    grdDOCtl.Columns(ORDERDATE_COLUMN).Caption = "OrderDate"
    grdDOCtl.Columns(PRODUCTID_COLUMN).Caption = "ProductID"
    grdDOCtl.Columns(UNITPRICE_COLUMN).Caption = "UnitPrice"
    grdDOCtl.Columns(QUANTITY_COLUMN).Caption = "Quantity"
    'Save the current column of the datagrid control
    mlCurrentCol = grdDOCtl.Col
    'Set the Flag to false
    mbFirstTime = False
    'Return the Class object.
    Set InitDataObjClass = oDataObjClass
    'Resize the datagrid control to the UserControl object when we are in the Visual Basic Run Time mode.
    grdDOCtl.Top = UserControl.ScaleTop
    grdDOCtl.Left = UserControl.ScaleLeft
    grdDOCtl.Height = UserControl.ScaleHeight
    grdDOCtl.Width = UserControl.ScaleWidth
    Exit Function
InitDataObjClassErr:
End Function
Private Sub FillCombo(Ctrl As ComboBox, oRS As Recordset, nDescrField As String, bShowNone As Boolean)
'=============================================================
'Name: FillCombo
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Fills the Foreign Key as hidden in the combobox control
'Comment:
'=============================================================
    'Clear the floating combobox control
    Ctrl.Clear
    'If Foreign Key Identifier field is nullable then put '(None)' as the first record in listbox control
    If bShowNone Then
        Ctrl.AddItem "(None)"
        Ctrl.ItemData(Ctrl.NewIndex) = -1
    End If
    'Move to the first record of the RecordSet class
    oRS.MoveFirst
    'Load the combobox control from the RecordSet class
    While Not oRS.EOF
        Ctrl.AddItem oRS(nDescrField)
        Ctrl.ItemData(Ctrl.NewIndex) = oRS.AbsolutePosition
        oRS.MoveNext
    Wend
    On Error Resume Next
        Select Case grdDOCtl.Col
            'Set the listbox control to the Foreign Key value.
            Case CUSTOMERSCOMPANYNAME_COLUMN:
                If IsNull(oDataObjClass.customerid) Then
                    Ctrl.ListIndex = 0
                Else
                    Ctrl.ListIndex = GetSurKeyCustomers(oDataObjClass.customerid)
                End If
        End Select
    On Error GoTo 0
End Sub
Private Sub ShowFloatingControl(Ctrl As ComboBox, nColNumber As Integer, nRow As Integer)
'=============================================================
'Name: ShowFloatingControl
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Locates and unhides the Foreign Key listbox control.
'Comment:
'=============================================================
    Dim oCol As Column
    'Set the listbox control to the clicked datagrid control column
    Set oCol = grdDOCtl.Columns(nColNumber)
    'Move and show the listbox control
    With Ctrl
        .Left = grdDOCtl.Left + oCol.Left
        .Top = grdDOCtl.Top + grdDOCtl.rowtop(grdDOCtl.Row)
        .Width = oCol.Width + Screen.TwipsPerPixelX
        If nRow = -1 Then
            .ListIndex = 0
        Else
            .ListIndex = nRow
        End If
        .ZOrder 0
        'If the listbox control is outside of the datagrid control, don't show the datagrid control.
        If oCol.Left + oCol.Width <= grdDOCtl.Left + grdDOCtl.Width Then
            .Visible = True
            .SetFocus
        Else
            grdDOCtl.Col = 0
        End If
    End With
End Sub
Private Sub grdDOCtl_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
'=============================================================
'Name: grdDOCtlDataGrid_ButtonClick
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Standard DataGrid control ButtonClick event code.
'Comment:
'=============================================================
    cmbEdit.Visible = False
    'Exit the procudure if the GridEditable property is set to false
    If mbFirstTime Or (Not mbShowCombo) Or (Not GridEditable) Then
        Exit Sub
    End If
    'Save the datagrid controls current cell position
    mlCurrentCol = grdDOCtl.Col
    'Show the floating listbox control based on the datagrid controls column property
    Select Case mlCurrentCol
        'Fill the listbox control, set the control to the value of the Foreign Key and show it.
        Case CUSTOMERSCOMPANYNAME_COLUMN:
            FillCombo cmbEdit, oDataObjClass.rsCustomers, "CompanyName", True
            If grdDOCtl.Row = -1 Then
                SendKeys cmbEdit.List(0)
            Else
                If IsNull(oDataObjClass.customerid) Then
                    ShowFloatingControl cmbEdit, CUSTOMERSCOMPANYNAME_COLUMN, -1
                Else
                    ShowFloatingControl cmbEdit, CUSTOMERSCOMPANYNAME_COLUMN, GetSurKeyCustomers(grdDOCtl.Columns(CUSTOMERID_COLUMN).Text)
                End If
            End If
        Case Else
            cmbEdit.Visible = False
    End Select
End Sub
Private Sub grdDOCtl_Scroll(Cancel As Integer)
'=============================================================
'Name: grdDOCtl_Scroll
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Standard DataGrid control Scroll event.
'Comment:
'=============================================================
    'Hide the listbox control
    cmbEdit.Visible = False
End Sub
Private Function GetSurKeyCustomers(customerid) As Integer
'=============================================================
'Name: GetSurKeyCustomers
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Moves the RecordSet class to the AbsolutePosition value of the Foreign Key parameters.
'Comment:
'=============================================================
    oDataObjClass.rsCustomers.MoveFirst
    ' Loop through each record in the Foreign Key RecordSet class until we find the actual Foreign Key values
    While Not oDataObjClass.rsCustomers.EOF
        If oDataObjClass.rsCustomers("customerid").Value = (customerid) Then
            'Return the Surrogate Key value.
            GetSurKeyCustomers = oDataObjClass.rsCustomers.AbsolutePosition
            Exit Function
        End If
        oDataObjClass.rsCustomers.MoveNext
    Wend
    'If the Surrogate Key (AbsolutePosition) value is not found, set the function to the first Recordset item
    GetSurKeyCustomers = 1
End Function
Private Function UpdateFKCustomers(nSurrogateKey As Integer)
'=============================================================
'Name: UpdateFKCustomers
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Sets the Foreign Key properties based on the Surrogate Key value in the class.
'Comment:
'=============================================================
    If nSurrogateKey = -1 Then
        'Set the actual Foreign Key value to null
        oDataObjClass.customerid = Null
    Else
        oDataObjClass.rsCustomers.MoveFirst
        'Move the Foreign Key RecordSet class to the Surrogate Key value(the AbsolutePosition property.)
        While Not oDataObjClass.rsCustomers.EOF
            If oDataObjClass.rsCustomers.AbsolutePosition = Val(nSurrogateKey) Then
                'Set the DataSource class property to the value of the Foreign Key RecordSet class field.
                oDataObjClass.customerid = oDataObjClass.rsCustomers("customerid")
                Exit Function
            End If
            oDataObjClass.rsCustomers.MoveNext
        Wend
    End If
End Function
Private Sub cmbEdit_Click()
'=============================================================
'Name: cmbEdit_Click
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Standard lstEdit control click event.
'Comment:
'=============================================================
    If cmbEdit.Visible Then
        Select Case mlCurrentCol
            Case CUSTOMERSCOMPANYNAME_COLUMN:
                'Run the UpdateFK method to update the DataSource class Foreign Key Property value(s).
                UpdateFKCustomers cmbEdit.ItemData(cmbEdit.ListIndex)
        End Select
        'Update the datagrid control's cell with the listbox control List value.
        If cmbEdit.List(cmbEdit.ListIndex) = "(None)" Then
            grdDOCtl.Text = "(None)"
        Else
            grdDOCtl.Text = cmbEdit.List(cmbEdit.ListIndex)
        End If
    End If
    cmbEdit.Visible = False
End Sub
Private Sub oDataObjClass_ClassError(sProcedureName As String, oErr As ErrObject)
'=============================================================
'Name: oDataObjClass
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: This subroutine performs the Sink action on the ClassError event.
'Comment:
'=============================================================
    Dim sStr As String
    sStr = sProcedureName
    If oErr.Description <> "" Then
        sStr = sStr & oErr.Description
    End If
    mbClassError = True
    MsgBox sStr
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
'=============================================================
'Name: UserControl_ReadProperties
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Standard UserControl object ReadProperties Event.
'Comment:
'=============================================================
    Dim bErrorFlag As Boolean
    Dim sParamName As String
    bErrorFlag = False
    On Error GoTo errUserControl_ReadProperties
    'Set ManualInitialize property to false to initialize the datagrid control automatically.
    ManualInitialize = PropBag.ReadProperty("ManualInitialize")
    'Set GridEditable property to true to allow editing of the datagrid control and activate Foreign Key listbox controls.
    GridEditable = PropBag.ReadProperty("GridEditable")
    If Not ManualInitialize Then
        'Read the SaveMode property value.
        sParamName = "SaveMode"
        SaveMode = CLng(PropBag.ReadProperty("SaveMode"))
        'If parameter values were read then initialize the DataSource class.
        If Not bErrorFlag And Ambient.UserMode Then
            InitDataObjClass
        End If
    End If
Exit Sub
errUserControl_ReadProperties:
    bErrorFlag = True
    Resume Next
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
'=============================================================
'Name: UserControl_WriteProperties
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Standard UserControl object WriteProperties event.
'Comment:
'=============================================================
    On Error Resume Next
    'Set the ManualInitialize property to false to initialize the datagrid control automatically.
    PropBag.WriteProperty "ManualInitialize", ManualInitialize
    'Set the GridEditable property to true to allow editing the datagrid control and activate the Foreign Key listbox controls.
    PropBag.WriteProperty "GridEditable", GridEditable
    If Not ManualInitialize Then
        'Write the SaveMove property value.
        PropBag.WriteProperty "SaveMode", SaveMode
    End If
    On Error GoTo 0
End Sub
Private Sub UserControl_Resize()
'=============================================================
'Name: UserControl_Resize
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Standard UserControl object Resize event.
'Comment:
'=============================================================
    'Resize the datagrid control to the UserControl object when we are in Visual Basic Design Time mode.
    grdDOCtl.Top = UserControl.ScaleTop
    grdDOCtl.Left = UserControl.ScaleLeft
    grdDOCtl.Height = UserControl.ScaleHeight
    grdDOCtl.Width = UserControl.ScaleWidth
End Sub
Public Sub oDataObjClass_rsMoveComplete()
'=============================================================
'Name: MoveComplete
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: UserControl object MoveComplete event.
'Comment:
'=============================================================
    RaiseEvent MoveComplete(oDataObjClass)
End Sub
Private Sub grdDOCtl_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
'=============================================================
'Name: grdDOCtl_ColResize
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Standard DataGrid control ColResize event.
'Comment:
'=============================================================
    If cmbEdit.Visible Then
        If grdDOCtl.Columns(mlCurrentCol).Left + grdDOCtl.Columns(mlCurrentCol).Width <= grdDOCtl.Left + grdDOCtl.Width Then
            'If the listbox control does not extend past the datagrid control, then resize the listbox control to the column width of the datagrid control.
            cmbEdit.Left = grdDOCtl.Left + grdDOCtl.Columns(mlCurrentCol).Left
            cmbEdit.Width = grdDOCtl.Columns(mlCurrentCol).Width
        Else
            'If the listbox control extends past the datagrid control, then do not show the listbox control.
            cmbEdit.Visible = False
        End If
    End If
End Sub
Private Sub grdDOCtl_KeyPress(KeyAscii As Integer)
'=============================================================
'Name: grdDOCtl_KeyPress
'Author: Microsoft Data Object Wizard
'Date: 06/11/1998 18:39
'Description: Standard DataGrid control KeyPress event.
'Comment:
'=============================================================
    Select Case grdDOCtl.Col
        Case Is = CUSTOMERSCOMPANYNAME_COLUMN
            KeyAscii = 0
    End Select
End Sub