⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 clsstriprigout.cls

📁 金算盘软件代码
💻 CLS
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
   Case 43
      RowPropertys(lngRowno).dblMaxQuantityOfBatch = C2Dbl(strText)
   Case 44
      RowPropertys(lngRowno).dblOutedQuantityOfBatch = C2Dbl(strText)
   Case 45
      RowPropertys(lngRowno).strDiscInfo = strText
   Case 61
      RowPropertys(lngRowno).dblCostAmount = C2Dbl(strText) ' Round(C2Dbl(strText), gclsBase.NaturalCurDec)
   Case 62
      RowPropertys(lngRowno).dblCostDiff = C2Dbl(strText) ' Round(C2Dbl(strText), gclsBase.NaturalCurDec)
   Case 63
      RowPropertys(lngRowno).dblSaleTax = C2Dbl(strText) ' Round(C2Dbl(strText), gclsBase.NaturalCurDec)
   Case 64
      RowPropertys(lngRowno).dblAvgCostAmount = C2Dbl(strText) ' Round(C2Dbl(strText), gclsBase.NaturalCurDec)
   Case 65
      RowPropertys(lngRowno).strPrice = strText ' Round(C2Dbl(strText), gclsBase.NaturalCurDec)
   Case 66
      RowPropertys(lngRowno).strCurrAmount = strText ' Round(C2Dbl(strText), gclsBase.NaturalCurDec)
   Case 67
      RowPropertys(lngRowno).strAmount = strText ' Round(C2Dbl(strText), gclsBase.NaturalCurDec)
   End Select
End Sub

Public Function GetTextFromRowProperty(ByVal lngRowno As Long, ByVal lngColNo As Long) As String
    If UBound(RowNo) < lngRowno Then
        ReDim Preserve RowNo(lngRowno)
        RowNo(lngRowno) = UBound(RowPropertys) + 1
    End If
   lngRowno = RowNo(lngRowno)
   If UBound(RowPropertys) < lngRowno Then
        ReDim Preserve RowPropertys(lngRowno)
   End If
   Select Case lngColNo
   Case 0
      GetTextFromRowProperty = RowPropertys(lngRowno).lngDetailID
   Case 1
      GetTextFromRowProperty = RowPropertys(lngRowno).strItem
   Case 2
      GetTextFromRowProperty = RowPropertys(lngRowno).strSelectBill
   Case 3
      GetTextFromRowProperty = RowPropertys(lngRowno).strPosition
   Case 4
      GetTextFromRowProperty = RowPropertys(lngRowno).strUnit
   Case 5
      GetTextFromRowProperty = RowPropertys(lngRowno).strQuantity
   Case 6
      GetTextFromRowProperty = RowPropertys(lngRowno).strPrice
   Case 7
      GetTextFromRowProperty = RowPropertys(lngRowno).strPriceTax
   Case 8
      GetTextFromRowProperty = RowPropertys(lngRowno).strDiscount
   Case 9
      GetTextFromRowProperty = RowPropertys(lngRowno).strCurrAmount
   Case 10
      GetTextFromRowProperty = RowPropertys(lngRowno).strAmount
   Case 11
      GetTextFromRowProperty = RowPropertys(lngRowno).strTax
   Case 12
      GetTextFromRowProperty = RowPropertys(lngRowno).strCurrTaxAmount
   Case 13
      GetTextFromRowProperty = RowPropertys(lngRowno).strTaxAmount
   Case 14
      GetTextFromRowProperty = RowPropertys(lngRowno).strCurrAmountTax
   Case 15
      GetTextFromRowProperty = RowPropertys(lngRowno).strAmountTax
   Case 16
      GetTextFromRowProperty = RowPropertys(lngRowno).strExpenseAmount
   Case 17
      GetTextFromRowProperty = RowPropertys(lngRowno).strProduceNum
   Case 18
      GetTextFromRowProperty = RowPropertys(lngRowno).strProduceDate
   Case 19
      GetTextFromRowProperty = RowPropertys(lngRowno).strValidDate
   Case 20
      GetTextFromRowProperty = RowPropertys(lngRowno).intValidDay
   Case 21
      GetTextFromRowProperty = RowPropertys(lngRowno).strJob
   Case 22
      GetTextFromRowProperty = RowPropertys(lngRowno).strCustomID0
   Case 23
      GetTextFromRowProperty = RowPropertys(lngRowno).strCustomID1
   Case 24
      GetTextFromRowProperty = RowPropertys(lngRowno).strCustomID2
   Case 25
      GetTextFromRowProperty = RowPropertys(lngRowno).strCustomID3
   Case 26
      GetTextFromRowProperty = RowPropertys(lngRowno).strCustomID4
   Case 27
      GetTextFromRowProperty = RowPropertys(lngRowno).strCustomID5
   Case 28
      GetTextFromRowProperty = RowPropertys(lngRowno).lngItemID
   Case 29
      GetTextFromRowProperty = RowPropertys(lngRowno).lngOrderDetailID
   Case 30
      GetTextFromRowProperty = RowPropertys(lngRowno).lngPositionID
   Case 31
      GetTextFromRowProperty = RowPropertys(lngRowno).lngUnitID
   Case 32
      GetTextFromRowProperty = RowPropertys(lngRowno).lngTaxID
   Case 33
      GetTextFromRowProperty = RowPropertys(lngRowno).lngJobID
   Case 34
      GetTextFromRowProperty = RowPropertys(lngRowno).lngCustomID0
   Case 35
      GetTextFromRowProperty = RowPropertys(lngRowno).lngCustomID1
   Case 36
      GetTextFromRowProperty = RowPropertys(lngRowno).lngCustomID2
   Case 37
      GetTextFromRowProperty = RowPropertys(lngRowno).lngCustomID3
   Case 38
      GetTextFromRowProperty = RowPropertys(lngRowno).lngCustomID4
   Case 39
      GetTextFromRowProperty = RowPropertys(lngRowno).lngCustomID5
   Case 40
      GetTextFromRowProperty = RowPropertys(lngRowno).dblFactor
   Case 41
      GetTextFromRowProperty = RowPropertys(lngRowno).dblMinQuantity
   Case 42
      GetTextFromRowProperty = RowPropertys(lngRowno).lngInActivityDetailID
   Case 43
      GetTextFromRowProperty = RowPropertys(lngRowno).dblMaxQuantityOfBatch
   Case 44
      GetTextFromRowProperty = RowPropertys(lngRowno).dblOutedQuantityOfBatch
   Case 45
      GetTextFromRowProperty = RowPropertys(lngRowno).strDiscInfo
   Case 61
      GetTextFromRowProperty = RowPropertys(lngRowno).dblCostAmount
   Case 62
      GetTextFromRowProperty = RowPropertys(lngRowno).dblCostDiff
   Case 63
      GetTextFromRowProperty = RowPropertys(lngRowno).dblSaleTax
   Case 64
      GetTextFromRowProperty = RowPropertys(lngRowno).dblAvgCostAmount
   Case 65
      GetTextFromRowProperty = RowPropertys(lngRowno).strPrice
   Case 66
      GetTextFromRowProperty = RowPropertys(lngRowno).strCurrAmount
   Case 67
      GetTextFromRowProperty = RowPropertys(lngRowno).strAmount
   End Select
