VERSION 5.00
Begin VB.Form frmPropDefs 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   " Edit Property Definitions"
   ClientHeight    =   3390
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4095
   Icon            =   "frmPropDefs.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3390
   ScaleWidth      =   4095
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CheckBox chkAdditive 
      Alignment       =   1  'Right Justify
      Caption         =   "Addi&tive"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   225
      Left            =   1245
      TabIndex        =   6
      Top             =   3135
      Width           =   1185
   End
   Begin VB.CommandButton cbOkay 
      Caption         =   "&OK"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   5
      Top             =   2730
      Width           =   1470
   End
   Begin VB.CommandButton cbNew 
      Caption         =   "&Add"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   4
      Top             =   315
      Width           =   1470
   End
   Begin VB.CommandButton cbRename 
      Caption         =   "&Rename"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   3
      Top             =   780
      Width           =   1470
   End
   Begin VB.CommandButton cbDelete 
      Caption         =   "&Delete"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2520
      TabIndex        =   2
      Top             =   1260
      Width           =   1470
   End
   Begin VB.ListBox lbProps 
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FF0000&
      Height          =   2790
      ItemData        =   "frmPropDefs.frx":08CA
      Left            =   120
      List            =   "frmPropDefs.frx":08CC
      Sorted          =   -1  'True
      TabIndex        =   0
      Top             =   300
      Width           =   2310
   End
   Begin VB.Label Label3 
      Caption         =   "Properties"
      BeginProperty Font 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   150
      TabIndex        =   1
      Top             =   60
      Width           =   1125
   End
End
Attribute VB_Name = "frmPropDefs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cbDelete_Click()
    Dim upCount As Long
    Dim cls As infObject
    Dim obj As infObject
    Dim cont As String
    
    If lbProps.Text = "" Then
        MsgBox "Select a property definition to delete.", vbCritical, "Delete PropertyDef"
        Exit Sub
    End If
    
    upCount = 0
    For Each obj In inf.Modules("Main").Objects
        If obj.Properties.Find(lbProps.Text) > 0 Then
            upCount = upCount + 1
        End If
    Next
    For Each cls In inf.Modules("Main").Classes
        If cls.Properties.Find(lbProps.Text) > 0 Then
            upCount = upCount + 1
        End If
    Next

    cont = MsgBox("The property '" & lbProps.Text & "' is being used " & upCount & " times. Do you wish to continue deleting?", vbYesNoCancel, "Delete Property Definition")

    If cont = vbYes Then
        inf.Modules("Main").PropertyDefs.Remove lbProps.Text

        For Each obj In inf.Modules("Main").Objects
            If obj.Properties.Find(lbProps.Text) > 0 Then
                obj.Properties.Remove lbProps.Text
            End If
        Next
        For Each cls In inf.Modules("Main").Classes
            If cls.Properties.Find(lbProps.Text) > 0 Then
                cls.Properties.Remove lbProps.Text
            End If
        Next
        frmMain.cbProps.RemoveItem frmMain.cbProps.FindItemIndex(lbProps.Text, True)
        frmMain.cbProps.ListIndex = -1
        lbProps.RemoveItem lbProps.ListIndex
    End If

End Sub

Private Sub cbNew_Click()
    Dim newprop As String

TryAgain:
    newprop = InputBox("Enter a new property name:", "Add Property Definition")

    If isBlank(newprop) Then
        Exit Sub
    ElseIf Not LCase(Left(newprop, 1)) Like "[a-z]" Then
        MsgBox "Property must begin with A to Z." & vbCrLf & "(case insensitive)", vbExclamation, "New Property"
        Exit Sub
    Else
        For lChar = 1 To Len(newprop)
            sChar = Mid(newprop, lChar, 1)
            If Not sChar Like "[_0-9A-Za-z]" Then
                MsgBox "Property may only contain 0 to 9, underscore, or A to Z." & vbCrLf & "(case insensitive)", vbExclamation, "New Property"
                Exit Sub
            End If
        Next lChar
    End If

    If inf.Modules("Main").PropertyDefs.Find(newprop) > 0 Then
        MsgBox "Property already exists.", vbExclamation, "New Property"
        Exit Sub
    End If

    inf.Modules("Main").PropertyDefs.Add newprop, False

    lbProps.AddItem newprop
    chkAdditive.Value = 0
