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

Visual Basic Form | 1995-07-26 | 25.4 KB | 735 lines

VERSION 4.00
Begin VB.Form frmDFD
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Data Form Designer"
   ClientHeight    =   4065
   ClientLeft      =   1155
   ClientTop       =   2505
   ClientWidth     =   6135
   Height          =   4470
   HelpContextID   =   2018517
   Icon            =   "DFD.frx":0000
   Left            =   1095
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4065
   ScaleWidth      =   6135
   Top             =   2160
   Width           =   6255
   Begin VB.CheckBox chkOnScreen
      Caption         =   "On Screen"
      Height          =   195
      Left            =   810
      TabIndex        =   17
      Top             =   3345
      Width           =   1665
   End
   Begin VB.ListBox lstOLECtls
      Height          =   615
      Left            =   120
      TabIndex        =   16
      Top             =   3360
      Visible         =   0   'False
      Width           =   615
   End
   Begin VB.CommandButton cmdMoveFields
      Caption         =   "<<"
      Height          =   375
      Index           =   3
      Left            =   2760
      TabIndex        =   7
      Top             =   2880
      Width           =   495
   End
   Begin VB.CommandButton cmdMoveFields
      Caption         =   "<"
      Height          =   375
      Index           =   2
      Left            =   2760
      TabIndex        =   6
      Top             =   2400
      Width           =   495
   End
   Begin VB.CommandButton cmdMoveFields
      Caption         =   ">"
      Height          =   375
      Index           =   1
      Left            =   2760
      TabIndex        =   5
      Top             =   1920
      Width           =   495
   End
   Begin VB.CommandButton cmdMoveFields
      Caption         =   ">>"
      Height          =   375
      Index           =   0
      Left            =   2760
      TabIndex        =   4
      Top             =   1440
      Width           =   495
   End
   Begin VB.ListBox lstIncludedFields
      DragIcon        =   "DFD.frx":030A
      Height          =   1785
      Left            =   3360
      MultiSelect     =   2  'Extended
      TabIndex        =   3
      Top             =   1440
      Width           =   2655
   End
   Begin VB.CommandButton cmdBuildForm
      Caption         =   "&Build the Form"
      Height          =   375
      Left            =   720
      TabIndex        =   8
      Top             =   3600
      Width           =   1695
   End
   Begin VB.ComboBox cboRecordSource
      Height          =   300
      Left            =   1680
      TabIndex        =   1
      Top             =   480
      Width           =   4335
   End
   Begin VB.ListBox lstFields
      DragIcon        =   "DFD.frx":0614
      Height          =   1785
      Left            =   120
      MultiSelect     =   2  'Extended
      TabIndex        =   2
      Top             =   1440
      Width           =   2535
   End
   Begin VB.TextBox txtFormName
      Height          =   285
      Left            =   2760
      MaxLength       =   8
      TabIndex        =   0
      Top             =   120
      Width           =   1095
   End
   Begin VB.CommandButton cmdClose
      Caption         =   "&Close"
      Height          =   375
      Left            =   3600
      TabIndex        =   9
      Top             =   3600
      Width           =   1695
   End
   Begin VB.Line Line1
      BorderWidth     =   3
      X1              =   120
      X2              =   6000
      Y1              =   1080
      Y2              =   1080
   End
   Begin VB.Label lblLabels
      Alignment       =   2  'Center
      Caption         =   "Select a Table/QueryDef from the list or enter a SQL statement."
      Height          =   195
      Index           =   4
      Left            =   120
      TabIndex        =   15
      Top             =   840
      Width           =   5925
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   "Included Fields: "
      Height          =   195
      Index           =   10
      Left            =   3360
      TabIndex        =   14
      Top             =   1200
      Width           =   1155
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   " Drag/Drop to Change Order "
      Height          =   195
      Index           =   7
      Left            =   3360
      TabIndex        =   13
      Top             =   3300
      Width           =   2070
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   "RecordSource: "
      Height          =   195
      Index           =   6
      Left            =   105
      TabIndex        =   12
      Top             =   540
      Width           =   1125
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   "Available Fields: "
      Height          =   195
      Index           =   3
      Left            =   120
      TabIndex        =   11
      Top             =   1200
      Width           =   1185
   End
   Begin VB.Label lblLabels
      AutoSize        =   -1  'True
      Caption         =   "Form Name (w/o Extension): "
      Height          =   195
      Index           =   0
      Left            =   120
      TabIndex        =   10
      Top             =   120
      Width           =   2055
   End
