billset.cls

金算盘软件代码

    End If
    If intTotalColsWidth >= .GrdCol.width - 0 * intGrdBorderWidth Then
        If .GrdCol.ScrollBars = flexScrollBarNone Or _
           .GrdCol.ScrollBars = flexScrollBarVertical Then
            blnHscroll = False
        Else
            blnHscroll = True
        End If
        If blnHscroll And .GrdCol.RowPos(.GrdCol.Rows - 1) + .GrdCol.RowHeight(.GrdCol.Rows - 1) >= .GrdCol.Height - 0 * intGrdBorderHeight - 1 * gclsEniv.HScrollHeight Or _
            (Not blnHscroll) And .GrdCol.RowPos(.GrdCol.Rows - 1) + .GrdCol.RowHeight(.GrdCol.Rows - 1) >= .GrdCol.Height - 0 * intGrdBorderHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    If intTotalColsWidth < .GrdCol.width - 0 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
        blnHscroll = False
        If .GrdCol.RowPos(.GrdCol.Rows - 1) + .GrdCol.RowHeight(.GrdCol.Rows - 1) >= .GrdCol.Height - 0 * intGrdBorderHeight Then
            blnVscroll = True
        Else
            blnVscroll = False
        End If
        GoTo EndProc
    End If
    
    If intTotalColsWidth < .GrdCol.width - 0 * intGrdBorderWidth _
        And intTotalColsWidth > .GrdCol.width - 0 * intGrdBorderWidth - gclsEniv.VScrollWidth Then
        If .GrdCol.RowPos(.GrdCol.Rows - 1) + .GrdCol.RowHeight(.GrdCol.Rows - 1) >= .GrdCol.Height - 0 * intGrdBorderHeight Then
            blnVscroll = True
            blnHscroll = True
        Else
            blnVscroll = False
            blnHscroll = False
        End If
    End If

EndProc:
    If .GrdCol.ScrollBars = flexScrollBarNone Or _
       .GrdCol.ScrollBars = flexScrollBarVertical Then
        blnHscroll = False
    End If
    If .GrdCol.ScrollBars = flexScrollBarNone Or _
       .GrdCol.ScrollBars = flexScrollBarHorizontal Then
        blnVscroll = False
    End If
End With
End Sub
'在GRID上的下一个增加行
Public Sub NextLineWithAdded()
    Dim intNewRow As Integer
    Dim blnHscroll As Boolean
    Dim blnVscroll As Boolean
    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, blnHscroll, blnVscroll) 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, blnH As Boolean, blnV As Boolean) 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
    blnH = False
    blnV = False
    Call ScrollBarExist(blnHscroll, blnVscroll) '判断是否滚动条
    blnH = blnHscroll
    blnV = 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 String
'GRID列合计
    Dim lngRow As Long
    Dim dblTmp As Double
    Dim intCur As Integer
    Dim intRate As Integer
    
    dblTmp = 0
    For lngRow = 1 To frmName.GrdCol.Rows - 1
        dblTmp = dblTmp + C2Dbl(strGrdCell(lngRow, intCol))
    Next lngRow
    If My.lngOldRow < 1 And frmName.GrdCol.Rows > 1 Then My.lngOldRow = 1
    Call BillPublic.CurRateDec(C2lng(frmName.GrdCol.TextMatrix(IIf(My.lngOldRow < frmName.GrdCol.Rows, My.lngOldRow, frmName.GrdCol.Rows - 1), 17)), intCur, intRate)
    dblTotalOfCol = Format(dblTmp, FormatString(intCur))
End Function

Private Sub Class_Initialize()
    intGrdBorderWidth = Screen.TwipsPerPixelX
    intGrdBorderHeight = Screen.TwipsPerPixelY
    Set clsBase = New Base
    Set clsLstMethod = New clsListMethod
End Sub
'---------------------------------
'确定GRID上的某一行是否为空行
'出口：为TRUE时不是空行为FALSE时是空行
'---------------------------------
Public Function blnNotNullRow(ByVal lngRow As Long) As Boolean
    Dim intI As Integer
    blnNotNullRow = False
    If lngRow >= frmName.GrdCol.Rows Then Exit Function
    For intI = 2 To frmName.GrdCol.Cols - 1
        If Trim(frmName.GrdCol.TextMatrix(lngRow, intI)) <> "" And frmName.GrdCol.TextMatrix(lngRow, intI) <> "0" Then
            blnNotNullRow = True
            Exit Function
        End If
    Next
End Function
'--------------------------------------
'------------------------------
'在GRID上写红字
'------------------------------
Public Sub WriteGrd(ByVal strText As String, ByVal lngRow As Long, ByVal lngCol As Long)
    With frmName.GrdCol
    If lngCol = 4 Then
        .TextMatrix(lngRow, 20 + lngCol) = strText
        If blnCashLine = False Then GoTo Display
    ElseIf lngCol = 26 Then
        .TextMatrix(lngRow, 25) = strText
    Else
        .TextMatrix(lngRow, lngCol) = strText
'        If lngCol = 24 And blnCashLine = False Then GoTo Display
    End If
    If lngCol = 6 Or lngCol = 9 Then
        If .col <> lngCol And .ColWidth(3) > 0 Then
'            RefreshRect .hwnd, .ColPos(3), .RowPos(lngRow) + .RowHeight(lngRow) \ 2, .ColPos(3) + .ColWidth(3), .RowPos(lngRow) + .RowHeight(lngRow)
            UpdateWindow .hWnd
        End If
    End If
    End With
    Exit Sub
    

    Dim lngR As Long, lngC As Long
    Dim blnB As Boolean
    Dim strNew As String
    If lngRow > frmName.GrdCol.Rows - 1 Or lngCol > frmName.GrdCol.Cols - 1 Or _
       lngRow < 0 Or lngCol < 0 Then
        Exit Sub
    End If

