clsstriprigout.cls

金算盘软件代码

    
    ReDim Field(6) As ClassField        '表头输入控件的附加属性
    'redim PicLbl(10) As ClassPicInputField  'PIC输入时的附加属性
    ReDim ColProperty(29) As ClassGridProperty   'GRID附加属性
    ClearRowProperty
    frmName.GrdCol.Cols = 29
    frmName.grdCol1.Cols = 29
    frmName.grdCol1.col = 1
    frmName.grdCol1.Row = 1
    frmName.grdCol1.CellBackColor = frmName.lblField(0).BackColor
    frmName.grdCol1.CellForeColor = frmName.lblField(0).ForeColor
    '设置GRID附加属性
    SetColProperty
    
    '创建GRID列粘贴控键
    Dim i As Integer
    For i = 1 To frmName.GrdCol.Cols - 1
        Load frmName.lblTotal(i)
        frmName.lblTotal(i).Caption = ""
        frmName.lblTotal(i).ZOrder 0
    Next i
    frmName.lblTotal(0).ZOrder 0

'   创建Field控件(表头输入)
    CreateField (6)
    frmName.lblField(2).Caption = Format$(gclsBase.BaseDate, "yyyy-mm-dd")
    ReDim strColRow(frmName.GrdCol.Cols - 1) As String  '单据体行复制/粘贴存储区
    ReDim arrItemProperty(1) As ItemProperty
    ReDim arr1ItemProperty(1) As ItemProperty
'设置默认小数位数
    intCurDec = 2
    intRateDec = 2
InvalidExit:
End Property

Public Property Get Form() As Object
'当检索属性值时在参数右边使用。
'Syntax: Debug.Print X.GridName
    Set Form = frmName
End Property
'确定滚动条的存在(待优化)
Public Sub ScrollBarExist(blnHscroll As Boolean, blnVscroll As Boolean)
    Dim intTotalColsWidth As Long
    intTotalColsWidth = lngSumOfColWidth()
    If frmName.GrdCol.Rows <= 2 Then
        '总行数小于2,必无垂直滚动条
        blnVscroll = False
        If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If (Not frmName.GrdCol.RowIsVisible(frmName.GrdCol.Rows - 1)) Or (Not frmName.GrdCol.RowIsVisible(1)) Then
        '第一行或最大行不可视(第0行为固定行),必有垂直滚动条
        blnVscroll = True
        If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
            blnHscroll = True
        Else
            blnHscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth >= frmName.GrdCol.width - 2 * intGrdBorderWidth Then
        blnHscroll = True
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight - gclsEniv.HScrollHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth < frmName.GrdCol.width - 2 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
        blnHscroll = False
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    
    If intTotalColsWidth < frmName.GrdCol.width - 2 * intGrdBorderWidth _
        And intTotalColsWidth > frmName.GrdCol.width - 2 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
        If frmName.GrdCol.RowPos(frmName.GrdCol.Rows - 1) + frmName.GrdCol.RowHeight(frmName.GrdCol.Rows - 1) >= frmName.GrdCol.Height - 2 * intGrdBorderHeight Then
            blnVscroll = True
            blnHscroll = True
        Else
            blnVscroll = False
            blnHscroll = False
        End If
    End If

EndProc:
    If frmName.GrdCol.ScrollBars = flexScrollBarNone Or _
       frmName.GrdCol.ScrollBars = flexScrollBarVertical Then
        blnHscroll = False
    End If
    If frmName.GrdCol.ScrollBars = flexScrollBarNone Or _
       frmName.GrdCol.ScrollBars = flexScrollBarHorizontal Then
        blnVscroll = False
    End If

End Sub
'在GRID上的下一个增加行
Public Sub NextLineWithAdded()
    Dim intNewRow As Integer
    If frmName.GrdCol.Row < frmName.GrdCol.Rows - 1 Then
        intNewRow = frmName.GrdCol.Row + 1
    Else
        frmName.GrdCol.Rows = frmName.GrdCol.Rows + 1
        frmName.GrdCol.TextMatrix(frmName.GrdCol.Rows - 1, 0) = "0"
        intNewRow = frmName.GrdCol.Row + 1
    End If
    If Not blnRowIsVisible(intNewRow) Then
        frmName.GrdCol.TopRow = frmName.GrdCol.TopRow + 1
    End If
    frmName.GrdCol.Row = intNewRow
    If frmName.GrdCol.col = 0 Then
        frmName.GrdCol.col = 1
    End If