Attribute VB_Name = "frmDFD"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Dim mrecRS As Recordset
Private Sub cboRecordSource_Change()
  Set mrecRS = Nothing
  lstFields.Clear
  lstIncludedFields.Clear
End Sub
Private Sub cboRecordSource_Click()
  Call cboRecordSource_LostFocus
End Sub
Private Sub cboRecordSource_LostFocus()
  On Error GoTo RSErr
  Dim i As Integer
  Dim fld As Field
  If Len(cboRecordSource.Text) = 0 Then Exit Sub
  Screen.MousePointer = 11
  If mrecRS Is Nothing Then
    Set mrecRS = gdbCurrentDB.OpenRecordset(cboRecordSource.Text)
    For Each fld In mrecRS.Fields
      lstFields.AddItem fld.Name
    Next
  ElseIf mrecRS.Name <> cboRecordSource.Text Then
    lstFields.Clear
    lstIncludedFields.Clear
    Set mrecRS = gdbCurrentDB.OpenRecordset(cboRecordSource.Text)
    For Each fld In mrecRS.Fields
      lstFields.AddItem fld.Name
    Next
  End If
  Screen.MousePointer = 0
  Exit Sub
RSErr:
  Screen.MousePointer = 0
  MsgBox Error$
  Exit Sub
End Sub
Sub cmdBuildForm_Click()
  If Len(txtFormName.Text) = 0 Then
    MsgBox "Form Name cannot be blank!", 16
    txtFormName.SetFocus
    Exit Sub
  End If
  If Len(cboRecordSource.Text) = 0 Then
    MsgBox "You must enter a RecordSource!", 16
    Exit Sub
  End If
  If lstIncludedFields.ListCount = 0 Then
    MsgBox "You must include some Columns!", 16
    Exit Sub
  End If
  If chkOnScreen.Value = vbChecked Then
    BuildFormOnScreen
  Else
    BuildFormFile
  End If