End Sub

Private Sub cbOkay_Click()
    Unload Me
End Sub

Private Sub cbRename_Click()
    Dim yn As String
    Dim newprop As String
    Dim tempprop As infProperty
    Dim obj As infObject
    Dim cls As infObject

    If lbProps.Text = "" Then
        MsgBox "Select a property definition to rename.", vbCritical, "Delete PropertyDef"
        Exit Sub
    End If
    
    newprop = InputBox("Rename '" & lbProps.Text & "' to:", "Rename Property")

    If isBlank(newprop) Then
        Exit Sub
    ElseIf Not LCase(Left(newprop, 1)) Like "[a-z]" Then
        MsgBox "Property must begin with A to Z." & vbCrLf & "(case insensitive)", vbExclamation, "Rename Property"
        Exit Sub
    Else
        For lChar = 1 To Len(newprop)
            sChar = Mid(newprop, lChar, 1)
            If Not sChar Like "[_0-9A-Za-z]" Then
                MsgBox "Property may only contain 0 to 9, underscore, or A to Z." & vbCrLf & "(case insensitive)", vbExclamation, "Rename Property"
                Exit Sub
            End If
        Next lChar
    End If

    If inf.Modules("Main").PropertyDefs.Find(newprop) > 0 Then
        MsgBox "Property already exists.", vbExclamation, "Rename Property"
        Exit Sub
    End If

    yn = MsgBox("Rename '" & lbProps.Text & "' to '" & newprop & "'?", vbYesNoCancel, "Rename Property")

    If yn = vbYes Then
        inf.Modules("Main").PropertyDefs.Add newprop, inf.Modules("Main").PropertyDefs(lbProps.Text).isAdditive
        Set inf.Modules("Main").PropertyDefs(newprop).Comments = inf.Modules("Main").PropertyDefs(lbProps.Text).Comments
        inf.Modules("Main").PropertyDefs.Remove lbProps.Text

        For Each obj In inf.Modules("Main").Objects
            If obj.Properties.Find(lbProps.Text) > 0 Then
                Set tempprop = obj.Properties(lbProps.Text)
                obj.Properties.Remove lbProps.Text
                obj.Properties.Add newprop, tempprop.Mode, tempprop.Arguments, tempprop.Code, tempprop.isPrivate
            End If
        Next
        For Each cls In inf.Modules("Main").Classes
            If cls.Properties.Find(lbProps.Text) > 0 Then
                Set tempprop = cls.Properties(lbProps.Text)
                cls.Properties.Remove lbProps.Text
                cls.Properties.Add newprop, tempprop.Mode, tempprop.Arguments, tempprop.Code, tempprop.isPrivate
            End If
        Next
        
        frmMain.cbClasses.ListIndex = -1
        frmMain.cbObjects.ListIndex = -1
        frmMain.cbProc.ListIndex = -1
        frmMain.cbProps.ListIndex = -1
        lbProps.Clear
        frmMain.cbProps.Clear
        Form_Load
    End If
End Sub

Private Sub chkAdditive_Click()
    inf.Modules("Main").PropertyDefs(lbProps.Text).isAdditive = Not inf.Modules("Main").PropertyDefs(lbProps.Text).isAdditive
End Sub

Private Sub Form_Load()
    Dim prop As infNameDef

    For Each prop In inf.Modules("Main").PropertyDefs
        lbProps.AddItem prop.Name
    Next
End Sub

Private Sub lbProps_Click()
    If inf.Modules("Main").PropertyDefs(lbProps.Text).isAdditive Then
        chkAdditive.Value = 1
    Else
        chkAdditive.Value = 0
    End If
End Sub