frmaccountinit.frm

金算盘软件代码

        Select Case col
            Case 6, 9, 12
                intCol = 6
            Case 7, 10, 13
                intCol = 7
            Case 8, 11, 14
                intCol = 8
        End Select
        For intCount = 0 To 2
            If mlngRow = Row And mintCol = intCol + 3 * intCount Then
                dblValue(intCount) = dblNew
            Else
                If Trim(.CellValue(Row, intCol + 3 * intCount)) = "" Or IsNull(.CellValue(Row, intCol + 3 * intCount)) Then
                    dblValue(intCount) = 0
                Else
                    dblValue(intCount) = CDbl(.CellValue(Row, intCol + 3 * intCount))
                End If
            End If
        Next intCount
        Select Case .CellValue(Row, 3)
            Case "借"
                dblValue(3) = dblValue(0) + dblValue(1) - dblValue(2)
            Case "贷"
                dblValue(3) = dblValue(0) - dblValue(1) + dblValue(2)
            Case ""
                For intCount = Row - 1 To 1 Step -1
                    If .CellValue(intCount, 3) = "借" Then
                        dblValue(3) = dblValue(0) + dblValue(1) - dblValue(2)
                        Exit For
                    End If
                    If .CellValue(intCount, 3) = "贷" Then
                        dblValue(3) = dblValue(0) - dblValue(1) + dblValue(2)
                        Exit For
                    End If
                Next
        End Select
        If dblValue(3) = 0 Then
            .CellFormula(Row, 9 + intCol) = ""
        Else
            Select Case intCol
                Case 6
                    .CellFormula(Row, intCol + 9) = Format(dblValue(3), IIf(.CellValue(Row, 18) = 0, "#,###,###,###", "#,###,###,##0." + String(.CellValue(Row, 18), "0")))
                Case 7
                    .CellFormula(Row, intCol + 9) = Format(dblValue(3), mstrDec)
                Case 8
                    '.CellFormula(Row, intCol + 9) = Format(dblValue(3), mstrQuantityDec)
                    .CellFormula(Row, intCol + 9) = dblValue(3)
                    .SetCellDataType Row, intCol + 9, Row, intCol + 9, 1, 1, gclsBase.QuantityDec, -1
            End Select
        End If
    End With
End Sub

'重计算上级编码余额(仅限于本位币)
Private Sub ReCalPrefix(ByVal Level As Integer, ByVal Flag As Integer, ByVal dblSub1 As Double, ByVal dblSub2 As Double)
    Dim dblValue As Double
    Dim intCount As Integer
    Dim intLevel As Integer
    Dim intFlag As Integer
    Dim blnIsFind As Boolean
    Dim blnIsExecute As Boolean
    Dim blnIsDone(20) As Boolean
    
    intCount = 1
    
    With mGrid
        Do
            If mlngRow - intCount < 1 Then Exit Do
            intLevel = .CellValue(mlngRow - intCount, 20)
            intFlag = .CellValue(mlngRow - intCount, 19)
            If Not blnIsFind Then
                If Flag = 6 Then
                    If intFlag = 4 Then
                        blnIsFind = True
                        blnIsExecute = True
                    End If
                End If
            End If
            If intLevel < Level Or blnIsExecute Then
                If Not blnIsDone(intLevel) Then
                    If Trim(.CellValue(mlngRow - intCount, mintCol)) = "" Then
                        dblValue = 0
                    Else
                        dblValue = CDbl(IIf(IsNull(.CellValue(mlngRow - intCount, mintCol)), 0, .CellValue(mlngRow - intCount, mintCol)))
                    End If
                    If mintCol = 7 And .CellValue(mlngRow - intCount, 3) = "贷" Then
                        dblValue = dblValue - dblSub1
                    Else
                        dblValue = dblValue + dblSub1
                    End If
                    If dblValue = 0 Then
                        .CellFormula(mlngRow - intCount, mintCol) = " "
                    Else
                        .CellFormula(mlngRow - intCount, mintCol) = Format(dblValue, mstrDec)
                    End If
                    If Trim(.CellValue(mlngRow - intCount, 16)) = "" Then
                        dblValue = 0
                    Else
                        dblValue = CDbl(IIf(IsNull(.CellValue(mlngRow - intCount, 16)), 0, .CellValue(mlngRow - intCount, 16)))
                    End If
                    If .CellValue(mlngRow - intCount, 3) = "借" Then
                        dblValue = dblValue + dblSub2
                    Else
                        dblValue = dblValue - dblSub2
                    End If
                    If dblValue = 0 Then
                        .CellFormula(mlngRow - intCount, 16) = " "
                    Else
                        .CellFormula(mlngRow - intCount, 16) = Format(dblValue, mstrDec)
                    End If
                    blnIsExecute = False
                    blnIsDone(intLevel) = True
                End If
            End If
            intCount = intCount + 1
            If Flag = 6 And Level = 1 Then
                If blnIsFind Then Exit Do
            Else
                If intLevel = 1 Then Exit Do
            End If
        Loop
    End With
End Sub