End Sub
Sub BuildFormOnScreen()
  On Error GoTo BuildErr
  Dim i As Integer
  Dim sTmp As String
  Dim nNumFlds As Integer
  Dim frmNewForm As Object
  Dim ctlNewControl As Object
  Dim nButtonTop As Integer
  nNumFlds = lstIncludedFields.ListCount
  lstOLECtls.Clear
  'create the new form
  Set frmNewForm = gobjIDEAppInst.ActiveProject.AddFormTemplate()
  'form height = 320 * numflds + 1260 for buttons and data control
  'form width = 5640
  With frmNewForm
    .Properties!Appearance = 1
    .Properties!Caption = Left(mrecRS.Name, 32)
    .Properties!Height = 1115 + (nNumFlds * 320)
    .Properties!Left = 1050
    .Properties!Name = "frm" & txtFormName.Text
    .Properties!Width = 5640
  End With
  'labels.left = 120, .width = 1815, .height = 255
  'fields.left = 2040, .width = 3375, .height = 285
  For i = 0 To nNumFlds - 1
    sTmp = lstIncludedFields.List(i)
    Set ctlNewControl = frmNewForm.ControlTemplates.Add("Label")
    With ctlNewControl
      .Properties!Appearance = 1
      .Properties!Caption = sTmp & ":"
      .Properties!Height = 255
      .Properties!Index = i
      .Properties!Left = 120
      .Properties!Name = "lblLabels"
      .Properties!Top = (i * 320) + 60
      .Properties!Width = 1815
    End With
    If mrecRS.Fields(sTmp).Type = 1 Then
      'true/false field
      Set ctlNewControl = frmNewForm.ControlTemplates.Add("CheckBox")
      With ctlNewControl
        .Properties!Appearance = 1
        .Properties!Caption = ""
        .Properties!Height = 285
        .Properties!Left = 2040
        .Properties!Name = "chkField" & i
        .Properties!Top = (i * 320) + 40
        .Properties!Width = 3375
        .Properties!DataSource = "Data1"
        .Properties!DataField = sTmp
      End With
    ElseIf mrecRS.Fields(sTmp).Type = 11 Then
      'picture field
      Set ctlNewControl = frmNewForm.ControlTemplates.Add("OLE")
      With ctlNewControl
        .Properties!Height = 285
        .Properties!Left = 2040
        .Properties!Name = "oleField" & i
        .Properties!OLETypeAllowed = 1
        .Properties!Top = (i * 320) + 40
        .Properties!Width = 3375
        .Properties!DataSource = "Data1"
        .Properties!DataField = sTmp
      End With
      SendKeys "{Esc}"
      lstOLECtls.AddItem i
    Else
      Set ctlNewControl = frmNewForm.ControlTemplates.Add("TextBox")
      With ctlNewControl
        .Properties!Appearance = 1
        .Properties!Left = 2040
        .Properties!Name = "txtField" & i
        .Properties!Text = ""
        If mrecRS.Fields(sTmp).Type < 10 Then
          'numeric or date
          .Properties!Width = 1935
        Else
          'string or memo
          .Properties!Width = 3375
        End If
        .Properties!DataSource = "Data1"
        .Properties!DataField = sTmp
        If mrecRS.Fields(sTmp).Type = 10 Then
          .Properties!Height = 285
          .Properties!Top = (i * 320) + 40
          .Properties!MaxLength = mrecRS.Fields(sTmp).Size
        ElseIf mrecRS.Fields(sTmp).Type = 12 Then
          .Properties!Height = 310
          .Properties!Top = (i * 320) + 30
          .Properties!MultiLine = True
          .Properties!ScrollBars = 2
        Else
          .Properties!Height = 285
          .Properties!Top = (i * 320) + 40
        End If
      End With
    End If
  Next
  nButtonTop = ctlNewControl.Properties!Top + 340
  'add the data control and buttons
  Set ctlNewControl = frmNewForm.ControlTemplates.Add("Data")
  With ctlNewControl
    .Properties!Appearance = 1
    .Properties!Align = 2
    .Properties!Caption = ""
    .Properties!DatabaseName = gdbCurrentDB.Name
    .Properties!Connect = gdbCurrentDB.Connect
    .Properties!RecordSource = cboRecordSource.Text
  End With
  Set ctlNewControl = frmNewForm.ControlTemplates.Add("CommandButton")
  With ctlNewControl
    .Properties!Appearance = 1
    .Properties!Caption = "&Add"
    .Properties!Height = 300
    .Properties!Left = 120
    .Properties!Name = "cmdAdd"
    .Properties!Top = nButtonTop
    .Properties!Width = 975
  End With
  Set ctlNewControl = frmNewForm.ControlTemplates.Add("CommandButton")
  With ctlNewControl
    .Properties!Appearance = 1
    .Properties!Caption = "&Delete"
    .Properties!Height = 300
    .Properties!Left = 1200
    .Properties!Name = "cmdDelete"
    .Properties!Top = nButtonTop
    .Properties!Width = 975
  End With
  Set ctlNewControl = frmNewForm.ControlTemplates.Add("CommandButton")
  With ctlNewControl
    .Properties!Appearance = 1
    .Properties!Caption = "&Refresh"
    .Properties!Height = 300
    .Properties!Left = 2280
    .Properties!Name = "cmdRefresh"
    .Properties!Top = nButtonTop
    .Properties!Width = 975
  End With
  Set ctlNewControl = frmNewForm.ControlTemplates.Add("CommandButton")
  With ctlNewControl
    .Properties!Appearance = 1
    .Properties!Caption = "&Update"
    .Properties!Height = 300
    .Properties!Left = 3360
    .Properties!Name = "cmdUpdate"
    .Properties!Top = nButtonTop
    .Properties!Width = 975
  End With
  Set ctlNewControl = frmNewForm.ControlTemplates.Add("CommandButton")
  With ctlNewControl
    .Properties!Appearance = 1
    .Properties!Caption = "&Close"
    .Properties!Height = 300
    .Properties!Left = 4440
    .Properties!Name = "cmdClose"
    .Properties!Top = nButtonTop
    .Properties!Width = 975
  End With
  'add the code to the form
  Dim fh As Integer
  fh = FreeFile
  Open App.Path & "\DFD_FRM.MOD" For Output As fh
  WriteFrmCode fh
  Close fh
  frmNewForm.InsertFile App.Path & "\DFD_FRM.MOD"
  Kill App.Path & "\DFD_FRM.MOD"
  'save the new form
  gobjIDEAppInst.ActiveProject.SelectedComponents(0).SaveAs (gobjIDEAppInst.LastUsedPath & "\" & txtFormName & ".FRM")
  'set the form back to defaults
  txtFormName.Text = ""
  cboRecordSource.Text = ""
  'try to set focus back to the form
  Me.SetFocus
  txtFormName.SetFocus
  Exit Sub
BuildErr:
  MsgBox Error$
  Exit Sub
End Sub
Sub cmdClose_Click()
  Unload Me
End Sub
Private Sub cmdMoveFields_Click(Index As Integer)
  Dim i As Integer
  Select Case Index
    Case 0
      For i = 0 To lstFields.ListCount - 1
        lstIncludedFields.AddItem lstFields.List(i)
      Next
      lstFields.Clear
    Case 1
      If lstFields.ListIndex = -1 Then Exit Sub
      For i = lstFields.ListCount - 1 To 0 Step -1
        If lstFields.Selected(i) = True Then
          lstIncludedFields.AddItem lstFields.List(i)
          lstFields.RemoveItem i
        End If
      Next
    Case 2
      If lstIncludedFields.ListIndex = -1 Then Exit Sub
      For i = lstIncludedFields.ListCount - 1 To 0 Step -1
        If lstIncludedFields.Selected(i) = True Then
          lstFields.AddItem lstIncludedFields.List(i)
          lstIncludedFields.RemoveItem i
        End If
      Next
    Case 3
      For i = 0 To lstIncludedFields.ListCount - 1
        lstFields.AddItem lstIncludedFields.List(i)
      Next
      lstIncludedFields.Clear
  End Select
End Sub
Sub Form_Load()
  CenterMe Me, gnMDIFORM
  GetTableList cboRecordSource, True, False, True
End Sub
Sub lstIncludedFields_DragDrop(Source As Control, x As Single, Y As Single)
  Dim sTmp As String
  Dim nPos As Integer
  If Source = lstIncludedFields Then
    If lstIncludedFields.ListIndex >= 0 Then
      sTmp = lstIncludedFields.List(lstIncludedFields.ListIndex)
      nPos = (Y / TextHeight(sTmp)) + lstIncludedFields.TopIndex
      'check for the last item
      If nPos > lstIncludedFields.ListCount Then
        nPos = lstIncludedFields.ListCount
      End If
      lstIncludedFields.AddItem sTmp, nPos
      If lstIncludedFields.ListIndex > nPos Then
        lstIncludedFields.RemoveItem lstIncludedFields.ListIndex + 1
      Else
        lstIncludedFields.RemoveItem lstIncludedFields.ListIndex
      End If
    End If
    Source.MousePointer = 0
  End If
End Sub
Private Sub lstIncludedFields_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)
  If Button = 1 Then lstIncludedFields.Drag
