Use Windows.pkg
Use Dfclient.pkg
Use File_dlg.pkg
Use Dfentry.pkg
Use VDFCLS.DD

Object oRegisterCls is a dbModalPanel
    Set Size to 89 211
    Set Label to "Register New Class"
    Set piMinSize to 100 302
    Set Size to 100 302
    Set Location to 4 5
    Set Auto_Clear_DEO_State to False
    //Set Locate_Mode to CENTER_ON_PANEL
    Set piMaxSize To 100 4000

    Property String psClass

    Object oOpenBitmapDialog is a OpenDialog
        Set Filter_String to ;
        'Bitmaps|*.bmp|All Files|*.*'
        Set ShowFileTitle_State to True
    End_Object  // oOpenBitmapDialog

    Object Vdfcls_DD is a Vdfcls_DataDictionary
        Procedure item_find Integer iMode Integer idbFile Integer idbField Integer iUpd Integer iErrs Integer iDeferred
            Forward Send item_find iMode idbFile idbField iUpd iErrs iDeferred
            Integer iParent iRec
            String  sBaseCls
            Move VDFCls.RecNum                          to iRec
            Get Field_Current_Value Field VDFCls.Parent to iParent
            Clear VDFCls
            Move iParent    to VDFCls.Code
            Find Eq VDFCls by Index.3
            [Found] Move VDFCls.Name    to sBaseCls
            Clear VDFCls
            Move iRec   to VdfCls.RecNum
            Find Eq VDFCls by RecNum
            Set value of (Vdfcls_ParentName(Self)) to sBaseCls
          End_Procedure

          Procedure Clear
              Forward Send Clear
              Set value of (Vdfcls_ParentName(Self)) to ""
          End_Procedure
    End_Object    // Vdfcls_DD

    Set Main_DD to (Vdfcls_DD(Self))
    Set Server to (Vdfcls_DD(Self))

    Object Vdfcls_Name is a dbForm
        Entry_Item Vdfcls.Name
        Set Label to "New Class Name"
        Set Size to 13 210
        Set Location to 10 75
        Set Label_Col_Offset to 2
        Set Label_Justification_Mode to jMode_Right
        Set peAnchors to anTopLeftRight
    End_Object    // Vdfcls_Name
    Object Vdfcls_Parent is a dbForm
        Entry_Item Vdfcls.Parent
        Set Size to 13 10 //13 208
        Set Location to -5 -5
        Set visible_state       to False
        Set Focus_Mode to NonFocusAble
    End_Object    // Vdfcls_Name

    Object Vdfcls_ParentName is a dbForm
        Set Label to "Superclass"
        Set Size to 13 210
        Set Location to 26 75
        Set Label_Col_Offset to 2
        Set Label_Justification_Mode to jMode_Right
        Set Prompt_Object item 0 to (VDFCLS_SL(Self))
        Set peAnchors to anTopLeftRight
        Procedure onChange
            Clear VDFCls
            Move (Value(Self,0))    to VDFCls.Name
            Find Eq VDFCls by Index.1
            [Found] Begin
                Set value of (Vdfcls_Bitmap(Self)) to VDFCls.Bitmap
                Set Item_Changed_State of (Vdfcls_Bitmap(Self)) item 0 to True
                Set value of (Vdfcls_Parent(Self)) to VDFCls.Code
                Set Item_Changed_State of (Vdfcls_Parent(Self)) item 0 to True
            End
        End_Procedure

    End_Object    // Vdfcls_Parent

    Object Vdfcls_Bitmap is a dbForm
        Entry_Item Vdfcls.Bitmap
        Set Label to "Bitmap"
        Set Size to 13 194
        Set Location to 42 75
        Set Label_Col_Offset to 2
        Set Label_Justification_Mode to jMode_Right
        Set peAnchors to anTopLeftRight
        Procedure OnChange
            String sFile
            Integer iRet
            Get value item 0                to sFile
            Get_File_Path sFile             to sFile
            File_Exist sFile                   iRet
            If not iRet Move "NoBmp.bmp"    to sFile
            Set Bitmap of (oBmpShow(Self))  to sFile
        End_Procedure

        Set Prompt_Object item 0            to (oOpenBitmapDialog(Self))

        // **WvA: Added the prompt-part so you can select the bitmap.
        Procedure prompt
          Boolean bOk
          String  sFileName
          Handle  hoOpenBitmapDialog

          Move (oOpenBitmapDialog(Self)) to hoOpenBitmapDialog
          Get Show_Dialog of hoOpenBitmapDialog to bOk
          If (bOk) Begin
            // File_Title is Eq to the selected File_Name without the path
            Get File_Title of hoOpenBitmapDialog to sFileName
            Set Value              item 0 to sFileName
            Set Item_Changed_State item 0 to True
          End
        End_Procedure // Prompt
    End_Object    // Vdfcls_Bitmap


    Object oBmpShow is a TextBox
        Set auto_size_state to False
        Set Location to 42 273
        Set Size            to 13 13
        Set Border_Style    to Border_StaticEdge
        Set peAnchors to anTopRight
    End_Object

    Object oOK_Btn is a Button
        Set Label    to "&OK"
        Set Location to 80 182
        Set peAnchors To anBottomRight
        Procedure OnClick
            Send Ready
        End_Procedure
    End_Object

    Object oCancel_Btn is a Button
        Set Label    to "&Cancel"
        Set Location to 80 237
        Set peAnchors to anBottomRight

        Procedure OnClick
            Send Finish
        End_Procedure

    End_Object

    On_Key Key_Alt+Key_O Send KeyAction of oOK_Btn
    On_Key Key_Alt+Key_C Send KeyAction of oCancel_Btn

    Procedure Popup_Group
        String  sCls
        Integer iClsCode
        Forward Send Popup_Group
        Get psClass    to sCls
        Get VDFCls_Search sCls 0 0 to iClsCode
        Send OpenTH3DB of ghoApplication VDFCLS.File_Number
        Send OpenTH3DB of ghoApplication SYSFILE.File_Number
        If (iClsCode=0) Begin
          Send Clear to (Vdfcls_DD(Self))
          Set  Value of (Vdfcls_Name(Self)) item 0                to sCls
          Set  Item_Changed_State of (Vdfcls_Name(Self)) item 0   to True
        End
        If (iClsCode<>0) Begin
          Move iClsCode To VDFCLS.Code
          Find Eq VDFCLS By Index.3
          Send Find_By_RecNum to (Vdfcls_DD(Self)) VDFCls.File_Number VdfCls.RecNum
          Send Item_Find      to (Vdfcls_DD(Self)) Ge VDFCls.File_Number 0 True False False
        End
    End_Procedure

    Procedure Ready
        Send Request_Save to (Vdfcls_Name(Self))
        Send info_box (_T("Changes saved\nYou have to close and reopen the file to see icons change.", 1579)) (_T("Information", 1580))
        Send Close_Panel
    End_Procedure

    Procedure Close_Panel
      Send CloseTH3DB of ghoApplication VDFCLS.File_Number
      Send CloseTH3DB of ghoApplication SYSFILE.File_Number
      Forward Send Close_Panel
    End_Procedure

    Procedure Finish
        Send Close_Panel
    End_Procedure

    #IFDEF TH_TRANSLATION
    Procedure Translate
        Set Label                                   to gILanguage[1571]
        Set Filter_String   of oOpenBitmapDialog    to gILanguage[1572]
        Set Dialog_Caption  of oOpenBitmapDialog    to gILanguage[1573]
        Set Label           of Vdfcls_Name          to gILanguage[1574]
        Set Label           of Vdfcls_ParentName    to gILanguage[1575]
        Set Label           of Vdfcls_Bitmap        to gILanguage[1576]
        Set Label           of oOK_Btn              to gILanguage[1577]
        Set Label           of oCancel_Btn          to gILanguage[1578]
    End_Procedure
    #ENDIF

    Procedure Activating
        Forward Send Activating
        #IFDEF TH_TRANSLATION
        Send Translate
        #ENDIF
    End_Procedure

End_Object

Procedure Request_RegisterNewClass for Desktop String sCls
    Set psClass of oRegisterCls to sCls
    Send Popup  to oRegisterCls
End_Procedure