Content Supported by Sourcelens Consulting
VERSION 5.00
Object = "{CDE57A40-8B86-11D0-B3C6-00A0C90AEA82}#1.0#0"; "MSDATGRD.OCX"
Begin VB.Form frmDEShape
Caption = "Single DataGrid Bound to Shape"
ClientHeight = 3615
ClientLeft = 675
ClientTop = 2310
ClientWidth = 7005
LinkTopic = "Form1"
ScaleHeight = 3615
ScaleWidth = 7005
Begin VB.CommandButton cmdMove
Caption = "Move First"
Height = 285
Index = 0
Left = -15
TabIndex = 6
Top = 75
Width = 1335
End
Begin VB.CommandButton cmdMove
Caption = "Move Previous"
Height = 285
Index = 1
Left = 1330
TabIndex = 5
Top = 75
Width = 1365
End
Begin VB.CommandButton cmdMove
Caption = "Move Next"
Height = 285
Index = 2
Left = 2705
TabIndex = 4
Top = 75
Width = 1305
End
Begin VB.CommandButton cmdMove
Caption = "Move Last"
Height = 285
Index = 3
Left = 4020
TabIndex = 3
Top = 75
Width = 1125
End
Begin VB.CommandButton cmdRequery
Caption = "Bind"
Height = 360
Left = 3180
TabIndex = 2
Top = 615
Width = 1875
End
Begin VB.TextBox txtCustomer
Height = 315
Left = 75
TabIndex = 1
Text = "Text1"
Top = 660
Width = 2880
End
Begin MSDataGridLib.DataGrid grdData
Height = 2220
Left = 135
TabIndex = 0
Top = 1380
Width = 6210
_ExtentX = 10954
_ExtentY = 3916
_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
End
Attribute VB_Name = "frmDEShape"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private bConnect As Boolean
Private Sub cmdRequery_Click()
ReShape ' Requery using the DataEnvironment Shape command.
RebindFields ' Rebind controls to DataEnvironment recordsets.
End Sub
Private Sub RebindFields()
With grdData
.DataMember = "Orders"
Set .DataSource = deNwind
End With
With txtCustomer
.DataMember = "Customers"
.DataField = "CompanyName"
Set .DataSource = deNwind
End With
End Sub
Private Sub cmdMove_Click(Index As Integer)
On Error GoTo MoveErr
Select Case Index
Case 0 ' Move first
deNwind.rsCustomers.MoveFirst
Case 1 ' Move Previous
deNwind.rsCustomers.MovePrevious
Case 2 ' Move Next
deNwind.rsCustomers.MoveNext
Case 3 ' Move last
deNwind.rsCustomers.MoveLast
End Select
If deNwind.rsCustomers.BOF Then _
deNwind.rsCustomers.MoveFirst
If deNwind.rsCustomers.EOF Then _
deNwind.rsCustomers.MoveLast
Exit Sub
MoveErr:
If Err.Number = 3704 Then
ReShape
RebindFields
Resume
Else
MsgBox "Unexpected Error: " & Err.Number & ": " & _
Err.Description
End
End If
Exit Sub
End Sub
Private Sub DoRequery()
' Keep a reference to the Connection object.
Dim x As Connection
Set x = deNwind.rsCustomers.ActiveConnection
' If x.State = adStateOpen Then x.Close
With deNwind.rsCustomers
' Close the Recordset object.
If .State = adStateOpen Then
.Close
.Open , x
.Requery
End If
End With
' Rebind a TextBox control named txtCustomer
' and a DataGrid control named grdData
With txtCustomer
Set .DataSource = deNwind
.DataMember = "Customers"
.DataField = "CompanyName"
End With
With grdData
.DataMember = "customers"
Set .DataSource = deNwind
End With
bConnect = True
End Sub
Private Sub Form_Resize()
With grdData
.Width = frmDEShape.Width - 500
.Height = frmDEShape.Height - grdData.Top - 500
End With
End Sub
Private Sub txtCustomer_Validate(Cancel As Boolean)
If txtCustomer.Text = "" Then
MsgBox "Can't have a null value"
Cancel = True
ElseIf bConnect = False Then
Exit Sub
Else
deNwind.rsCustomers.Update
End If
End Sub