VERSION 5.00 Begin VB.Form frmNewClass BorderStyle = 3 'Fixed Dialog Caption = " New Class" ClientHeight = 4020 ClientLeft = 45 ClientTop = 330 ClientWidth = 7905 ClipControls = 0 'False ControlBox = 0 'False Icon = "frmNewClass.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 = 1995 Left = 60 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 2 Top = 1515 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 = 1 Top = 885 Width = 7755 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 = 4 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 = 6840 TabIndex = 3 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 = 9 Top = 675 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 = 8 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 = 7 Top = 1305 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 = 6 Top = 675 Width = 1785 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 = 5 Top = 0 Width = 705 End End Attribute VB_Name = "frmNewClass" 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 frmNewClass ' ' Validate name ' .txtName = Trim(.txtName) If isBlank(.txtName) Then MsgBox "Class Name is a required field.", vbExclamation, "New Class" Exit Sub ElseIf Not LCase(Left(.txtName, 1)) Like "[a-z]" Then MsgBox "Class Name must begin with A to Z." & vbCrLf & "(case insensitive)", vbExclamation, "New Class" Exit Sub Else For lChar = 1 To Len(.txtName) sChar = Mid(.txtName, lChar, 1) If Not sChar Like "[_0-9A-Za-z]" Then MsgBox "Class Name may only contain 0 to 9, underscore, or A to Z." & vbCrLf & "(case insensitive)", vbExclamation, "New Class" 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 Class" Exit Sub End If ' ' These are optional ' sNameProperty = .txtNameProp sDescriptionProperty = .txtDescriptionProp inf.Modules("Main").Classes.Add sName, "", "", "", 0 If Not isBlank(sNameProperty) Then inf.Modules("Main").Classes(sName).Properties.Add "name", infptSTRING_ARRAY, "", sNameProperty, False End If If Not isBlank(sDescriptionProperty) Then inf.Modules("Main").Classes(sName).Properties.Add "description", infptSTRING, "", sDescriptionProperty, False End If frmMain.cbClasses.AddItemAndData sName, , 4, vbBlue, , , , , , , sfClasses frmMain.cbClasses.ItemData(frmMain.cbClasses.NewIndex) = inf.Modules("Main").Classes.Count frmMain.cbClassName.AddItemAndData sName, , 4, vbBlue, , , , , , , sfClasses frmMain.cbClassName.ItemData(frmMain.cbClassName.NewIndex) = inf.Modules("Main").Classes.Count frmMain.cbClasses.ListIndex = frmMain.cbClasses.NewIndex End With Unload Me End Sub