// Use fvWebFormDesigner.vw // Web form designer

Use WebForm.nui // cWebForm class
Use DBMS.nui     // Basic DBMS functions (No User Interface)
Use HTML.utl     // HTML functions
Use DDCreate.nui // Create generic DDO structures (using global FDX object)
Use FdxSelct.utl // Functions iFdxSelectOneFile and iFdxSelectOneField
Use FdxUiCls.pkg // UI classes for displaying FDX data
Use WebAppXhtmlBuilder.nui // Global procedures for writing XHTML

object oWebFormPrototyper is a cWebForm
  property integer phCurrentFieldSet
  procedure DoAddFieldSet string lsLabel integer liLocation
    integer lhObj
    object oFieldSet is a cWebFormFieldSet
      if (lsLabel<>"") set psLegend to lsLabel
      move self to lhObj
    end_object
    set phCurrentFieldSet to lhObj
  end_procedure

  procedure DoAddTopBar
    object oTop is a cWebFormButtonBar
      send DoAddFindButtons
    end_object
  end_procedure
  procedure DoAddBottomBar
    object oTop is a cWebFormButtonBar
      send DoAddEditButtons
    end_object
  end_procedure

  procedure DoAddFieldSpecial integer liFile integer liField string lsLabel integer liInputType integer liLocation
    integer lhFieldSet
    if (phCurrentFieldSet(self)=0) send DoAddFieldSet "Missing field set" 0
    get phCurrentFieldSet to lhFieldSet
    send DoAddDBfield of lhFieldSet liFile liField liInputType liLocation
    if (lsLabel<>"") set current_input_attribute of lhFieldSet WFIP_LABEL to lsLabel
  end_procedure

  procedure DoReset
    forward send DoReset
    set phCurrentFieldSet to 0
  end_procedure

  procedure DoWriteFile string lsFileName
    send XHTML_SetOutputFile lsFileName
    send XHTML_StartXhtml
    send XHTML_OpeningOath
    send XHTML_Add_Open_Element "html"
    send XHTML_Add_Open_Element "head"
    send XHTML_Close_Element // head
    send XHTML_Add_Open_Element "body"
    send DoWriteHtml
    send XHTML_Close_Element // body
    send XHTML_Close_Element // html
    send XHTML_EndXhtml
  end_procedure
end_object

activate_view Activate_WebFormPrototyper for oWebFormPrototyper_Vw
object oWebFormPrototyper_Vw is a aps.View label "Web Form Prototyper"
  property integer piFieldSetCounter public 0
  property integer piMainFile        public 0
  on_key kCancel send close_panel

  object oFieldSelector is a Fdx.TreeViewFieldSelector
    set size to 300 200
    set pbExcludeOverlaps to true
    set pbExcludeRelatingFields to true
//    set pbExcludeAllFields to true
    procedure OnFieldSelect integer liFile integer liField
      send DoAddField liFile liField
    end_procedure
  end_object
  object oGrid is a aps.Grid snap SL_RIGHT
    set size to 300 0
    send GridPrepare_AddColumn "Field"     AFT_ASCII25
    send GridPrepare_AddColumn "Label"     AFT_ASCII20
    send GridPrepare_AddColumn "InputType" AFT_ASCII10
    send GridPrepare_AddColumn "Location"  AFT_ASCII5
    send GridPrepare_Apply self
    set select_mode to NO_SELECT
    on_key KNEXT_ITEM send switch
    on_key KPREVIOUS_ITEM send switch_back
    function iFindField.ii integer liFile integer liField returns integer
      integer liRow liMax liBase
      get Grid_RowCount self to liMax
      decrement liMax
      for liRow from 0 to liMax
        get Grid_RowBaseItem self liRow to liBase
        if (aux_value(self,liBase)=liFile and aux_value(self,liBase+1)=liField) function_return liRow
      loop
      function_return -1
    end_function
    function iAddRow returns integer
      integer liRow liMax liBase
      get Grid_RowCount self to liMax
      get Grid_CurrentRow self to liRow
      if (liRow=(liMax-1)) begin // This means add
        get Grid_AppendRow self to liRow
      end
      else begin // This means insert
        get Grid_InsertRow self liRow to liRow
      end
      get Grid_RowBaseItem self liRow to liBase
      set current_item to liBase
      function_return liBase
    end_function
    procedure DoAddFieldSet
      integer liBase liCount
      get piFieldSetCounter to liCount
      increment liCount
      set piFieldSetCounter to liCount
      get iAddRow to liBase
      set value item (liBase+0) to "--- field set ---"
      set value item (liBase+1) to ("FieldSet "+string(liCount))
      set value item (liBase+2) to ""
      set value item (liBase+3) to ""
      set entry_state item (liBase+0) to false
      set entry_state item (liBase+1) to true
      set entry_state item (liBase+2) to false
      set entry_state item (liBase+3) to false
    end_procedure
    procedure DoAddField integer liFile integer liField
      integer liRow liBase
      string lsName
      get iFindField.ii liFile liField to liRow
      if (liRow=-1) begin
        get iAddRow to liBase
        set value item (liBase+0) to (lowercase(FDX_FieldName(ghFdx,liFile,liField,true)))
        get FDX_FieldName ghFdx liFile liField false to lsName
        move (replaces("_",lsName," ")) to lsName
        get StringUppercaseFirstLetters lsName to lsName
        set value item (liBase+1) to lsName
