VERSION 5.00 Begin VB.Form frmNewObject BorderStyle = 3 'Fixed Dialog Caption = " New Object" ClientHeight = 4020 ClientLeft = 2175 ClientTop = 2160 ClientWidth = 7905 ClipControls = 0 'False ControlBox = 0 'False Icon = "frmNewObject.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False NegotiateMenus = 0 'False ScaleHeight = 4020 ScaleWidth = 7905 ShowInTaskbar = 0 'False StartUpPosition = 1 'CenterOwner Begin VB.TextBox txtDescriptionProp BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 1380 Left = 60 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 3 Top = 2130 Width = 7755 End Begin VB.TextBox txtNameProp BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 345 Left = 60 TabIndex = 2 Top = 1500 Width = 7755 End Begin VB.TextBox txtShortNameProp BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 345 Left = 60 TabIndex = 1 Top = 870 Width = 7770 End Begin VB.TextBox txtName BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 345 Left = 60 MaxLength = 32 TabIndex = 0 Top = 210 Width = 4530 End Begin VB.CommandButton cbCancel Cancel = -1 'True Caption = "&Cancel" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 5745 TabIndex = 5 Top = 3600 Width = 990 End Begin VB.CommandButton cbOK Caption = "&OK" Default = -1 'True BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 6825 TabIndex = 4 Top = 3600 Width = 990 End Begin VB.Label Label5 Alignment = 1 'Right Justify Caption = "Enter as: 'word1' 'word2' 'word3'" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000C0& Height = 195 Left = 4485 TabIndex = 11 Top = 1290 Width = 3315 End Begin VB.Label Label4 Caption = "(use text only in these fields - no procedure code)" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H000000C0& Height = 195 Left = 60 TabIndex = 10 Top = 3705 Width = 4935 End Begin VB.Label Label3 Caption = "Description (property)" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 75 TabIndex = 9 Top = 1920 Width = 2340 End Begin VB.Label Label2 Caption = "Name (property)" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 75 TabIndex = 8 Top = 1290 Width = 1785 End Begin VB.Label Label1 Caption = "Short Name (property)" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 75 TabIndex = 7 Top = 645 Width = 2355 End Begin VB.Label Label7 Caption = "Name" BeginProperty Font Name = "Verdana" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 195 Left = 75 TabIndex = 6 Top = 0 Width = 705 End End Attribute VB_Name = "frmNewObject" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub cbCancel_Click() Unload Me End Sub Private Sub cbOk_Click() Dim sName As String Dim sShortNameProperty As String Dim sNameProperty As String Dim sDescriptionProperty As String Dim lChar As Long Dim sChar As String With frmNewObject ' ' Validate name ' .txtName = Trim(.txtName) If isBlank(.txtName) Then MsgBox "Object Name is a required field.", vbExclamation, "New Object" Exit Sub ElseIf Not LCase(Left(.txtName, 1)) Like "[a-z]" Then MsgBox "Object Name must begin with A to Z." & vbCrLf & "(case insensitive)", vbExclamation, "New Object" Exit Sub Else For lChar = 1 To Len(.txtName) sChar = Mid(.txtName, lChar, 1) If Not sChar Like "[_0-9A-Za-z]" Then MsgBox "Object Name may only contain 0 to 9, underscore, or A to Z." & vbCrLf & "(case insensitive)", vbExclamation, "New Object" Exit Sub End If Next lChar End If sName = .txtName If inf.Modules("Main").Classes.Find(sName) > 0 Or _ inf.Modules("Main").Objects.Find(sName) > 0 Or _ inf.Modules("Main").Procedures.Find(sName) > 0 Then MsgBox "Name already exists.", vbExclamation, "New Object" Exit Sub End If ' ' These are optional ' sShortNameProperty = .txtShortNameProp sNameProperty = .txtNameProp sDescriptionProperty = .txtDescriptionProp inf.Modules("Main").Objects.Add sName, "", "", "", 0 If Not isBlank(sShortNameProperty) Then inf.Modules("Main").Objects(sName).ShortName = sShortNameProperty End If If Not isBlank(sNameProperty) Then inf.Modules("Main").Objects(sName).Properties.Add "name", infptSTRING_ARRAY, "", sNameProperty, False End If If Not isBlank(sDescriptionProperty) Then inf.Modules("Main").Objects(sName).Properties.Add "description", infptSTRING, "", sDescriptionProperty, False End If frmMain.cbObjects.AddItemAndData sName, , 4, vbBlue, , , , , , , sfObjects frmMain.cbObjects.ItemData(frmMain.cbObjects.NewIndex) = inf.Modules("Main").Objects.Count frmMain.cbParentName.AddItemAndData sName, , 4, vbBlue, , , , , , , sfObjects frmMain.cbParentName.ItemData(frmMain.cbParentName.NewIndex) = inf.Modules("Main").Objects.Count frmMain.cbObjects.ListIndex = frmMain.cbObjects.NewIndex End With Unload Me End Sub