'设置Grid
Private Sub SetFlexGrid()
    Dim intCount As Integer, lngRowCount As Long
    Dim blnMutiCurr As Boolean
    
    With mGrid
        .ClipCell = 1
        '.Control = -11
        .SetBorder 0, 0, 1 + 2
        .SetColBorder 0, .Cols - 1, 1, 0, 1 + 2
        .SelectionMode = 1
        .FixedRows = 2
        .ResizeCol = 1
        .SetOption -1, -1, 0, -1, -1, -1, -1, -1
        .FixedCols = 0
        .SetCellForeColor 0, 0, 1, .Cols - 1, RGB(0, 0, 0)
        .SetCellPattern 0, 0, 1, .Cols - 1, 0, RGB(192, 192, 192), -1, -1

        For intCount = 1 To mclsListSet.Columns
            .ColWidth(intCount) = mclsListSet.ColumnWidth(intCount) / Screen.TwipsPerPixelX
        Next
        .ColWidth(0) = 0
        
        .CellFormula(0, 1) = "科目编码"
        .CellFormula(0, 2) = "科目名称"
        .CellFormula(0, 3) = "方向"
        .CellFormula(0, 4) = "币种"
        .CellFormula(0, 5) = "单位"
        .SetCellAlignment 0, 0, 0, 5, -1, -1, -1, 1, -1
        .CellFormula(0, 6) = "年初余额"
        .SetCellAlignment 0, 6, 0, 6, -1, -1, -1, -1, 2
        If mbytPeriod > 1 Then
            .CellFormula(0, 9) = "期初借方累计"
            .SetCellAlignment 0, 9, 0, 9, -1, -1, -1, -1, 2
            .CellFormula(0, 12) = "期初贷方累计"
            .SetCellAlignment 0, 12, 0, 12, -1, -1, -1, -1, 2
            .CellFormula(0, 15) = "期初余额"
            .SetCellAlignment 0, 15, 0, 15, -1, -1, -1, -1, 2
        End If
        
        
        If mbytPeriod = 1 Then
            .CellFormula(1, 6) = "原币"
            .CellFormula(1, 7) = "本位币"
            .CellFormula(1, 8) = "数量"
        Else
            For intCount = 0 To 3
                .CellFormula(1, 6 + 3 * intCount) = "原币"
                .CellFormula(1, 7 + 3 * intCount) = "本位币"
                .CellFormula(1, 8 + 3 * intCount) = "数量"
            Next
        End If
        
        .SetColAlignment 6, .Cols - 1, 3, -1, -1, -1, -1
        .SetRowAlignment 0, 1, 2, -1, -1, -1, -1
        '有问题
        .SetColDataType 6, 17, 1, 1, 2, -1
        
        If mbytPeriod = 1 Then
            For intCount = 1 To 3
                .ColWidth(6 + 3 * intCount) = 0
                .ColWidth(7 + 3 * intCount) = 0
                .ColWidth(8 + 3 * intCount) = 0
            Next
        End If
        
        .ColWidth(.Cols - 1) = 0
        .ColWidth(.Cols - 2) = 0
        .ColWidth(.Cols - 3) = 0
        .ColWidth(.Cols - 4) = 0
        .ColWidth(.Cols - 5) = 0
        .SetColProtect .Cols, .Cols, -1, 1
        
        For intCount = 6 To .Cols - 1
            .ColControl(intCount) = -11
        Next intCount
        
    End With
    SetCellColor 2, 100
End Sub

'重画Form
Private Sub RedrawForm()
    Dim intCount As Integer
    
    On Error GoTo ErrHandle
    '重画其余控件
    txtFind.width = Me.ScaleWidth - txtFind.Left - ListFormBottom - cmdAccountInit(2).width - 15
    cmdAccountInit(2).Left = txtFind.Left + txtFind.width
    cmdAccountInit(0).top = Me.ScaleHeight - cmdAccountInit(0).Height - ListFormBottom
    cmdAccountInit(1).top = cmdAccountInit(0).top
    cmdAccountInit(3).top = cmdAccountInit(0).top
    For intCount = 2 To 7
        Label1(intCount).top = 120 + cmdAccountInit(0).top
    Next
    chkAccountInit.top = cmdAccountInit(0).top + 60
    chkAccountInit.Left = Me.ScaleWidth - chkAccountInit.width - ListFormBottom
    '重画DBGrid
    With picInit
        .width = Me.ScaleWidth - 150
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight
    End With
    Exit Sub
ErrHandle:
End Sub

'初始化查找列表框
Private Sub InitcboFind()
    cboFind.AddItem "科目编码"
    cboFind.AddItem "科目名称"
    cboFind.ListIndex = 0
End Sub

Private Sub cboFind_Click()
  Dim intCol As Integer
    If Not mblnLoad Then
       Exit Sub
    End If
    If mGrid.Row < 2 Then
       Exit Sub
    End If
    mblnNotFind = True
    intCol = cboFind.ListIndex + 1
    txtFind.Text = mGrid.CellValue(mGrid.Row, intCol)
    mblnNotFind = False
End Sub

Private Sub chkAccountInit_Click()
    If chkAccountInit.Value = True Then
       mGrid.EnterDirection = 2
    Else
       mGrid.EnterDirection = 4
    End If
End Sub

Private Sub cmdAccountInit_Click(Index As Integer)
    Dim strWhere As String
    Dim blnFlag As Boolean
    
    Select Case Index
        Case 0  '筛选
            'InputFinish
            If mclsListSet.ListID < 1 Then mclsListSet.SaveList
            strWhere = Filter.ShowFilter(mclsListSet.ListID, 1, , , , , blnFlag)
            If blnFlag Then
                mstrWhere = strWhere
                GetList
                SetFlexGrid
            End If
        Case 1  '试算平衡
            Me.MousePointer = vbHourglass
            frmMain.Enabled = False
            frmAccountEquation.ShowCard mstrDec, mstrDate, mintYear
            Me.MousePointer = vbDefault
            frmMain.Enabled = True
        Case 2
            FindText txtFind.Text, True
        Case 3
            mclsMainControl_FilePrint
    End Select
End Sub

Private Sub Form_Activate()
    Dim vntMessage As Variant