End Sub
Function StripFileName(rsFileName As String) As String
  On Error Resume Next
  Dim i As Integer
  For i = Len(rsFileName) To 1 Step -1
    If Mid(rsFileName, i, 1) = "\" Then
      Exit For
    End If
  Next
  StripFileName = Mid(rsFileName, 1, i - 1)
End Function
Sub BuildFormFile()
  On Error GoTo BuildFErr
  Dim i As Integer
  Dim sTmp As String
  Dim nNumFlds As Integer
  Dim frmNewForm As Object
  Dim ctlNewControl As Object
  Dim nButtonTop As Integer
  'create and open the file
  Dim nFileHnd As Integer
  nFileHnd = FreeFile
  Open gobjIDEAppInst.LastUsedPath & "\" & txtFormName & ".FRM" For Output As nFileHnd
  Print #nFileHnd, "VERSION 4.00"
  nNumFlds = lstIncludedFields.ListCount
  lstOLECtls.Clear
  Print #nFileHnd, "Begin VB.Form frm" & txtFormName.Text
  'form height = 320 * numflds + 1260 for buttons and data control
  'form width = 5640
  Print #nFileHnd, "   Caption = """ & Left(mrecRS.Name, 32) & """"
  Print #nFileHnd, "   Height       = " & 1115 + (nNumFlds * 320)
  Print #nFileHnd, "   Left         = 2400"
  Print #nFileHnd, "   Top          = 2040"
  Print #nFileHnd, "   Width        = 5640"
  'labels.left = 120, .width = 1815, .height = 255
  'fields.left = 2040, .width = 3375, .height = 285
  For i = 0 To nNumFlds - 1
    sTmp = lstIncludedFields.List(i)
    Print #nFileHnd, "   Begin VB.Label lblLabels"
    Print #nFileHnd, "      Caption = """ & sTmp & ":"""
    Print #nFileHnd, "      Height  = 255"
    Print #nFileHnd, "      Index   = " & i
    Print #nFileHnd, "      Left    = 120"
    Print #nFileHnd, "      Top     = " & (i * 320) + 60
    Print #nFileHnd, "      Width   = 1815"
    Print #nFileHnd, "   End"
    If mrecRS.Fields(sTmp).Type = 1 Then
      'true/false field
      Print #nFileHnd, "   Begin VB.CheckBox chkField" & i
      Print #nFileHnd, "      DataField  = """ & sTmp & """"
      Print #nFileHnd, "      DataSource = ""Data1"""
      Print #nFileHnd, "      Height     = 285"
      Print #nFileHnd, "      Index      = " & i
      Print #nFileHnd, "      Left       = 2040"
      Print #nFileHnd, "      Top        = " & (i * 320) + 40
      Print #nFileHnd, "      Width      = 3375"
      Print #nFileHnd, "   End"
    ElseIf mrecRS.Fields(sTmp).Type = 11 Then
      'picture field
      Print #nFileHnd, "   Begin VB.OLE oleField" & i
      Print #nFileHnd, "      DataField      = """ & sTmp & """"
      Print #nFileHnd, "      DataSource     = ""Data1"""
      Print #nFileHnd, "      Height         = 285"
      Print #nFileHnd, "      Left           = 2040"
      Print #nFileHnd, "      OLETypeAllowed = 1"
      Print #nFileHnd, "      Top            = " & (i * 320) + 40
      Print #nFileHnd, "      Width          = 3375"
      Print #nFileHnd, "   End"
      lstOLECtls.AddItem i
    Else
      Print #nFileHnd, "   Begin VB.TextBox txtField" & i
      Print #nFileHnd, "      DataField  = """ & sTmp & """"
      Print #nFileHnd, "      DataSource = ""Data1"""
      If mrecRS.Fields(sTmp).Type = 12 Then
        Print #nFileHnd, "      Height     = 310"
      Else
        Print #nFileHnd, "      Height     = 285"
      End If
      Print #nFileHnd, "      Index      = " & i
      Print #nFileHnd, "      Left       = 2040"
      If mrecRS.Fields(sTmp).Type = 10 Then
        Print #nFileHnd, "      MaxLength   = " & mrecRS.Fields(sTmp).Size
      End If
      If mrecRS.Fields(sTmp).Type = 12 Then
        Print #nFileHnd, "      MultiLine   = True"
      End If
      If mrecRS.Fields(sTmp).Type = 12 Then
        Print #nFileHnd, "      ScrollBars  = 2"
      End If
      Print #nFileHnd, "      Top        = " & (i * 320) + 40
      Print #nFileHnd, "      Text       = """""
      If mrecRS.Fields(sTmp).Type < 10 Then
        'numeric or date
        Print #nFileHnd, "      Width      = 1935"
      Else
        'string or memo
        Print #nFileHnd, "      Width      = 3375"
      End If
      Print #nFileHnd, "   End"
    End If
  Next
  nButtonTop = (((i - 1) * 320) + 40) + 340
  'add the data control and buttons
  Print #nFileHnd, "   Begin VB.Data Data1"
  Print #nFileHnd, "      Align        = 2"
  Print #nFileHnd, "      Caption      = """""
  Print #nFileHnd, "      Connect      = """ & gdbCurrentDB.Connect & """"
  Print #nFileHnd, "      DatabaseName = """ & gdbCurrentDB.Name & """"
  Print #nFileHnd, "      RecordSource = """ & cboRecordSource.Text & """"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdAdd"
  Print #nFileHnd, "      Caption      = ""&Add"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 120"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdDelete"
  Print #nFileHnd, "      Caption      = ""&Delete"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 1200"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdRefresh"
  Print #nFileHnd, "      Caption      = ""&Refresh"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 2280"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdUpdate"
  Print #nFileHnd, "      Caption      = ""&Update"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 3360"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "   Begin VB.CommandButton cmdClose"
  Print #nFileHnd, "      Caption      = ""&Close"""
  Print #nFileHnd, "      Height       = 300"
  Print #nFileHnd, "      Left         = 4440"
  Print #nFileHnd, "      Top          = " & nButtonTop
  Print #nFileHnd, "      Width        = 975"
  Print #nFileHnd, "   End"
  Print #nFileHnd, "End"
  Print #nFileHnd, ""
  Print #nFileHnd, "Attribute VB_Name = ""frm" & txtFormName.Text & """"
  Print #nFileHnd, "Attribute VB_Creatable = False"
  Print #nFileHnd, "Attribute VB_Exposed = False"
  Print #nFileHnd, "Option Explicit"
  Print #nFileHnd, ""
  'add the code to the form
  WriteFrmCode nFileHnd
  Close nFileHnd
  'add the new form to the project
  gobjIDEAppInst.ActiveProject.AddFile gobjIDEAppInst.LastUsedPath & "\" & txtFormName & ".FRM"
  'set the form back to defaults
  txtFormName.Text = ""
  cboRecordSource.Text = ""
  'try to set focus back to the form
  Me.SetFocus
  txtFormName.SetFocus
  Exit Sub