//      set value item (liBase+1) to (FieldInf_FieldLabel_Long(liFile,liField))
        set value item (liBase+2) to "Auto"
        set value item (liBase+3) to "New row"
        set aux_value item (liBase+0) to liFile
        set aux_value item (liBase+1) to liField
        set entry_state item (liBase+0) to false
        set entry_state item (liBase+1) to true
        set entry_state item (liBase+2) to false
        set entry_state item (liBase+3) to false
      end
      else send obs "Field already used"
    end_procedure
    procedure DoPreview
      integer lhForm liMax liRow liBase liFile liField liInputType liLocation
      string lsLabel
      move oWebFormPrototyper to lhForm
      send DoReset of lhForm

      send DoAddTopBar of lhForm

      get Grid_RowCount self to liMax
      decrement liMax
      for liRow from 0 to liMax
        get Grid_RowBaseItem self liRow to liBase
        get aux_value item liBase to liFile
        get aux_value item (liBase+1) to liField
        get value item (liBase+1) to lsLabel
        get aux_value item (liBase+2) to liInputType
        get aux_value item (liBase+3) to liLocation
        if (liFile=0) send DoAddFieldSet of lhForm lsLabel liLocation
        else send DoAddFieldSpecial of lhForm liFile liField lsLabel liInputType liLocation
      loop
      send DoAddBottomBar of lhForm

      send DoWriteFile of lhForm "c:\test.htm"
      send html_StartDoc "c:\test.htm"
    end_procedure
  end_object // oGrid
  procedure DoAddField integer liFile integer liField
    send DoAddField of oGrid liFile liField
  end_procedure
  procedure DoAddFieldSet
    send DoAddFieldSet of oGrid
  end_procedure
  procedure DeleteRow
    send Grid_DeleteCurrentRow (oGrid(self))
  end_procedure
  procedure MoveUp
    send Grid_SwapCurrentRowUp (oGrid(self))
  end_procedure
  procedure MoveDown
    send Grid_SwapCurrentRowDown (oGrid(self))
  end_procedure

  procedure DoPreview
    send DoPreview of oGrid
  end_procedure

  procedure DoReset
    set piFieldSetCounter to 0
    send delete_data of oGrid
    send DoAddFieldSet of oGrid
  end_procedure

  object oBtn1 is a aps.Multi_Button
    on_item "Add field set" send DoAddFieldSet
  end_object
  object oBtn2 is a aps.Multi_Button
    on_item "Delete" send DeleteRow
  end_object
  object oBtn3 is a aps.Multi_Button
    on_item "Move up" send MoveUp
  end_object
  object oBtn4 is a aps.Multi_Button
    on_item "Move down" send MoveDown
  end_object
  send aps_locate_multi_buttons

  send aps_goto_max_row
  send aps_make_row_space 5

  object oLine is a aps.LineControl
    set peAnchors to (anBottom+anRight+anLeft)
  end_object

  object oBtn11 is a aps.Multi_Button
    on_item "Preview" send DoPreview
  end_object
  object oBtn12 is a aps.Multi_Button
    on_item "Reset" send DoReset
  end_object
  object oBtn13 is a aps.Multi_Button
    on_item "New" send DoNewFile
  end_object
  object oBtn14 is a aps.Multi_Button
    on_item "Close" send close_panel
  end_object
  send aps_locate_multi_buttons

  procedure DoNewFile
    integer liFile
    get piMainFile to liFile
    get iFdxSelectOneFile ghFDX liFile to liFile
    if liFile begin
      send DoReset
      send DDC_OpenFileInclParents liFile true
      set piMainFile to liFile
      send fill_list of oFieldSelector ghFDX liFile true
    end
  end_procedure

  procedure popup
    integer liFile
    get piMainFile to liFile
    ifnot liFile begin
      get iFdxSelectOneFile ghFDX 0 to liFile
      if liFile begin
        send DDC_OpenFileInclParents liFile true
        send DoReset
        set piMainFile to liFile
      end
    end
    if liFile begin
      send fill_list of oFieldSelector ghFDX liFile true
      forward send popup
    end
  end_procedure
  procedure aps_beautify
    send APS_ALIGN_INSIDE_CONTAINER_BY_SIZING (oLine(self)) SL_ALIGN_RIGHT
  end_procedure

  procedure Close_Query_View
    set piMainFile to 0
    send close_panel
  end_procedure

end_object