frmaccountinitdetail.frm

金算盘软件代码

    Dim strSQL As String
    Dim recTemp As rdoResultset
    
    strSQL = "Select Account.* ,DECODE(lngAccountNatureID,3,1,4,1,0) As blnIsARAP From Account Where lngAccountID=" & mlngAccountID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If recTemp.RowCount > 0 Then
        mblnIsQuatity = recTemp("blnIsQuantity")
        mblnIsMultCurrency = recTemp("blnIsMultCurrency")
        mblnIsAllCurrency = recTemp("blnIsAllCurrency")
        mblnIsARAP = recTemp("blnIsARAP")
        lblAccountInitDetail(3).Caption = IIf(recTemp("intDirection") = 1, "借", "贷")
        If mblnIsQuatity Then
            lblAccountInitDetail(3).top = 30
            lblAccountInitDetail(2).top = 30
            lblAccountInitDetail(5).Visible = True
            lblAccountInitDetail(4).Visible = True
            lblAccountInitDetail(5).Caption = recTemp("strQuantityUnit")
        Else
            lblAccountInitDetail(3).top = 150
            lblAccountInitDetail(2).top = 150
            lblAccountInitDetail(5).Visible = False
            lblAccountInitDetail(4).Visible = False
        End If
        With msgAccountInitDetail(0)
            For intCount = 0 To 5
                .ColWidth(intCount) = mclsListSet.ColumnWidth(intCount + 1)
            Next
            If recTemp("blnIsCustomer") = 0 Then
                .ColWidth(0) = 0
            Else
                .ColData(0) = 1
            End If
            If recTemp("blnIsDepartment") = 0 Then
                .ColWidth(1) = 0
            Else
                .ColData(1) = 1
            End If
            If recTemp("blnIsEmployee") = 0 Then
                .ColWidth(2) = 0
            Else
                .ColData(2) = 1
            End If
'            If Not recTemp("blnIsJob") Then
                .ColWidth(3) = 0
'            Else
'                .ColData(3) = 1
'            End If
            If recTemp("blnIsClass1") = 0 Then
                .ColWidth(4) = 0
            Else
                .ColData(4) = 1
            End If
            
            If recTemp("blnIsClass2") = 0 Then
                .ColWidth(5) = 0
            Else
                .ColData(5) = 1
            End If
        End With
    End If
    recTemp.Close
End Sub

'因币种改变设置GRID中金额数量列的可见性
Private Sub SetFlexGridByCurrency()
    Dim intCount As Integer
    
    With msgAccountInitDetail(0)
        For intCount = 6 To 17
            .ColWidth(intCount) = mclsListSet.ColumnWidth(intCount)
        Next
        For intCount = 6 To .Cols - 1
            .FixedAlignment(intCount) = 4
        Next
        If mbytPeriod = 1 Then
            For intCount = 9 To 17
                .ColWidth(intCount) = 0
            Next
        End If
        If Not mblnIsQuatity Then
            For intCount = 0 To 3
                .ColWidth(8 + 3 * intCount) = 0
            Next
        End If
        If mlngCurrencyID = 1 Then
            For intCount = 0 To 3
                .ColWidth(6 + 3 * intCount) = 0
            Next
        End If
        If mlngCurrencyID = 1 And Not mblnIsQuatity Then
            .TextMatrix(0, 7) = "年初余额"
            .TextMatrix(1, 7) = "年初余额"
            If mbytPeriod > 1 Then
                For intCount = 0 To 1
                    .TextMatrix(intCount, 10) = "期初借方发生"
                    .TextMatrix(intCount, 13) = "期初贷方发生"
                    .TextMatrix(intCount, 16) = "期初余额"
                Next
            End If
        Else
            For intCount = 0 To 2
                .TextMatrix(0, 6 + intCount) = "年初余额"
                If mbytPeriod > 1 Then
                    .TextMatrix(0, 9 + intCount) = "期初借方累计"
                    .TextMatrix(0, 12 + intCount) = "期初贷方累计"
                    .TextMatrix(0, 15 + intCount) = "期初余额"
                End If
            Next
            For intCount = 0 To 3
                .TextMatrix(1, 6 + 3 * intCount) = "原币"
                .TextMatrix(1, 7 + 3 * intCount) = "本位币"
                .TextMatrix(1, 8 + 3 * intCount) = "数量"
            Next
        End If
    End With
End Sub

'保存GRID列宽
Private Sub SaveListSet()
    Dim intCount As Integer
    
    With mclsListSet
        For intCount = 1 To .Columns
            If msgAccountInitDetail(0).ColWidth(intCount) > 0 Then
                .ColumnWidth(intCount) = msgAccountInitDetail(0).ColWidth(intCount)
            End If
        Next
        .SaveList
    End With
End Sub

'判定是否出现水平和垂直滚动条
Private Sub ISScroll(blnHscroll As Boolean, blnVscroll As Boolean)
    blnHscroll = IsHScroll(gclsEniv.VScrollWidth)
    blnVscroll = IsVScroll(gclsEniv.HScrollHeight)
    If blnVscroll Then
        If blnHscroll Then
            If Not IsVScroll(0) Then
                If Not IsHScroll(0) Then
                    blnHscroll = False
                    blnVscroll = False
                End If
            End If
        Else
            blnVscroll = IsVScroll(0)
        End If
    Else
        If blnHscroll Then blnHscroll = IsHScroll(0)
    End If
End Sub