Display:
    lngCol = 4
    strText = Format(Trim(strText), FormatString(gclsBase.NaturalCurDec))
    If frmName.GrdCol.ColAlignment(lngCol) = flexAlignRightCenter And Len(strText) > 0 Then
        blnB = My.blnCtrlBinding
        My.blnRefresh = False
        My.blnCtrlBinding = False
        lngR = frmName.GrdCol.Row
        lngC = frmName.GrdCol.col
        frmName.GrdCol.Row = lngRow
        frmName.GrdCol.col = lngCol
        strNew = Left(strText, 1)
        If strNew = "-" Then
            frmName.GrdCol.CellForeColor = RGB(255, 0, 0)
            frmName.GrdCol.TextMatrix(lngRow, lngCol) = Mid(strText, 2)
        ElseIf Val(strText) = 0 Then
            frmName.GrdCol.CellForeColor = RGB(0, 0, 0)
            frmName.GrdCol.TextMatrix(lngRow, lngCol) = ""
        Else
            frmName.GrdCol.CellForeColor = RGB(0, 0, 0)
            frmName.GrdCol.TextMatrix(lngRow, lngCol) = strText
        End If
        frmName.GrdCol.Row = lngR
        frmName.GrdCol.col = lngC
        My.blnCtrlBinding = blnB
        My.blnRefresh = True
    Else
        My.blnRefresh = False
        lngR = frmName.GrdCol.Row
        lngC = frmName.GrdCol.col
        frmName.GrdCol.Row = lngRow
        frmName.GrdCol.col = lngCol
        frmName.GrdCol.CellForeColor = RGB(0, 0, 0)
        If lngCol = 4 Then
            frmName.GrdCol.TextMatrix(lngRow, 20 + lngCol) = strText
        Else
            frmName.GrdCol.TextMatrix(lngRow, lngCol) = strText
        End If
        frmName.GrdCol.Row = lngR
        frmName.GrdCol.col = lngC
        My.blnRefresh = True
    End If

End Sub
'------------------------------
'从GRID上某一单元格内取出字符串
'------------------------------
Public Function strGrdCell(ByVal lngRow As Long, ByVal lngCol As Long) As String
'---------------------------------
    If lngCol = 4 Then
        strGrdCell = frmName.GrdCol.TextMatrix(lngRow, 20 + lngCol)
    ElseIf lngCol = 26 Then
        strGrdCell = frmName.GrdCol.TextMatrix(lngRow, 25)
    Else
        strGrdCell = frmName.GrdCol.TextMatrix(lngRow, lngCol)
    End If
    Exit Function
'---------------------------------
'    Dim lngR As Long, lngC As Long
'    Dim blnB As Boolean
'    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
'        My.blnRefresh = False
'        My.blnCtrlBinding = False
'        lngR = frmName.grdCol.Row
'        lngC = frmName.grdCol.col
'        frmName.grdCol.Row = lngRow
'        frmName.grdCol.col = lngCol
'        If lngCol = 4 Then
'            If CLng(frmName.grdCol.CellForeColor) = CLng(RGB(255, 0, 0)) Then
'                strGrdCell = CStr(C2Dbl(frmName.grdCol.TextMatrix(lngRow, 20 + lngCol)) * (-1))
'            Else
'                strGrdCell = frmName.grdCol.TextMatrix(lngRow, 20 + lngCol)
'            End If
'        Else
'            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
'        End If
'        frmName.grdCol.Row = lngR
'        frmName.grdCol.col = lngC
'        My.blnCtrlBinding = blnB
'        My.blnRefresh = True
'    Else
'        strGrdCell = frmName.grdCol.TextMatrix(lngRow, lngCol)
'    End If
End Function
Private Sub Class_Terminate()
    Set mclsSubClass = Nothing
    Set mclsHook = Nothing
    Set HookHe = Nothing
    Set clsRed = Nothing
    Set mclsPicFooter = Nothing
    Erase Field
    Erase PicLbl
    Erase ColProperty
    Erase lngPosition
    Erase strColRow
    Set ColBill = Nothing  '单据内容集合(不包括ActivityID和DetailID)
    Set clsBase = Nothing
    Set clsLstMethod = Nothing
    Set ctrInput = Nothing
    Set ctrPicInput = Nothing
    Set frmName = Nothing
End Sub
Public Sub Form_key_Down(ByVal KeyCode As Long)
    Dim bCancel As Long
    HookHe_OnMessage frmName.hWnd, WM_KEYDOWN, KeyCode, 0, bCancel
End Sub

Private Sub HookHe_OnMessage(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long, bCancel As Long)
    On Error Resume Next
    Static i As Integer
    Static lnghWnd As Long
    If Msg = WM_CHAR Or Msg = WM_KEYDOWN Or Msg = WM_KEYUP Then
        If blnBusy = True Then
            bCancel = 1
            Exit Sub
        End If
        If mblnNotRespondKeyPress Then
            Exit Sub
        End If
    End If
    If Msg = WM_KEYDOWN Then
        If wParam = 9 Or wParam = 13 Then
            mblnKeyDown = True
            Exit Sub
        End If
        If Not (frmName.refInput(0).ReferVisible Or frmName.refInput(1).ReferVisible Or frmName.refInput(2).ReferVisible Or frmName.dtmInput.IsDropDown = 1) Then
            If wParam = 38 Or wParam = 40 Then
                mblnReadOnly = mblnIsDiscount Or blnHaveISVoucher Or frmName.chkPrint(1).Value = 1 Or mblnYSJX Or My.blnMayChange = False
                If mblnReadOnly Then