End Sub
'在GRID上确定行是否可见
Public Function blnRowIsVisible(ByVal RowNo As Integer) As Boolean
    '该行高度完全可视时为TRUE
    Dim blnHscroll As Boolean, blnVscroll As Boolean
    If frmName.GrdCol.Rows <= 1 Then
        frmName.GrdCol.Rows = 2
    End If
    If RowNo > frmName.GrdCol.Rows - 1 Then
        blnRowIsVisible = False
    End If
    If frmName.GrdCol.RowIsVisible(RowNo) = False Then
        blnRowIsVisible = False
        Exit Function
    End If
    Call ScrollBarExist(blnHscroll, blnVscroll) '判断是否滚动条
    If blnHscroll Then
        '下边有滚动水平条
        If frmName.GrdCol.RowPos(RowNo) + frmName.GrdCol.RowHeight(RowNo) > frmName.GrdCol.Height - gclsEniv.HScrollHeight Then
            blnRowIsVisible = False
        Else
            blnRowIsVisible = True
        End If
   Else
        '下边无水平滚动条
        If frmName.GrdCol.RowPos(RowNo) + frmName.GrdCol.RowHeight(RowNo) > frmName.GrdCol.Height Then
            blnRowIsVisible = False
        Else
            blnRowIsVisible = True
        End If
   End If
End Function

'各列宽度之和
Public Function lngSumOfColWidth() As Long
    Dim i As Integer, lngSum As Long
    lngSum = 0
    For i = 0 To frmName.GrdCol.Cols - 1
        lngSum = lngSum + frmName.GrdCol.ColWidth(i)
    Next i
    lngSumOfColWidth = lngSum
End Function

Public Function dblTotalOfCol(ByVal intCol As Integer) As Double
'GRID列合计
    Dim lngRow As Long
    Dim dblTmp As Double
    dblTmp = 0
    For lngRow = 1 To frmName.GrdCol.Rows - 1
        dblTmp = dblTmp + C2Dbl(strGrdCell(lngRow, intCol))
    Next lngRow
    dblTotalOfCol = dblTmp
End Function

'---------------------------------
'单据类型数组初始化
'---------------------------------
Private Sub Class_Initialize()
    intGrdBorderWidth = Screen.TwipsPerPixelX
    intGrdBorderHeight = Screen.TwipsPerPixelY
'    InitTabName
'    InitReceiptArray
End Sub
'---------------------------------
'确定GRID上的某一行是否为空行
'出口：为TRUE时不是空行为FALSE时是空行
'---------------------------------
Public Function blnNotNullRow(ByVal lngRow As Long, Optional ByVal blnIsGrid1 As Boolean = False) As Boolean
    Dim intI As Integer
    blnNotNullRow = False
    If blnIsGrid1 Then
        For intI = 0 To frmName.grdCol1.Cols - 1
            If frmName.GrdCol.TextMatrix(lngRow, intI) <> "" And frmName.GrdCol.TextMatrix(lngRow, intI) <> "0" Then
                blnNotNullRow = True
                Exit Function
            End If
        Next
    Else
        For intI = 0 To frmName.GrdCol.Cols - 1
            If frmName.GrdCol.TextMatrix(lngRow, intI) <> "" And frmName.GrdCol.TextMatrix(lngRow, intI) <> "0" Then
                blnNotNullRow = True
                Exit Function
            End If
        Next
    End If
End Function
'--------------------------------------
'在GRID上删除一行
'入口：行号
'--------------------------------------
Public Function blnDeleteARow(ByVal lngRow As Long) As Boolean
    Dim i%
    With frmName.GrdCol
        If .Rows <= 2 Then
            InsertARow False
            .Row = lngRow
        End If
        .RemoveItem .Row
        My.bytRegion = FcmdButton
        My.bytIndex = 0
        InputCtrInvisible
        If frmName.GrdCol.Rows > 1 Then
            setAllItemproperty
        End If
        BuildNoteMsg True
        blnDeleteARow = True
        My.blnIsChanged = True
    End With