'判定水平滚动条是否出现
Private Function IsHScroll(ByVal intVScrollWidth As Integer) As Boolean
    Dim i As Integer
    Dim lngSum As Long
    
    With msgAccountInitDetail(1)
        For i = 0 To .Cols - 1
            lngSum = lngSum + .ColWidth(i)
        Next
        If .width - 80 - intVScrollWidth >= lngSum Then
            IsHScroll = False
        Else
            IsHScroll = True
        End If
    End With
End Function

'判定垂直滚动条是否出现
Private Function IsVScroll(ByVal intHScrollHeight As Integer) As Boolean
    Dim lngSum As Long
    
    With msgAccountInitDetail(1)
        lngSum = .RowPos(.Rows - 1) + .RowHeight(.Rows - 1)
        If .Height - intHScrollHeight >= lngSum + 15 Then
            IsVScroll = False
        Else
            IsVScroll = True
        End If
    End With
End Function

'录入开始
Private Sub InputStart(ByVal lngRow As Long, ByVal intCol As Integer, Optional strText As String = "")
    If lstAccountInitDetail(0).ID = 0 Or lstAccountInitDetail(1).ID = 0 Then Exit Sub
    With msgAccountInitDetail(1)
        Select Case .LeftCol - intCol
            Case Is > 0
                .LeftCol = intCol
            Case Is < 0
                If intCol < .Cols - 1 Then
                    If Not .ColIsVisible(intCol + 1) Then
                        Do While Not .ColIsVisible(intCol + 1)
                            .LeftCol = .LeftCol + 1
                        Loop
                    End If
                End If
        End Select
        If .Rows - 1 = lngRow Then
            .TopRow = .TopRow + 1
        Else
            If Not .RowIsVisible(lngRow + 1) Then
                Do While Not .RowIsVisible(lngRow + 1)
                    .TopRow = .TopRow + 1
                Loop
            End If
        End If
        mlngRow = lngRow
        mintCol = intCol
        
        If Trim(.TextMatrix(mlngRow, mintCol)) = "" Then
             .TextMatrix(mlngRow, mintCol) = ""
        End If
        
        If mintCol < 6 Then
            If .ColData(mintCol) <> 1 And .TextMatrix(mlngRow, mintCol + 24) = 0 Then Exit Sub
            lstAccountInitDetail(2).top = .top + .RowPos(mlngRow)
            lstAccountInitDetail(2).Left = .Left + .ColPos(mintCol)
            lstAccountInitDetail(2).width = IIf(.ColWidth(mintCol) - 30 > 0, .ColWidth(mintCol) - 30, 30)
'            If strText = "" Then
'                lstAccountInitDetail(2).Text = .TextMatrix(mlngRow, mintCol)
'            Else
'                lstAccountInitDetail(2).Text = strText
'            End If
            lstAccountInitDetail(2).Visible = True
            On Error Resume Next
            lstAccountInitDetail(2).SetFocus
            mblnIsInput = True
        Else
            txtAccountInitDetail.top = .top + .RowPos(mlngRow)
            txtAccountInitDetail.Left = .Left + .ColPos(mintCol)
            txtAccountInitDetail.width = .ColWidth(mintCol) - 15
            If strText = "" Then
                txtAccountInitDetail.Text = .TextMatrix(mlngRow, mintCol)
            Else
                txtAccountInitDetail.Text = strText
            End If
            txtAccountInitDetail.Visible = True
            txtAccountInitDetail.SetFocus
            mintStart = Len(txtAccountInitDetail.Text)
            If strText = "" Then
                txtAccountInitDetail.SelLength = mintStart
            Else
                txtAccountInitDetail.SelStart = mintStart
            End If
            mblnIsInput = True
        End If
    End With
End Sub

'录入完成
Private Function InputFinish() As Boolean
    Dim intCount As Integer
    Dim lngID As Long
    Dim dblValue As Double
    Dim dblOldValue As Double
    
    With msgAccountInitDetail(1)
        If mblnIsInput Then
            Select Case mintCol
                Case Is <= 5
                    If .TextMatrix(mlngRow, mintCol) <> lstAccountInitDetail(2).Text Then
                        If lstAccountInitDetail(2).ID = 0 And .ColData(mintCol) = 1 Then
                            If lstAccountInitDetail(2).Text = "" Then
                                ShowMsg Me.hwnd, msgAccountInitDetail(0).TextMatrix(0, mintCol) _
                                    & "不能为空，必须选择！", vbInformation, "科目期初明细"
                                InputStart mlngRow, mintCol
                            End If
                            InputFinish = False
                            Exit Function
                        Else
                            lngID = .TextMatrix(mlngRow, mintCol + 18)
                            .TextMatrix(mlngRow, mintCol + 18) = lstAccountInitDetail(2).ID
                            If .ColData(mintCol) = 1 Then
                                For intCount = 2 To .Rows - 1
                                    If intCount <> mlngRow And .RowHeight(intCount) > 0 Then
                                        If .TextMatrix(mlngRow, 18) = .TextMatrix(intCount, 18) And .TextMatrix(mlngRow, 19) = .TextMatrix(intCount, 19) _
                                        And .TextMatrix(mlngRow, 20) = .TextMatrix(intCount, 20) And .TextMatrix(mlngRow, 21) = .TextMatrix(intCount, 21) _
                                        And .TextMatrix(mlngRow, 22) = .TextMatrix(intCount, 22) And .TextMatrix(mlngRow, 23) = .TextMatrix(intCount, 23) Then
                                            ShowMsg Me.hwnd, "辅助核算不允许相同，请重新选择！", vbInformation, Me.Caption
                                            .Text