// Use WinPrint_ImageDefinition.pkg

Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
Use Strings.nui  // String manipulation for VDF and 3.2 (No User Interface)

Use DF_Print.pkg // Winprint system
Use VpeBase3     // Virtual Print Engine

object oVpeReportHelper is a cArray
  property integer piCurrentY
  property integer priv.vpe.max_bottom 0
  property boolean priv.skip_page_top_area TRUE

  function nLeftMargin returns number
     function_return (Vpe_Get(oVPE#,VLEFTMARGIN)/100.0)
  end_function
  function nRightMargin returns number
     function_return (Vpe_Get(oVPE#,VRIGHTMARGIN)/100.0)
  end_function

  procedure new_report
    set piCurrentY to 0
    set priv.vpe.max_bottom to 0
  end_procedure

  procedure WriteLine
    send vpe_Line of oVPE# (Vpe_Get(oVPE#,VLEFTMARGIN)) (piCurrentY(self)) (Vpe_Get(oVPE#,VRIGHTMARGIN)) (piCurrentY(self))
    //set piCurrentY to (vpe_get(oVPE#,VBOTTOM))
  end_procedure

  procedure WritePos string lsValue number lnPos integer liFontAttr integer liDecs number lnWidth
    integer liFontAttrTmp liDecsTmp liX1 liX2 liY1 liY2
    number lnWidthTmp
    if (num_arguments<5) move 0 to lnWidthTmp
    else move (lnWidth*100) to lnWidthTmp

    if (num_arguments<4) move -1 to liDecsTmp
    else move liDecs to liDecsTmp

    if (liDecsTmp<>-1) get NumToStr lsValue liDecsTmp to lsValue

    if (num_arguments<3) move 0 to liFontAttrTmp
    else move liFontAttr to liFontAttrTmp

    if (liFontAttrTmp iand FONT_BOLD) move ("[B ]"+lsValue) to lsValue

    if (lnWidthTmp=0) begin
      if (liFontAttrTmp iand FONT_RIGHT) begin
        move (lnPos*100-vpe_get(oVPE#,VLEFTMARGIN)) to lnWidthTmp
      end
      else begin
        move (vpe_get(oVPE#,VRIGHTMARGIN)-(lnPos*100)) to lnWidthTmp
      end
    end

    move (lnPos*100+vpe_get(oVPE#,VLEFTMARGIN)) to liX1

    // Figure out vertical position
    get piCurrentY to liY1

  //// If we are "under" the Default Output Rectangle, we take a new page
  //if ((liY1+100)>vpe_get(oVPE#,VBOTTOMMARGIN)) begin
  //  send vpe_PageBreak of oVPE#                            //     <<--------- PAGE BREAK
  //  get vpe_get of oVPE# VTOPMARGIN) to liY1
  //  set piCurrentY to liY1
  //end

    if (priv.skip_page_top_area(self)) begin
      // If we are "over" the Default Output Rectangle, we move down so we're in. If we are in XY-mode we do not make this adjustment (we could be writing the page top)
      if (liY1<vpe_get(oVPE#,VTOPMARGIN)) begin
        get vpe_get of oVPE# VTOPMARGIN) to liY1
        set piCurrentY to liY1
      end
    end

    move VFREE to liY2

    move (trim(lsValue)) to lsValue))
    if (liFontAttrTmp iand FONT_RIGHT) begin
      send vpe_SetAlign of oVPE# ALIGN_RIGHT
      send vpe_Write of oVPE# (liX1-lnWidthTmp) liY1 liX1 liY2 lsValue
      send vpe_SetAlign of oVPE# ALIGN_LEFT
    end
    else begin
      send vpe_Write of oVPE# liX1 liY1 (liX1+lnWidthTmp) liY2 lsValue
    end

    if (liFontAttrTmp iand FONT_BOLD) begin
      send vpe_StorePos of oVPE#
      send vpe_Write of oVPE# VRIGHT liY1 VRIGHT liY2 "[BO ]"
      send vpe_RestorePos of oVPE#
    end

    // x1=lnPos x2=piVpe_Current
    // y1
    // y2=VFREE
    if (vpe_get(oVPE#,VBOTTOM)>priv.vpe.max_bottom(self)) set priv.vpe.max_bottom to (vpe_get(oVPE#,VBOTTOM))
  end_procedure

  procedure WriteLnPos string lsValue number lnPos integer liFontAttr integer liDecs number lnWidth
    if (num_arguments=2) send WritePos lsValue lnPos
    if (num_arguments=3) send WritePos lsValue lnPos liFontAttr
    if (num_arguments=4) send WritePos lsValue lnPos liFontAttr liDecs
    if (num_arguments=5) send WritePos lsValue lnPos liFontAttr liDecs lnWidth

    if (priv.skip_page_top_area(self)) begin
      if (priv.vpe.max_bottom(self)<piCurrentY(self)) set piCurrentY to 0
      else set piCurrentY to (priv.vpe.max_bottom(self)) // Next available vertical position
      set priv.vpe.max_bottom to 0 //(piCurrentY(oVpeReportHelper))
    end
    else begin
      set piCurrentY to (priv.vpe.max_bottom(self))
      set priv.vpe.max_bottom to 0 //(piCurrentY(oVpeReportHelper))
    end
  end_procedure
end_object


class cWinPrint_ImageDefinition is a cArray
  procedure construct_object
    forward send construct_object
    property integer pbVpe_Mode    public FALSE
  end_procedure

  item_property_list
    item_property integer pbDeactivate.i
    item_property string  psColumnHeader.i
    item_property number  pnPosition.i
    item_property integer piType.i
    item_property integer piDecimals.i
    item_property integer pbNewLine.i
    item_property integer pbTotals.i
    item_property string  psValue.i
    item_property integer pbBold.i
//    item_property integer pbZeroSuppress.i
    item_property number  pnSumTotal.i
    item_property number  pnSumTotal2.i
    item_property number  pnSumTotal3.i
    item_property number  pnSumTotal4.i
    item_property number  pnSumTotal5.i
    item_property integer pbForceRight.i
  end_item_property_list cWinPrint_ImageDefinition

  procedure WritePos string lsValue number lnPos integer liFontAttr integer liDecs number lnWidth
    integer liFontAttrTmp liDecsTmp liX1 liX2 liY1 liY2
    number lnWidthTmp
    if (pbVpe_Mode(self)) begin
      if (num_arguments=2) send WritePos of oVpeReportHelper  lsValue lnPos
      if (num_arguments=3) send WritePos of oVpeReportHelper  lsValue lnPos liFontAttr
      if (num_arguments=4) send WritePos of oVpeReportHelper  lsValue lnPos liFontAttr liDecs
      if (num_arguments=5) send WritePos of oVpeReportHelper  lsValue lnPos liFontAttr liDecs lnWidth
    end
    else begin
      if (num_arguments=2) DFWritePos lsValue lnPos
      if (num_arguments=3) DFWritePos lsValue lnPos liFontAttr
      if (num_arguments=4) DFWritePos lsValue lnPos liFontAttr liDecs
      if (num_arguments=5) DFWritePos lsValue lnPos liFontAttr liDecs lnWidth
    end
  end_procedure

  procedure WriteLnPos string lsValue number lnPos integer liFontAttr integer liDecs number lnWidth
    if (pbVpe_Mode(self)) begin
      if (num_arguments=2) send WriteLnPos of oVpeReportHelper  lsValue lnPos
      if (num_arguments=3) send WriteLnPos of oVpeReportHelper  lsValue lnPos liFontAttr
      if (num_arguments=4) send WriteLnPos of oVpeReportHelper  lsValue lnPos liFontAttr liDecs
      if (num_arguments=5) send WriteLnPos of oVpeReportHelper  lsValue lnPos liFontAttr liDecs lnWidth
    end
    else begin
      if (num_arguments=2) DFWriteLnPos lsValue lnPos
      if (num_arguments=3) DFWriteLnPos lsValue lnPos liFontAttr
      if (num_arguments=4) DFWriteLnPos lsValue lnPos liFontAttr liDecs
      if (num_arguments=5) DFWriteLnPos lsValue lnPos liFontAttr liDecs lnWidth
    end
//    showln ("efter: priv.vpe.max_bottom: "+string(priv.vpe.max_bottom(self))) " " ("piCurrentY: "+string(piCurrentY(oVpeReportHelper)))
  end_procedure

            procedure Reset_Totals integer liLevel
              integer liRow liMax
              get row_count to liMax
              decrement liMax
              for liRow from 0 to liMax
                if NUM_ARGUMENTS eq 0 begin
                  set pnSumTotal.i  liRow to 0
                  set pnSumTotal2.i liRow to 0
                  set pnSumTotal3.i liRow to 0
                  set pnSumTotal4.i liRow to 0
                  set pnSumTotal5.i liRow to 0
                end
                else begin
                  if (liLevel=1) begin
                    set pnSumTotal2.i liRow to (pnSumTotal2.i(self,liRow)+pnSumTotal.i(self,liRow))
                    set pnSumTotal.i  liRow to 0
                  end
                  if (liLevel=2) begin
                    set pnSumTotal3.i liRow to (pnSumTotal3.i(self,liRow)+pnSumTotal2.i(self,liRow))
                    set pnSumTotal2.i liRow to 0
                  end
                  if (liLevel=3) begin
                    set pnSumTotal4.i liRow to (pnSumTotal4.i(self,liRow)+pnSumTotal3.i(self,liRow))
                    set pnSumTotal3.i liRow to 0
                  end
                  if (liLevel=4) begin
                    set pnSumTotal5.i liRow to (pnSumTotal5.i(self,liRow)+pnSumTotal4.i(self,liRow))
                    set pnSumTotal4.i liRow to 0
                  end
                  if (liLevel=5) begin
                    set pnSumTotal5.i liRow to 0
                  end
                end
              loop
            end_procedure

  procedure Output_Total integer liLevelTmp
    integer liRow liMax liType liDecimals lbNewLine lbTotals liLevel
    boolean lbForceRight
    number lnPosition
    string lsValue
    if NUM_ARGUMENTS eq 0 move 1 to liLevel
    else move liLevelTmp to liLevel
    get row_count to liMax
    decrement liMax
    for liRow from 0 to liMax
      if (liLevel=1) get pnSumTotal.i  liRow to lsValue
      if (liLevel=2) get pnSumTotal2.i liRow to lsValue
      if (liLevel=3) get pnSumTotal3.i liRow to lsValue
      if (liLevel=4) get pnSumTotal4.i liRow to lsValue
      if (liLevel=5) get pnSumTotal5.i liRow to lsValue
      get pnPosition.i   liRow to lnPosition
      get piType.i       liRow to liType
      get piDecimals.i   liRow to liDecimals
      get pbNewLine.i    liRow to lbNewLine
      get pbTotals.i     liRow to lbTotals
      get pbForceRight.i liRow to lbForceRight
      move (lbNewLine or liRow=liMax) to lbNewLine // Last column will have a new line anyway
      if (pbDeactivate.i(self,liRow)) move "" to lsValue
      if lbTotals begin
        if (liType=DF_BCD or lbForceRight<>FALSE) begin
          if lbNewLine send WriteLnPos lsValue lnPosition FONT_RIGHT liDecimals
          else         send WritePos   lsValue lnPosition FONT_RIGHT liDecimals
        end
        else begin
          if lbNewLine send WriteLnPos (psValue.i(self,liRow)) lnPosition
          else         send WritePos   (psValue.i(self,liRow)) lnPosition
        end
      end
    loop
    send Reset_Totals liLevel
  end_procedure

            procedure DoReset
              send delete_data
            end_procedure

  procedure Add_Column string lsHeader number lnPos integer liType integer liDecs integer lbNewLine integer lbTotals //integer lbZeroSuppress
    integer liRow
    get row_count to liRow
    set psColumnHeader.i liRow to lsHeader
    set pnPosition.i     liRow to lnPos
    set piType.i         liRow to liType
    set piDecimals.i     liRow to liDecs
    set pbNewLine.i      liRow to lbNewLine
    set pbTotals.i       liRow to lbTotals
//    set pbZeroSuppress.i liRow to lbZeroSuppress
  end_procedure

  procedure set Bold_State integer lbValue
    set pbBold.i (row_count(self)-1) to lbValue
  end_procedure

  procedure set Force_RightAdjust integer lbValue
    set pbForceRight.i (row_count(self)-1) to lbValue
  end_procedure

  procedure Output_Header
    integer liRow liMax liType lbNewLine
    boolean lbForceRight
    number lnPosition
    string lsValue
    get row_count to liMax
    decrement liMax
    for liRow from 0 to liMax
      get psColumnHeader.i liRow to lsValue
      get pnPosition.i     liRow to lnPosition
      get piType.i         liRow to liType
      get pbNewLine.i      liRow to lbNewLine
      get pbForceRight.i   liRow to lbForceRight
      move (lbNewLine or liRow=liMax) to lbNewLine // Last column will have a new line anyway
      if (pbDeactivate.i(self,liRow)) move "" to lsValue
      if (liType=DF_BCD or lbForceRight<>FALSE) begin
        if lbNewLine send WriteLnPos lsValue lnPosition (FONT_RIGHT+FONT_BOLD) -1
        else         send WritePos   lsValue lnPosition (FONT_RIGHT+FONT_BOLD) -1
      end
      else begin
        if lbNewLine send WriteLnPos lsValue lnPosition FONT_BOLD
        else         send WritePos   lsValue lnPosition FONT_BOLD
      end
    loop
  end_procedure

  procedure Update_Totals
    integer liRow liMax liType lbTotals
    string lsValue
    get row_count to liMax
    decrement liMax
    for liRow from 0 to liMax
      get piType.i      liRow to liType
      get pbTotals.i    liRow to lbTotals

      if (liType=DF_BCD and lbTotals<>0) begin
        get psValue.i     liRow to lsValue

        if (StringIsNumber(lsValue,ascii(CurrentDecimalSeparator()))) ;
          set pnSumTotal.i liRow to (pnSumTotal.i(self,liRow)+number(lsValue))
      end
    loop
  end_procedure

  procedure Output_Image
    boolean lbForceRight
    integer liRow liMax liType liDecimals lbNewLine lbTotals lbBold liBold
    number lnPosition lnMaxWidth
    string lsValue

    get row_count to liMax
    decrement liMax
    for liRow from 0 to liMax
      get psValue.i      liRow  to lsValue
      get pnPosition.i   liRow  to lnPosition
      get piType.i       liRow  to liType
      get piDecimals.i   liRow  to liDecimals
      get pbNewLine.i    liRow  to lbNewLine
      get pbBold.i       liRow  to lbBold
      get pbForceRight.i liRow  to lbForceRight

      if lbBold move FONT_BOLD to liBold
      else move 0 to liBold

      if (liRow=liMax or lbNewLine<>0 or liType=DF_BCD) move 0 to lnMaxWidth //
      else move (pnPosition.i(self,liRow+1)-lnPosition-0.1) to lnMaxWidth

      move (lbNewLine or liRow=liMax) to lbNewLine // Last column will have a new line anyway
      if (pbDeactivate.i(self,liRow)) begin
        if lbNewLine send WriteLnPos "" lnPosition (FONT_RIGHT+liBold) -1 lnMaxWidth
        else         send WritePos   "" lnPosition (FONT_RIGHT+liBold) -1 lnMaxWidth
      end
      else begin
        if (liType=DF_BCD or lbForceRight<>FALSE) begin
          if (not(StringIsNumber(lsValue,ascii(CurrentDecimalSeparator()))) or (liType<>DF_BCD)) begin
            if lbNewLine send WriteLnPos lsValue lnPosition (FONT_RIGHT+liBold) -1 lnMaxWidth
            else         send WritePos   lsValue lnPosition (FONT_RIGHT+liBold) -1 lnMaxWidth
          end
          else begin
            if lbNewLine send WriteLnPos lsValue lnPosition (FONT_RIGHT+liBold) liDecimals lnMaxWidth
            else         send WritePos   lsValue lnPosition (FONT_RIGHT+liBold) liDecimals lnMaxWidth
          end
        end
        else begin
          if lbNewLine send WriteLnPos lsValue lnPosition liBold -1 lnMaxWidth
          else         send WritePos   lsValue lnPosition liBold -1 lnMaxWidth
        end
      end
    loop
    send Update_Totals
  end_procedure

  procedure BlankForm_Image
    integer liRow liMax
    get row_count to liMax
    decrement liMax
    for liRow from 0 to liMax
      set psValue.i liRow to ""
    loop
  end_procedure

  procedure Print_Value integer liRow string lsValue
    set psValue.i liRow to lsValue
  end_procedure

  procedure Print_ColumnLabel integer liRow string lsValue
    set psColumnHeader.i liRow to lsValue
  end_procedure
end_class // cWinPrint_ImageDefinition