End Function


Public Sub ResetRowProperty()
   Dim i As Long
   
   ReDim RowPropertys(frmName.GrdCol.Rows - 1)
   ReDim RowNo(frmName.GrdCol.Rows - 1)
   For i = 1 To frmName.GrdCol.Rows - 1
       RowNo(i) = i
   Next
End Sub
Public Sub ClearRowProperty()
   ReDim RowPropertys(0)
   ReDim RowNo(0)
End Sub
'------------------------------
'在GRID上写红字
'------------------------------
Public Sub WriteGrd(ByVal strText As String, ByVal lngRow As Long, ByVal lngCol As Long)
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    Dim blnOldR As Boolean
    Dim strNew As String
    If lngCol > frmName.GrdCol.Cols - 1 Then
        PutTextToRowProperty lngRow, lngCol, strText
        Exit Sub
    End If
    
    With frmName.GrdCol
    If lngRow > .Rows - 1 Or lngCol > .Cols - 1 Or lngRow < 0 Or lngCol < 0 Then
        Exit Sub
    End If
    strText = Trim(strText)
    If .ColAlignment(lngCol) = flexAlignRightCenter And Len(strText) > 0 Then
        blnOldR = My.blnRefresh
        My.blnRefresh = False
        lngR = .Row
        lngC = .col
        .Row = lngRow
        .col = lngCol
        strNew = Left(strText, 1)
        If strNew = "-" Then
            .CellForeColor = RGB(255, 0, 0)
            .TextMatrix(lngRow, lngCol) = Mid(strText, 2)
'        ElseIf Val(strText) = 0 Then
'            .CellForeColor = RGB(0, 0, 0)
'            .TextMatrix(lngRow, lngCol) = ""
        Else
            If C2Dbl(strText) = 0 Then strText = ""
            .TextMatrix(lngRow, lngCol) = strText
            .CellForeColor = RGB(0, 0, 0)
        End If
        .Row = lngR
        .col = lngC
        My.blnRefresh = blnOldR
    Else
        .TextMatrix(lngRow, lngCol) = strText
    End If
    End With

End Sub

