//TH-Header
//*****************************************************************************************
// Copyright (c)  2014  KURANT Project
// All rights reserved.
//
// $FileName    : proppage.DG
// $ProjectName : The Hammer 2.0
// $Authors     : Wil van Antwerpen, Michael Kurz, Sergey V. Natarov, Bernhard Ponemayr
// $Created     : 01.25.2014  01:08
// $Type        : LGPL
//
// Contents: Properties Page
//
//*****************************************************************************************
//TH-RevisionStart
//TH-RevisionEnd

// Project Object Structure
//   oPP is a dbModalPanel
//     oCreateObject is a Button
//     oCancel_bn is a Button
//     oObj is a Form
//     Grid1 is a Grid
//       RecnumOfRow is a Array
//       ParameterExists is a Array
//     oCls is a Form
//     oIDE is a CheckBox
//     oCreateClass is a Button
//     oDesc is a Edit
//     oCmt is a Edit
//     oTextBox1 is a Textbox
//     oThis is a CheckBox

// Register all objects
Register_Object Grid1
Register_Object oCancel_bn
Register_Object oCls
Register_Object oCmt
Register_Object oCreateClass
Register_Object oCreateObject
Register_Object oDesc
Register_Object oIDE
Register_Object oObj
Register_Object oPP
Register_Object oTextBox1
Register_Object oThis
Register_Object ParameterExists
Register_Object RecnumOfRow



Use For_All
Use cTHEdit.pkg





Object oPP is a dbModalPanel

    #IF (!@ >= 140)
    Set pbSizeToClientArea to False
    #ENDIF

    Property String  psClass  public ""
    Property Integer pnClass  public ""
    Property String  psSource public ""

    Set Locate_Mode To CENTER_ON_SCREEN

    Set Label to "Class Properties"
    Set Size to 253 376
    Set Location to 8 21




    Object oCreateObject is a Button
        Set Label to "Create &Object"
        Set Location to 214 257


        Register_Object CodeEditorView

        Procedure OnClick
            String sClass sObject sText sSrc sProp
            Integer iIDE
            Move "" to sSrc

            Get psClass Of oPP To sClass
            Get Value Of oObj  To sObject
            Get Checked_State of oIDE To iIDE
            Move (sSrc+"\sObject "+sObject+" is a "+sClass+"\n") To sSrc
            Get Add_Properties iIDE To sProp
            Move (sSrc+sProp+"\tEnd_Object  /"+"/ "+sObject+"\n") to sSrc
            Set psSource to sSrc
            Send Close_Panel
        End_Procedure

        Function Add_Properties Integer iIDE Returns String
            Integer iRows iRow iBase iRec
            String sProp sVal sVal1 sVal2 sVal3 sTemp sRet
            Get Item_Count Of (RecnumOfRow(Grid1(Self))) To iRows

            Move "" to sRet
            Move (sRet+"\t    \n") to sRet

            If (iIDE) Begin
                Move (sRet+"\t    /"+"/AB-StoreTopStart\n")  to sRet
                Move (sRet+"\t    /"+"/ Enter your extra code here before IDE source\n\n") to sRet
                Move (sRet+"\t    /"+"/AB-StoreTopEnd\n\n")  to sRet

                Move (sRet+"\t    /"+"/AB-StoreStart\n")  to sRet
                Move (sRet+"\t    /"+"/ To overwrite IDE settings after IDE generated source\n\n")  to sRet
            End

            For iRow From 1 To iRows

                Get Value Of (RecnumOfRow(Grid1(Self))) Item (iRow-1) To iRec
                Clear ASDB
                Move iRec To ASDB.RECNUM
                Find Eq ASDB by Recnum
        //
                If (found) Move (Trim(ASDB.SETCODE)) To sTemp
        //
                Move ((iRow*4)-4) To iBase
                Get Value Of (Grid1(Self)) Item iBase To sProp
                Get Value Of (Grid1(Self)) Item (iBase+1) To sVal1
                Get Value Of (Grid1(Self)) Item (iBase+2) To sVal2
                Get Value Of (Grid1(Self)) Item (iBase+3) To sVal3
        //
                If (sTemp<>"") Begin
                    Replace "{Par1}" In sTemp with sVal1
                    Replace "{Par2}" In sTemp with sVal2
                    Replace "{Par3}" In sTemp with sVal3
                    Move "" To sVal
                    Move (Trim(sVal1+" "+sVal2+" "+sVal3)) To sVal
        //
                    If "{" In sTemp Begin
                        If (sVal<>"") Move (sRet+"\t    /"+"/ "+sTemp+"\n") to sRet
                    End
                    Else If (sVal<>"") Move (sRet+"\t    "+sTemp+"\n") to sRet
                End
                Else Begin
                    If "{" In sVal Begin
                        If (sVal1<>"") Move (sRet+"\t    /"+"/ Set "+sProp+" to "+sVal+"\n") to sRet
                    End
                    Else If (sVal1<>"") Move (sRet+"\t    Set "+sProp+" to "+sVal+"\n") to sRet
                End
            Loop

            If (iIDE) Begin
                Move (sRet+"\t    /"+"/AB-StoreEnd\n\n") to sRet
            End
            Function_Return sRet
        End_Procedure

        Procedure OnResize
            Integer cyx cyxb

            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb

            Set GUILocation To (hi(cyx)-hi(GUISize(self))-38) (low(cyx)-Low(GUISize(Self))-100)

        End_Procedure

    End_Object    // oCreateObject

    Object oCancel_bn is a Button
        Set Label to "&Cancel"
        Set Location to 214 317


        Procedure OnClick
            Send Close_Panel
        End_Procedure

        Procedure OnResize
            Integer cyx cyxb

            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb

            Set GUILocation To (hi(cyx)-hi(GUISize(self))-38) (low(cyx)-Low(GUISize(Self))-12)

        End_Procedure

    End_Object    // oCancel_bn

    Object oObj is a Form

        Property Integer piLabelGuiLocationY    Public 0
        Property Integer piLabelGuiLocationX    Public 0

        Set Label to "Please, choose object/class name:"
        Set Size to 13 244
        Set Location to 4 123
        Set Label_Col_Offset to 2
        Set Label_Justification_Mode to jMode_Right


        Procedure Locate_Label
            Integer obj
            Get Label_object To obj
            Forward Send Locate_Label
            If (obj>0) Begin
                If ((Hi(GuiLocation(Label_Object(Self))) <> 0) and (Low(GuiLocation(Label_Object(Self))) <> 0)) Begin
                    Set piLabelGuiLocationY  To (Hi (GuiLocation(Label_Object(Self))))
                    Set piLabelGuiLocationX  To (Low(GuiLocation(Label_Object(Self))))
                End
            End
        End_Procedure // Locate_label

        Procedure MoveLabel
            If Not (Label_Object(Self)) Procedure_Return
            Set guiLocation Of (Label_Object(Self)) To (piLabelGuiLocationY(Self)) (piLabelGuiLocationX(Self))
        End_Procedure

        Procedure OnResize
            Integer cyx cyxb

            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb

            Integer iGuiLocYOld iGuiLocXOld
            Integer iGuiLocY iGuiLocX
            Move (Hi (GuiLocation(Self)))    To iGuiLocYOld
            Move (Low(GuiLocation(Self)))    To iGuiLocXOld

            Set GUISize To (hi(GUISize(Self))) (low(cyx)-low(GUILocation(Self))-12)

            Move (Hi (GuiLocation(Self)))    To iGuiLocY
            Move (Low(GuiLocation(Self)))    To iGuiLocX

            Send MoveLabel //(iGuiLocY-iGuiLocYOld) (iGuiLocX-iGuiLocXOld)

        End_Procedure

    End_Object    // oObj

    Object Grid1 is a Grid

        Property Integer peResizeColumn public 3
        Property Integer piResizeColumn public 1
        Property Integer piLastResizedColumn  public 0

        Set Select_Mode To NO_SELECT
        On_Key KEY_F4    Send Prompt
        On_Key KEY_Enter Send pValueList

        Object RecnumOfRow Is an Array
        End_Object

        Object ParameterExists Is an Array
        End_Object


        Set CurrentRowColor to 16774636
        Set CurrentRowTextColor to clBlack
        Set Size to 121 365
        Set Location to 62 3
        Set Highlight_Row_state to TRUE

        Set Line_Width to 4 0

        Set Form_Width    item 0 to 94
        Set Header_Label  item 0 to "Property"

        Set Form_Width    item 1 to 114
        Set Header_Label  item 1 to "Parameters: 1 (or item no.)"

        Set Form_Width    item 2 to 80
        Set Header_Label  item 2 to "2"

        Set Form_Width    item 3 to 80
        Set Header_Label  item 3 to "3"



        Set Scroll_Bar_Visible_State To FALSE
        Use pval.dg

        Procedure Fill_From_Data_File Integer iCls Integer iThis
            Integer iCnt iPars iFor
            For_All ASDB by Index.3
                Constrain ASDB.VDFCLS Eq iCls
                Constrain ASDB.TYPE   Eq 1
                If (iThis) Constrain ASDB.PCLASS Eq 0
                Do
                Get fNumOfParameters To iPars
                Send Add_Item 0 (Trim(ASDB.NAME))
                Set Entry_State Item (Item_Count(Self)-1) To False
                Set ItemColor   Item (Item_Count(Self)-1) To clBtnFace // (RGB(230,230,230))
                If (ASDB.PCLASS=0) Set ItemTextColor   Item (Item_Count(Self)-1) To clGreen // clBtnFace // (RGB(230,230,230))

                Set Form_FontWeight Item (Item_Count(Self)-1) To 800
                Set Value Of recnumOfRow Item (Item_Count(RecnumOfRow(Self))) To ASDB.RECNUM
                Set Value Of ParameterExists Item (Item_Count(ParameterExists(Self))) To False
                For iFor From 1 To 3
                    Send Add_Item 0 ""
                    If (iFor>iPars) Begin
                        Set Entry_State       Item (Item_Count(Self)-1) To False
                        Set ItemColor   Item (Item_Count(Self)-1) To (RGB(230,230,230))
                        Set Value Of ParameterExists Item (Item_Count(ParameterExists(Self))) To False
                    End
                    Else Begin
                        Set Form_Button       Item (Item_Count(Self)-1) To form_button_prompt
                        Set form_button_Value Item (Item_Count(Self)-1) To " + "
                        Set Value Of ParameterExists Item (Item_Count(ParameterExists(Self))) To True
                    End
                Loop
            End_For_All
        End_Procedure

        Procedure Create_Table
            Integer iCls iThis
            Send Delete_Data
            Send Delete_Data To RecnumOfRow
            Send Delete_Data To ParameterExists
            Get pnClass Of (oPP(Self)) To iCls
            Get Checked_State of (oThis(Self)) To iThis
            Send Fill_From_Data_File iCls iThis
            If ((Not(Item_Count(Self)))and(iThis)) Begin
                Clear VDFCLS
                Move iCls To VDFCLS.Code
                Find Eq VDFCLS by Index.3
                If ((found)and(VDFCLS.PARENT)) Begin
                    Move VDFCLS.PARENT To iCls
                    Send Fill_From_Data_File iCls iThis
                    If ((Not(Item_Count(Self)))and(iThis)) Begin
                        Clear VDFCLS
                        Move iCls To VDFCLS.Code
                        Find Eq VDFCLS by Index.3
                        If ((found)and(VDFCLS.PARENT)) Begin
                            Move VDFCLS.PARENT To iCls
                            Send Fill_From_Data_File iCls iThis
                            If ((Not(Item_Count(Self)))and(iThis)) Begin
                                Clear VDFCLS
                                Move iCls To VDFCLS.Code
                                Find Eq VDFCLS by Index.3
                                If ((found)and(VDFCLS.PARENT)) Begin
                                    Move VDFCLS.PARENT To iCls
                                    Send Fill_From_Data_File iCls iThis
                                    If ((Not(Item_Count(Self)))and(iThis)) Begin
                                        Clear VDFCLS
                                        Move iCls To VDFCLS.Code
                                        Find Eq VDFCLS by Index.3
                                        If ((found)and(VDFCLS.PARENT)) Begin
                                            Move VDFCLS.PARENT To iCls
                                            Send Fill_From_Data_File iCls iThis
                                        End
                                    End
                                End
                            End
                        End
                    End
                End
            End
        End_Procedure

        Procedure form_button_notification Integer iItem Integer iPos
            Send Process_Properties iItem
        End_Procedure

        Procedure Prompt
            Send Process_Properties (Current_Item(Self))
        End_Procedure

        Function IsParameterExists Integer iItem Returns Integer
            Function_Return (Value(ParameterExists(Self),iItem))
        End_Function

        Procedure pValueList
            Integer iCol iExist iWhat
            Get IsParameterExists (Current_Item(Self)) To iExist
            If (iExist) Begin
                Send Process_Properties (Current_Item(Self))

                Get IsParameterExists (Current_Item(Self)+1) To iWhat
                If (iWhat) Send Next
                Else Begin
                    While (Not(iWhat))
                        Get IsParameterExists (Current_Item(Self)+1) To iWhat
                        Send next
                    Loop
                End
            End
            Else Begin
                Get IsParameterExists (Current_Item(Self)+1) To iWhat
                If (iWhat) Send Next
                Else Begin
                    While (Not(iWhat))
                        Get IsParameterExists (Current_Item(Self)+1) To iWhat
                        Send next
                    Loop
                End
            End
        End_Procedure

        Procedure Process_Properties Integer iItem
            String sVal
            Integer iCls iItm iCol iRec
            Integer cxy cx cy hoForm

            Get pnClass Of (oPP(Self)) To iCls

            // Collect information about selected item
            Get Current_Item        To iItm
            Get Current_Column iItm To iCol
            Get Current_Recnum iItm To iRec

            Clear ASDB
            Move iRec To ASDB.RECNUM
            Find Eq ASDB by Recnum
            If (found) Begin
                Get LeftBottomItemGUILocation iItem To cxy
                If (iCol=1) Send PopUp To (oPV(Self)) ASDB.PAR1T (Trim(ASDB.PAR1)) Self iItem (Trim(ASDB.NAME)) cxy
                If (iCol=2) Send PopUp To (oPV(Self)) ASDB.PAR2T (Trim(ASDB.PAR2)) Self iItem (Trim(ASDB.NAME)) cxy
                If (iCol=3) Send PopUp To (oPV(Self)) ASDB.PAR3T (Trim(ASDB.PAR3)) Self iItem (Trim(ASDB.NAME)) cxy
            End
        End_Procedure

        Function fNumOfParameters Returns Integer
            Integer iRet
            Move 0 To iRet
            If ((ASDB.PAR1T>0)And(ASDB.PAR1T<>8)) Increment iRet
            If ((ASDB.PAR2T>0)And(ASDB.PAR2T<>8)) Increment iRet
            If ((ASDB.PAR3T>0)And(ASDB.PAR3T<>8)) Increment iRet
            If ((ASDB.PAR4T>0)And(ASDB.PAR4T<>8)) Increment iRet
            If ((ASDB.PAR5T>0)And(ASDB.PAR5T<>8)) Increment iRet
            Function_Return iRet
        End_Function

        Function Current_Recnum Integer iItem Returns Integer
            Integer iRec iRow
            Move (Integer(iItem/4)) To iRow
            Get Value Of RecnumOfRow Item iRow To iRec
            Function_Return iRec
        End_Function

        procedure item_change integer fromi integer toi returns integer
            integer rval iRec
            String sCls
            forward get msg_item_change fromi toi to rval
            Send Delete_Data To (oDesc(Self))
            Get Current_Recnum rval To irec
            If (iRec) Begin
                Clear ASDB
                Move iRec To ASDB.Recnum
                Find Eq ASDB by recnum
                Move "" to sCls
                if (ASDB.PCLASS=0) Begin
                    Move ASDB.name      To vdfprop.name
                    Move Asdb.vdfcls    To vdfprop.vdfcls
                End
                Else Begin
                    Move ASDB.name      To vdfprop.name
                    Move Asdb.pclass    To vdfprop.vdfcls
                    Move (Uppercase(Trim(ASDB.pclassname))+": ") To sCls
                End
                Find Eq vdfprop by Index.2
                If (found) Begin
                    Set Value of (oDesc(Self)) Item 0 To (sCls+Trim(VDFprop.Descr))
                    Send Beginning_Of_Data To (oDesc(Self))
                End
            End
            procedure_return rval
        end_procedure

        Function Current_Column Integer iItem Returns Integer
            Function_Return (mod(iItem,4))
        End_Function

        Function Base_Item Integer iItem Returns Integer
            Function_Return (iItem-mod(iItem,4))
        End_Function

        Function LeftBottomItemGUILocation Integer iItem Returns Integer
            Integer iLoc
            Integer iRow iCol iItm iFWdth iFHght iSzX iSzY iTopRow  iCols

            Move (low(matrix_size(current_object))) To iCols

            Get Column           iItem To iCol
            Get Current_Item_Row iItem To iRow

            Get Top_Item              To iItm
            Get Current_Item_Row iItm To iTopRow
            Move (iRow-iTopRow) To iRow

            Get Form_GUIWidth    iItem To iFWdth
            Get Form_GUIHeight   iItem To iFHght

            If (iCol>0) Begin
                Move 0 To iSzX
                For iItm From 0 To (iCol-1)
                    Get Form_GUIWidth Item iItm To iFWdth
                    Move (iSzX+iFWdth) To iSzX
                Loop
            End
            Else Move 0 To iSzX

            Move (low(location(Self))+iSzX-mod(iItem,iCols)) To iSzX

            If (iRow>0) Move (iFHght+(iRow*iFHght)-(iRow*3)) To iSzY
            Else Move iFHght To iSzY

            // Header height +1
            Move (iSzY+14) To iSzY

            Function_Return (iSzX+(65536*iSzY))
        End_Function

        Function Current_Item_Row Integer iItem Returns Integer
            Integer iRec iRow iItms
            Move (low(matrix_size(current_object))) To iItms
            Move (Integer(iItem/iItms)) To iRow
            Function_Return iRow
        End_Function

        Procedure OnResize
            Integer cyx cyxb cyxgb cyxga

            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb

            Get Size To cyxgb
                                                          // 60
            Set GUISize To (hi(cyx)-hi(GUILOcation(self))-98) (low(cyx)-Low(GUILocation(Self))-12)
            Send Adjust_Logicals

            Get Size To cyxga

            Send Resize_Columns (low(cyxga)-low(cyxgb))

        End_Procedure

        Procedure Resize_Columns Integer iDelta
            Integer iResizeColumn eResizeColumn
            Integer iCols iCol iColWidth
            Integer i iWidth
            Integer iRemain
            Get peResizeColumn To eResizeColumn
            Get line_size To iCols
            Move (iDelta/iCols) To iColWidth
            Move (abs(mod(iDelta,iCols))) To iRemain
            Get piLastResizedColumn To iCol
            For i From 1 To iCols
                Move (mod(iCol+1,iCols)) To iCol
                Move iColWidth To iWidth
                If (iRemain>0) Begin
                    Move (iWidth + If(iDelta>0,1,-1)) To iWidth
                    Decrement iRemain
                    If (iRemain=0) Set piLastResizedColumn To iCol
                End
                If (iWidth<>0) ;
                Set form_width iCol To (form_width(Self,iCol)+iWidth)
            Loop
        End_Procedure

        Procedure Set line_width Integer iCols Integer iRows
            // This fixes the problem of resize lists and then displaying
            // the wrong Number Of lines...
            Forward Set line_width To iCols (displayable_rows(Self))
        End_Procedure

    End_Object    // Grid1

    Object oCls is a Form

        Property Integer piLabelGuiLocationY    Public 0
        Property Integer piLabelGuiLocationX    Public 0
        Set Enabled_State To False

        Set Label to "Class:"
        Set Size to 13 244
        Set Location to 20 123
        Set Label_Col_Offset to 2
        Set Label_Justification_Mode to jMode_Right


        Procedure Locate_Label
            Integer obj
            Get Label_object To obj
            Forward Send Locate_Label
            If (obj>0) Begin
                If ((Hi(GuiLocation(Label_Object(Self))) <> 0) and (Low(GuiLocation(Label_Object(Self))) <> 0)) Begin
                    Set piLabelGuiLocationY  To (Hi (GuiLocation(Label_Object(Self))))
                    Set piLabelGuiLocationX  To (Low(GuiLocation(Label_Object(Self))))
                End
            End
        End_Procedure // Locate_label

        Procedure MoveLabel
            If Not (Label_Object(Self)) Procedure_Return
            Set guiLocation Of (Label_Object(Self)) To (piLabelGuiLocationY(Self)) (piLabelGuiLocationX(Self))
        End_Procedure

        Procedure OnResize
            Integer cyx cyxb

            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb

            Integer iGuiLocYOld iGuiLocXOld
            Integer iGuiLocY iGuiLocX
            Move (Hi (GuiLocation(Self)))    To iGuiLocYOld
            Move (Low(GuiLocation(Self)))    To iGuiLocXOld

            Set GUISize To (hi(GUISize(Self))) (low(cyx)-low(GUILocation(Self))-12)

            Move (Hi (GuiLocation(Self)))    To iGuiLocY
            Move (Low(GuiLocation(Self)))    To iGuiLocX

            Send MoveLabel

        End_Procedure

    End_Object    // oCls

    Object oIDE is a CheckBox
        Set Label to "Make source IDE compatible"
        Set Size to 10 108
        Set Location to 216 3

        Procedure OnResize
            Integer cyx cyxb
            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb
            Set GUILocation To (hi(cyx)-hi(GUISize(self))-38) (Low(GUILocation(Self)))
        End_Procedure

    End_Object    // oIDE

    Object oCreateClass is a Button
        Set Label to "Create &Class"
        Set Location to 214 197


        Register_Object CodeEditorView

        Procedure OnClick
            String sClass sObject sText sSrc sProp sPref sCmt
            Move "" to sSrc
            Get TextEditValue of oCmt To sCmt
            If (sCmt<>"") Move ("\s"+sSrc+"/"+"/ "+sCmt+"\n") to sSrc
            Get psClass Of oPP To sClass
        //    Get Value Of oObj  To sObject
            Move ("cMy"+sClass) to sObject
            Move (sSrc+"\sClass "+sObject+" is a "+sClass+"\n") To sSrc
            Get Add_Properties To sProp
            Move (sSrc+sProp+"\tEnd_Class  /"+"/ "+sObject+"\n") to sSrc
            Set psSource to sSrc
            Send Close_Panel
        End_Procedure

        Function Add_Properties Returns String
            Integer iRows iRow iBase iRec
            String sProp sVal sVal1 sVal2 sVal3 sTemp sRet
            Get Item_Count Of (RecnumOfRow(Grid1(Self))) To iRows

            Move "" to sRet
            Move (sRet+"\t    \n") to sRet

            Move (sRet+"\t    "+"Procedure Construct_Object\n")  to sRet
            Move (sRet+"\t    "+"    Forward Send Construct_Object\n\n")  to sRet

            For iRow From 1 To iRows

                Get Value Of (RecnumOfRow(Grid1(Self))) Item (iRow-1) To iRec
                Clear ASDB
                Move iRec To ASDB.RECNUM
                Find Eq ASDB by Recnum

                If (found) Move (Trim(ASDB.SETCODE)) To sTemp

                Move ((iRow*4)-4) To iBase
                Get Value Of (Grid1(Self)) Item iBase To sProp
                Get Value Of (Grid1(Self)) Item (iBase+1) To sVal1
                Get Value Of (Grid1(Self)) Item (iBase+2) To sVal2
                Get Value Of (Grid1(Self)) Item (iBase+3) To sVal3

                If (sTemp<>"") Begin
                    Replace "{Par1}" In sTemp with sVal1
                    Replace "{Par2}" In sTemp with sVal2
                    Replace "{Par3}" In sTemp with sVal3
                    Move "" To sVal
                    Move (Trim(sVal1+" "+sVal2+" "+sVal3)) To sVal

                    If "{" In sTemp Begin
                        If (sVal<>"") Move (sRet+"\t        /"+"/ "+sTemp+"\n") to sRet
                    End
                    Else If (sVal<>"") Move (sRet+"\t        "+sTemp+"\n") to sRet
                End
                Else Begin
                    If "{" In sVal Begin
                        If (sVal1<>"") Move (sRet+"\t        /"+"/ Set "+sProp+" to "+sVal+"\n") to sRet
                    End
                    Else If (sVal1<>"") Move (sRet+"\t        Set "+sProp+" to "+sVal+"\n") to sRet
                End
            Loop

            Move (sRet+"\t    "+"End_Procedure\n\n") to sRet

            Function_Return sRet
        End_Procedure

        Procedure OnResize
            Integer cyx cyxb
            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb
            Set GUILocation To (hi(cyx)-hi(GUISize(self))-38) (low(cyx)-Low(GUISize(Self))-190)
        End_Procedure

    End_Object    // oCreateClass

    Object oDesc is a Edit

        Set Read_Only_State To True

        Set Size to 21 366
        Set Location to 188 3
        Set Color to clBtnFace


        Procedure OnResize
            Integer cyx cyxb
            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb
            Set GUILocation To (hi(cyx)-hi(GUISize(self))-60) (low(GUILocation(Self)))
            Set GUISize     To (hi(GUISize(Self))) (low(cyx)-15)
        End_Procedure

    End_Object    // oDesc

    Object oCmt is a cTHEdit
        Set Size to 22 244
        Set Location to 36 123
        Set Label_Col_Offset to 2
        Set Label_Justification_Mode to jMode_Right

        Procedure MoveLabel
        End_Procedure

        Procedure OnResize
            Integer cyx cyxb

            Get GUISize of (oPP(Self)) To cyx
            Get GUISize To cyxb

            Integer iGuiLocYOld iGuiLocXOld
            Integer iGuiLocY iGuiLocX
            Move (Hi (GuiLocation(Self)))    To iGuiLocYOld
            Move (Low(GuiLocation(Self)))    To iGuiLocXOld

            Set GUISize To (hi(GUISize(Self))) (low(cyx)-low(GUILocation(Self))-12)

            Move (Hi (GuiLocation(Self)))    To iGuiLocY
            Move (Low(GuiLocation(Self)))    To iGuiLocX

            Send MoveLabel

        End_Procedure

    End_Object    // oCmt

    Object oTextBox1 is a Textbox
        Set Label to "Optional comments:"
        Set Location to 37 57
        Set Size to 10 63
        Set TypeFace to "MS Sans Serif"
    End_Object    // oTextBox1

    Object oThis is a CheckBox
        Set Label to "This class only"
        Set Size to 10 63
        Set Location to 50 3

        Procedure OnChange
            Integer iState
            Get Dynamic_Update_State of Grid1 To iState
            Set Dynamic_Update_State of Grid1 To False
            Send Create_Table To Grid1
            Set Dynamic_Update_State of Grid1 To iState
        End_Procedure  // OnChange

    End_Object    // oThis



    Procedure PopUp String sCls Integer nCls
        Set psSource To ""
        If (sCls<>"") Begin
            Set psClass To sCls
            Set value Of oObj Item 0 To ("o"+sCls+"1")
            Set value Of oCls Item 0 To sCls
        End
        If (nCls<>0)  Set pnClass To nCls
        Send Create_Table To Grid1
        Forward Send popup
    End_Procedure

    Procedure OnResize
        Broadcast Send OnResize
        Send Adjust_Logicals
    End_Procedure

End_Object    // oPP