End Function
Public Sub PutTextToRowProperty(ByVal lngRowno As Long, ByVal lngColNo As Long, ByVal strText As String)
'    On Error Resume Next
    
    If UBound(RowNo) < lngRowno Then
        ReDim Preserve RowNo(lngRowno)
        RowNo(lngRowno) = UBound(RowPropertys) + 1
    End If
   If RowNo(lngRowno) = 0 Then
        RowNo(lngRowno) = UBound(RowPropertys) + 1
        ReDim Preserve RowPropertys(RowNo(lngRowno))
   End If
   lngRowno = RowNo(lngRowno)
   If UBound(RowPropertys) < lngRowno Then
        ReDim Preserve RowPropertys(lngRowno)
   End If
   Select Case lngColNo
   Case 0
      RowPropertys(lngRowno).lngDetailID = C2lng(strText)
   Case 1
      RowPropertys(lngRowno).strItem = strText
   Case 2
      RowPropertys(lngRowno).strSelectBill = strText
   Case 3
      RowPropertys(lngRowno).strPosition = strText
   Case 4
      RowPropertys(lngRowno).strUnit = strText
   Case 5
      RowPropertys(lngRowno).strQuantity = strText
   Case 6
      RowPropertys(lngRowno).strPrice = strText
   Case 7
      RowPropertys(lngRowno).strPriceTax = strText
   Case 8
      RowPropertys(lngRowno).strDiscount = strText
   Case 9
      RowPropertys(lngRowno).strCurrAmount = strText
   Case 10
      RowPropertys(lngRowno).strAmount = strText
   Case 11
      RowPropertys(lngRowno).strTax = strText
   Case 12
      RowPropertys(lngRowno).strCurrTaxAmount = strText
   Case 13
      RowPropertys(lngRowno).strTaxAmount = strText
   Case 14
      RowPropertys(lngRowno).strCurrAmountTax = strText
   Case 15
      RowPropertys(lngRowno).strAmountTax = strText
   Case 16
      RowPropertys(lngRowno).strExpenseAmount = strText
   Case 17
      RowPropertys(lngRowno).strProduceNum = strText
   Case 18
      RowPropertys(lngRowno).strProduceDate = strText
   Case 19
      RowPropertys(lngRowno).strValidDate = strText
   Case 20
      RowPropertys(lngRowno).intValidDay = C2lng(strText)
   Case 21
      RowPropertys(lngRowno).strJob = strText
   Case 22
      RowPropertys(lngRowno).strCustomID0 = strText
   Case 23
      RowPropertys(lngRowno).strCustomID1 = strText
   Case 24
      RowPropertys(lngRowno).strCustomID2 = strText
   Case 25
      RowPropertys(lngRowno).strCustomID3 = strText
   Case 26
      RowPropertys(lngRowno).strCustomID4 = strText
   Case 27
      RowPropertys(lngRowno).strCustomID5 = strText
   Case 28
      RowPropertys(lngRowno).lngItemID = C2lng(strText)
   Case 29
      RowPropertys(lngRowno).lngOrderDetailID = C2lng(strText)
   Case 30
      RowPropertys(lngRowno).lngPositionID = C2lng(strText)
   Case 31
      RowPropertys(lngRowno).lngUnitID = C2lng(strText)
   Case 32
      RowPropertys(lngRowno).lngTaxID = C2lng(strText)
   Case 33
      RowPropertys(lngRowno).lngJobID = C2lng(strText)
   Case 34
      RowPropertys(lngRowno).lngCustomID0 = C2lng(strText)
   Case 35
      RowPropertys(lngRowno).lngCustomID1 = C2lng(strText)
   Case 36
      RowPropertys(lngRowno).lngCustomID2 = C2lng(strText)
   Case 37
      RowPropertys(lngRowno).lngCustomID3 = C2lng(strText)
   Case 38
      RowPropertys(lngRowno).lngCustomID4 = C2lng(strText)
   Case 39
      RowPropertys(lngRowno).lngCustomID5 = C2lng(strText)
   Case 40
      RowPropertys(lngRowno).dblFactor = C2Dbl(strText)
   Case 41
      RowPropertys(lngRowno).dblMinQuantity = C2Dbl(strText)
   Case 42
      RowPropertys(lngRowno).lngInActivityDetailID = C2Dbl(strText)