Public Sub WriteGrd1(ByVal strText As String, ByVal lngRow As Long, ByVal lngCol As Long)
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    Dim blnOldR As Boolean
    Dim strNew As String
    If lngCol > frmName.GrdCol.Cols - 1 Then
        PutTextToRowProperty 0, lngCol, strText
        Exit Sub
    End If
    
    With frmName.grdCol1
    If lngRow > .Rows - 1 Or lngCol > .Cols - 1 Or lngRow < 0 Or lngCol < 0 Then
        Exit Sub
    End If
    strText = Trim(strText)
    If ColProperty(lngCol).lngCtrType = tCurrency And Len(strText) > 0 Then
        blnOldR = My.blnRefresh
        My.blnRefresh = False
        lngR = .Row
        lngC = .col
        .Row = lngRow
        .col = lngCol
        strNew = Left(strText, 1)
        If strNew = "-" Then
            .CellForeColor = RGB(255, 0, 0)
            .TextMatrix(lngRow, lngCol) = Mid(strText, 2)
'        ElseIf Val(strText) = 0 Then
'            frmName.grdCol.CellForeColor = RGB(0, 0, 0)
'            frmName.grdCol.TextMatrix(lngRow, lngCol) = ""
        Else
            If C2Dbl(strText) = 0 Then strText = ""
            .TextMatrix(lngRow, lngCol) = strText
            .CellForeColor = RGB(0, 0, 0)
        End If
        .Row = lngR
        .col = lngC
        My.blnRefresh = blnOldR
    Else
        .TextMatrix(lngRow, lngCol) = strText
    End If
    End With
End Sub


'------------------------------
'从GRID上某一单元格内取出字符串
'------------------------------
Public Function strGrdCell(ByVal lngRow As Long, ByVal lngCol As Long) As String
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    Dim blnOldR As Boolean
    If lngCol > frmName.GrdCol.Cols - 1 Then
        strGrdCell = GetTextFromRowProperty(lngRow, lngCol)
        Exit Function
    End If
    
    If lngRow > frmName.GrdCol.Rows - 1 Or lngCol > frmName.GrdCol.Cols - 1 Or _
       lngRow < 0 Or lngCol < 0 Then
        Exit Function
    End If
    If frmName.GrdCol.ColAlignment(lngCol) = flexAlignRightCenter Then
        blnB = My.blnCtrlBinding
        blnOldR = My.blnRefresh
        My.blnRefresh = False
        My.blnCtrlBinding = False
        lngR = frmName.GrdCol.Row
        lngC = frmName.GrdCol.col
        frmName.GrdCol.Row = lngRow
        frmName.GrdCol.col = lngCol
        If CLng(frmName.GrdCol.CellForeColor) = CLng(RGB(255, 0, 0)) Then
            strGrdCell = CStr(C2Dbl(frmName.GrdCol.TextMatrix(lngRow, lngCol)) * (-1))
        Else
            strGrdCell = frmName.GrdCol.TextMatrix(lngRow, lngCol)
        End If

        frmName.GrdCol.Row = lngR
        frmName.GrdCol.col = lngC
        My.blnCtrlBinding = blnB
        My.blnRefresh = blnOldR
    Else
        strGrdCell = frmName.GrdCol.TextMatrix(lngRow, lngCol)
    End If
End Function

Public Function strGrdCell1(ByVal lngRow As Long, ByVal lngCol As Long) As String
    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    Dim blnOldR As Boolean
    If lngCol > frmName.GrdCol.Cols - 1 Then
        strGrdCell1 = GetTextFromRowProperty(0, lngCol)
        Exit Function
    End If
    
    If lngRow > frmName.grdCol1.Rows - 1 Or lngCol > frmName.grdCol1.Cols - 1 Or _
       lngRow < 0 Or lngCol < 0 Then
        Exit Function
    End If
    If frmName.grdCol1.ColAlignment(lngCol) = flexAlignRightCenter Then
        blnB = My.blnCtrlBinding
        blnOldR = My.blnRefresh
        My.blnRefresh = False
        My.blnCtrlBinding = False
        lngR = frmName.grdCol1.Row
        lngC = frmName.grdCol1.col
        frmName.grdCol1.Row = lngRow
        frmName.grdCol1.col = lngCol
        If CLng(frmName.grdCol1.CellForeColor) = CLng(RGB(255, 0, 0)) Then
            strGrdCell1 = CStr(C2Dbl(frmName.grdCol1.TextMatrix(lngRow, lngCol)) * (-1))
        Else
            strGrdCell1 = frmName.grdCol1.TextMatrix(lngRow, lngCol)
        End If

        frmName.grdCol1.Row = lngR
        frmName.grdCol1.col = lngC
        My.blnCtrlBinding = blnB
        My.blnRefresh = blnOldR
    Else
        strGrdCell1 = frmName.grdCol1.TextMatrix(lngRow, lngCol)
    End If
End Function

Private Sub Class_Terminate()
    Set mclsSubClass = Nothing
    Set mclsSubClass1 = Nothing
    Set mclsHook = Nothing
    Set HookHe = Nothing
    Erase Field
    Erase ColProperty
    Erase lngPosition
    Erase strColRow
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -