customerinitdetail1.frm

金算盘软件代码

            .ColWidth(intCount) = 0
        Next
        For intCount = 1 To mclsListSet.Columns
            .ColWidth(intCount - 1) = mclsListSet.ColumnWidth(intCount)
        Next
        For intCount = 0 To 2
            .ColWidth(intCount + 4) = 0
        Next
        strSql = "Select * From Account Where lngAccountID=" & mudtAccount.ID
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recTemp.EOF Then
        If Not recTemp("blnIsDepartment") Then
            .ColWidth(7) = 0
        Else
            .ColData(7) = 1
        End If
        If Not recTemp("blnIsEmployee") Then
            .ColWidth(8) = 0
        Else
            .ColData(8) = 1
        End If
        If Not recTemp("blnIsClass1") Then
            .ColWidth(9) = 0
        Else
            .ColData(9) = 1
        End If
        If Not recTemp("blnIsClass2") Then
            .ColWidth(10) = 0
        Else
            .ColData(10) = 1
        End If
        recTemp.Close
        End If
        If mlngCurrencyID = 1 Then
            .ColWidth(11) = 0
            .ColWidth(12) = 0
        End If
        For lngRowCount = 2 To .Rows - 1
            If .TextMatrix(lngRowCount, 22) Then
                .Row = lngRowCount
                For intCount = 0 To .Cols - 1
                    .col = intCount
                    .CellBackColor = RGB(255, 255, 226)
                Next
            End If
            For intCount = 0 To 3
                If Not blnIsAssistant(intCount) Then
                    If .TextMatrix(lngRowCount, 18 + intCount) <> "0" Then
                        blnIsAssistant(intCount) = True
                    End If
                End If
            Next
        Next
        For intCount = 0 To 3
            If .ColWidth(7 + intCount) = 0 Then
                If blnIsAssistant(intCount) Then
                    .ColWidth(7 + intCount) = mclsListSet.ColumnWidth(8 + intCount + 1)
                End If
            End If
        Next
        .RowHeightMin = 270
        .ColAlignment(11) = 7
        .ColAlignment(12) = 7
        .ColAlignment(13) = 7
        .ColAlignment(14) = 7
        mclsMainControl_ListEditMenu 0
        mlngRow = .Rows - 1
        mintCol = 0
    End With
    For intCount = 0 To 7
        intColumn(intCount) = GetSetting(App.title, "CusInit1", "Col" & intCount, 0)
    Next intCount
    SetDefCol intColumn
End Sub

'保存FLEXGRID列宽
Private Sub SaveListSet()
    Dim intCount As Integer
    
    With mclsListSet
        For intCount = 1 To .Columns
            If msgCustomerInitDetail.ColWidth(intCount - 1) > 0 Then
                .ColumnWidth(intCount) = msgCustomerInitDetail.ColWidth(intCount - 1)
            End If
        Next
    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 msgCustomerInitDetail
        For i = 1 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 msgCustomerInitDetail
        lngSum = .Rows * .RowHeight(0)
        If .Height - intHScrollHeight >= lngSum + 15 Then
            IsVScroll = False
        Else
            IsVScroll = True
        End If
    End With
End Function

'重画Form
Private Sub RedrawForm()
    '重画其余控件
    #If conVersionType = 1 Or conVersionType = 16 Then
        lstCustomerInitdetail(1).width = Me.ScaleWidth - lstCustomerInitdetail(1).Left - ListFormBottom - 30
    #Else
        #If conVersionType = 4 Then
            lstCustomerInitdetail(2).width = 2895
            lblCustomerInit(0).Left = 3960
            lstCustomerInitdetail(0).Left = 4740
            lstCustomerInitdetail(0).width = Me.ScaleWidth - lstCustomerInitdetail(0).Left - ListFormBottom - 30
        #Else
        
        #End If
    #End If
    cmdCustomerInitDetail(0).top = Me.ScaleHeight - cmdCustomerInitDetail(0).Height - ListFormBottom
    cmdCustomerInitDetail(1).top = cmdCustomerInitDetail(0).top
    cmdCustomerInitDetail(2).top = cmdCustomerInitDetail(0).top
    cmdCustomerInitDetail(3).top = cmdCustomerInitDetail(0).top
    cmdCustomerInitDetail(4).top = cmdCustomerInitDetail(0).top
    cmdCustomerInitDetail(5).top = cmdCustomerInitDetail(0).top
    cmdCustomerInitDetail(6).top = cmdCustomerInitDetail(0).top
    '重画MS FlexGrid 控件
    With msgCustomerInitDetail
        .width = Me.ScaleWidth - ListFormLeft - ListFormRight
        .Height = Me.ScaleHeight - ListUpAreaHeight - ListDownAreaHeight ' + 360
    End With
    ISScroll mblnHscroll, mblnVscroll
End Sub

'得到ID
Private Function getID(ByVal intCol As Integer) As Integer
    Select Case intCol
        Case 1
            getID = 16
        Case 4
            getID = 17
        Case 7 To 10
            getID = 11 + intCol
    End Select
End Function

'改变ID
Private Sub ChangeID(ByVal intCol As Integer, intID As Integer)
    With msgCustomerInitDetail
        If lstCustomerInitdetail(3).Text <> .TextMatrix(mlngRow, intCol) Then
            .TextMatrix(mlngRow, intID) = lstCustomerInitdetail(3).ID
        End If
    End With
End Sub

'输入完成
Private Function InputFinish() As Boolean
    Dim intCount As Integer
    Dim dblValue As Double
    Dim dblOldValue As Double
    
    With msgCustomerInitDetail
        Select Case True
            Case mblnIsInput(0)
                If .TextMatrix(mlngRow, mintCol) = gacCustomerInitDetail.Text Then
                    InputFinish = True
                    gacCustomerInitDetail.Visible = False
                    mblnIsInput(0) = False
                    Exit Function
                End If
                Select Case mintCol
                    Case 0
                        If Trim(gacCustomerInitDetail.Text) >= mstrStartDate Then
                            ShowMsg Me.hwnd, "该日期必须小于帐套的启用期间的开始日期" & mstrStartDate & "，请重新输入！", vbOKOnly + vbInformation, Me.Caption
                            FlexInput mlngRow, mintCol
                            InputFinish = False
                            Exit Function
                        End If
                        If .TextMatrix(mlngRow, 5) = "" Then .TextMatrix(mlngRow, 5) = gacCustomerInitDetail.Text
                        If .TextMatrix(mlngRow, 6) = "" Then .TextMatrix(mlngRow, 6) = gacCustomerInitDetail.Text
                    Case 5
                        If gacCustomerInitDetail.Text <> "" Then
                            If .TextMatrix(mlngRow, 6) = "" Then
                                If .Cols >= 32 Then
                                    If .TextMatrix(mlngRow, 31) > 0 Then
                                        .TextMatrix(mlngRow, 6) = GetDueDate(gacCustomerInitDetail.Text, .TextMatrix(mlngRow, 31))
                                    End If
                                End If
                            Else
                                If Trim(gacCustomerInitDetail.Text) > .TextMatrix(mlngRow, 6) Then
                                    ShowMsg Me.hwnd, "开票日期必须小于到期日期，请重新输入！", vbOKOnly + vbInformation, Me.Caption
                                    gacCustomerInitDetail.SetFocus
                                    InputFinish = False
                                    Exit Function
                                End If
                            End If
                        End If
                    Case 6
                        If gacCustomerInitDetail.Text <> "" And .TextMatrix(mlngRow, 5) <> "" Then
                            If Trim(gacCustomerInitDetail.Text) < .TextMatrix(mlngRow, 5) Then
                                ShowMsg Me.hwnd, "到期日期必须大于开票日期，请重新输入！", vbOKOnly + vbInformation, Me.Caption
                                gacCustomerInitDetail.SetFocus
                                InputFinish = False
                                Exit Function
                            End If
                        End If
                End Select
                gacCustomerInitDetail.Visible = False
                .TextMatrix(mlngRow, mintCol) = gacCustomerInitDetail.Text
                If mintCol = 5 Then CalDueDate mlngRow, .TextMatrix(mlngRow, 17)
                mblnIsInput(0) = False
                If .TextMatrix(mlngRow, 15) = "0" Then
                    .RowData(mlngRow) = 1
                Else
                    .RowData(mlngRow) = 2
                End If
            Case mblnIsInput(1)
                If .TextMatrix(mlngRow, mintCol) = tedCustomerInitDetail.Text Then
                    tedCustomerInitDetail.Visible = False
                    mblnIsInput(1) = False
                    InputFinish = True
                    Exit Function
                End If
                tedCustomerInitDetail.Visible = False
                .TextMatrix(mlngRow, mintCol) = tedCustomerInitDetail.Text
                mblnIsInput(1) = False
                If .TextMatrix(mlngRow, 15) = "0" Then
                    .RowData(mlngRow) = 1
                Else
                    .RowData(mlngRow) = 2
                End If
            Case mblnIsInput(3)
                If .TextMatrix(mlngRow, mintCol) = "" Then
                    dblOldValue = 0
                Else
                    dblOldValue = CDbl(.TextMatrix(mlngRow, mintCol))
                End If
                If calCustomerInitDetail.Text = "" Or Not IsNumeric(calCustomerInitDetail.Text) Then
                    dblValue = 0
                Else
                    dblValue = CDbl(calCustomerInitDetail.Text)
                End If
                If dblValue = dblOldValue Then
                    InputFinish = True
                    calCustomerInitDetail.Visible = False
                    mblnIsInput(3) = False
                    Exit Function
                End If
                Select Case mintCol
                    Case 2
                        If dblValue > 9999 Or dblValue < 1 Then
                            ShowMsg Me.hwnd, "凭证号必须为0001至9999的整数,请重新输入！", vbOKOnly + vbInformation, Me.Caption
                            InputFinish = False
                            calCustomerInitDetail.SetFocus
                            Exit Function
                        End If
                    Case 11
                        If dblValue <= 0 Then
                            ShowMsg Me.hwnd, "汇率必须大于0,请重新输入！", vbOKOnly + vbInformation, Me.Caption
                            InputFinish = False
                            calCustomerInitDetail.SetFocus
                            Exit Function
                        End If
                    Case 13, 14
                        Dim dblCurrValue As Double
                        
                        If .TextMatrix(mlngRow, 12) = "" Then
                            dblCurrValue = 0
                        Else
                            dblCurrValue = CDbl(.TextMatrix(mlngRow, 18))
                        End If
                        If dblValue * dblCurrValue < 0 Then
                            ShowMsg Me.hwnd, "本币金额与原币金额符号比须一致！", vbInformation, Me.Caption
                            InputFinish = False
                            calCustomerInitDetail.SetFocus
                            Exit Function
                        End If
                End Select
                calCustomerInitDetail.Visible = False
                If dblValue = 0 Then
                    .TextMatrix(mlngRow, mintCol) = ""
                Else
                    Select Case mintCol
                        Case 2
                            .TextMatrix(mlngRow, mintCol) = Format(dblValue, "0000")
                        Case 11
                            .TextMatrix(mlngRow, mintCol) = Format(dblValue, mstrRateDec)
                        Case 12
                            .TextMatrix(mlngRow, mintCol) = Format(dblValue, mstrCurrencyDec)
                        Case 13
                            .TextMatrix(mlngRow, mintCol) = Format(dblValue, mstrDec)
                            .TextMatrix(mlngRow, 14) = ""
                            If mlngCurrencyID = 1 Then .TextMatrix(mlngRow, 12) = .TextMatrix(mlngRow, 13)
                        Case 14
                            .TextMatrix(mlngRow, mintCol) = Format(dblValue, mstrDec)
                            .TextMatrix(mlngRow, 13) = ""
                            If mlngCurrencyID = 1 Then .TextMatrix(mlngRow, 12) = .TextMatrix(mlngRow, 14)
                    End Select