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
            If (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
            If (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