BuildFErr:
  MsgBox Error$
  Exit Sub
End Sub
Sub WriteFrmCode(fh As Integer)
  On Error GoTo WCErr
  Dim i As Integer
  Print #fh, "Private Sub cmdAdd_Click()"
  Print #fh, "  Data1.Recordset.AddNew"
  Print #fh, "End Sub"
  Print #fh, ""
  Print #fh, "Private Sub cmdDelete_Click()"
  Print #fh, "  'this may produce an error if you delete the last"
  Print #fh, "  'record or the only record in the recordset"
  Print #fh, "  Data1.Recordset.Delete"
  Print #fh, "  Data1.Recordset.MoveNext"
  Print #fh, "End Sub"
  Print #fh, ""
  Print #fh, "Private Sub cmdRefresh_Click()"
  Print #fh, "  'this is really only needed for multi user apps"
  Print #fh, "  Data1.Refresh"
  Print #fh, "End Sub"
  Print #fh, ""
  Print #fh, "Private Sub cmdUpdate_Click()"
  Print #fh, "  Data1.UpdateRecord"
  Print #fh, "  Data1.Recordset.Bookmark = Data1.Recordset.LastModified"
  Print #fh, "End Sub"
  Print #fh, ""
  Print #fh, "Private Sub cmdClose_Click()"
  Print #fh, "  Unload Me"
  Print #fh, "End Sub"
  Print #fh, ""
  Print #fh, "Private Sub Data1_Error(DataErr As Integer, Response As Integer)"
  Print #fh, "  'This is where you would put error handling code"
  Print #fh, "  'If you want to ignore errors, comment out the next line"
  Print #fh, "  'If you want to trap them, add code here to handle them"
  Print #fh, "  MsgBox ""Data error event hit err:"" & Error$(DataErr)"
  Print #fh, "  Response = 0  'throw away the error"
  Print #fh, "End Sub"
  Print #fh, ""
  Print #fh, "Private Sub Data1_Reposition()"
  Print #fh, "  Screen.MousePointer = vbDefault"
  Print #fh, "  On Error Resume Next"
  Print #fh, "  'This will display the current record position"
  Print #fh, "  'for dynasets and snapshots"
  Print #fh, "  Data1.Caption = ""Record: "" & (Data1.Recordset.AbsolutePosition + 1)"
  Print #fh, "  'for the table object you must set the index property when"
  Print #fh, "  'the recordset gets created and use the following line"
  Print #fh, "  'Data1.Caption = ""Record: "" & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1"
  Print #fh, "End Sub"
  Print #fh, ""
  Print #fh, "Private Sub Data1_Validate(Action As Integer, Save As Integer)"
  Print #fh, "  'This is where you put validation code"
  Print #fh, "  'This event gets called when the following actions occur"
  Print #fh, "  Select Case Action"
  Print #fh, "    Case vbDataActionMoveFirst"
  Print #fh, "    Case vbDataActionMovePrevious"
  Print #fh, "    Case vbDataActionMoveNext"
  Print #fh, "    Case vbDataActionMoveLast"
  Print #fh, "    Case vbDataActionAddNew"
  Print #fh, "    Case vbDataActionUpdate"
  Print #fh, "    Case vbDataActionDelete"
  Print #fh, "    Case vbDataActionFind"
  Print #fh, "    Case vbDataActionBookMark"
  Print #fh, "    Case vbDataActionClose"
  Print #fh, "  End Select"
  Print #fh, "  Screen.MousePointer = vbHourglass"
  Print #fh, "End Sub"
  Print #fh, ""
  'write the code for the bound OLE client control(s)
  For i = 0 To frmDFD.lstOLECtls.ListCount - 1
    Print #fh, "Private Sub oleField" & frmDFD.lstOLECtls.List(i) & "_DblClick()"
    Print #fh, "  'this is the way to get data into an empty ole control"
    Print #fh, "  'and have it saved back to the table"
    Print #fh, "  oleField" & frmDFD.lstOLECtls.List(i) & ".InsertObjDlg"
    Print #fh, "End Sub"
    Print #fh, ""
  Next
  Exit Sub
WCErr:
  MsgBox Error$
  Exit Sub
End Sub