customerinitdetail.frm

金算盘软件代码

                Card.EditCard Message.msgCustom1, lngID
            Case 24
                Card.EditCard Message.msgCustom2, lngID
            Case 25
                Card.EditCard Message.msgCustom3, lngID
            Case 26
                Card.EditCard Message.msgCustom4, lngID
            Case 27
                Card.EditCard Message.msgCustom5, lngID
            Case 28
                Card.EditCard Message.msgCustom6, lngID
        End Select
        If mintCol <> 3 Then
            msgCustomerInitDetail.TextMatrix(mlngRow, mintCol) = ""
            msgCustomerInitDetail.TextMatrix(mlngRow, mintCol + 25) = "0"
        End If
        SetListText mintCol
        .SeekId lngID
        If mintCol = 3 Then
           msgCustomerInitDetail.TextMatrix(mlngRow, mintCol) = .Text
           Exit Sub
        End If
        With msgCustomerInitDetail
            For intCount = 2 To .Rows - 1
                If intCount <> mlngRow Then
                     If .TextMatrix(intCount, mintCol + 25) = lngID Then
                        .TextMatrix(intCount, mintCol + 25) = lstCustomerInitdetail(3).ID
                        .TextMatrix(intCount, mintCol) = lstCustomerInitdetail(3).Text
                    End If
                End If
            Next
        End With
        
        If mintCol = 20 Then
            CalTax lngID, mlngRow
            CalCurrTax
        End If
        If mintCol = 12 Then
            Dim recTemp As rdoResultset
            
            Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT * FROM ItemUnit WHERE lngUnitID=" & msgCustomerInitDetail.TextMatrix(mlngRow, 38))
            If Not recTemp.EOF Then
                msgCustomerInitDetail.TextMatrix(mlngRow, 13) = recTemp!strUnitName
            End If
        End If
    End With
End Sub

'设置初始化
Private Sub SetInitDetail()
    Dim intCount As Integer
    Dim intColumn(7) As Integer
    
    With msgCustomerInitDetail
        For intCount = 1 To mclsListSet.Columns
            .ColWidth(intCount - 1) = mclsListSet.ColumnWidth(intCount)
        Next
    End With
    '设置科目参照
    SetListText 30
'    lstCustomerInitdetail(0).SeekId mudtAccount.ID
    lstCustomerInitdetail(0).ReferRow = 4
    GetAccountNature mudtAccount.ID
    '设置币种参照
    SetListText 31
    If mudtAccount.IsAllCur Or mudtAccount.IsMutCur Then
        lstCustomerInitdetail(1).ReferRow = 4
    Else
        lstCustomerInitdetail(1).ReferRow = 0
    End If
'    lstCustomerInitdetail(1).SeekId mlngCurrencyID
    '设置单位参照
    SetListText 32
    lstCustomerInitdetail(2).SeekId mlngCustomerID
    GetDiscountRate mlngCustomerID
    GetDetail
    For intCount = 0 To 7
        intColumn(intCount) = GetSetting(App.title, "CusInit", "Col" & intCount, 0)
    Next intCount
    SetDefCol intColumn
End Sub

'设置MS FELEXGRID
Private Sub SetFlexGrid()
    Dim intCount As Integer, lngRowCount As Long
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim blnIsAssistant(4) As Boolean
    Dim intColumn(7) As Integer
    
    With msgCustomerInitDetail
        .AddItem "", 1
        .RowHeight(1) = 0
        For intCount = 29 To 45
            .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("blnIsJob") Then
            .ColWidth(9) = 0
'        Else
'            .ColData(9) = 1
'        End If
        If Not recTemp("blnIsClass1") Then
            .ColWidth(10) = 0
        Else
            .ColData(10) = 1
        End If
        If Not recTemp("blnIsClass2") Then
            .ColWidth(11) = 0
        Else
            .ColData(11) = 1
        End If
        recTemp.Close
        End If
        If mlngCurrencyID = 1 Then
            .ColWidth(15) = 0
            .ColWidth(19) = 0
            .ColWidth(22) = 0
        Else
            .TextMatrix(0, 18) = "原币金额"
            .TextMatrix(0, 19) = "本币金额"
            .TextMatrix(0, 21) = "原币税额"
            .TextMatrix(0, 22) = "本币税额"
        End If
        For lngRowCount = 2 To .Rows - 1
            If .TextMatrix(lngRowCount, 47) = "1" Then
                .Row = lngRowCount
                For intCount = 0 To .Cols - 1
                    .col = intCount
                    .CellBackColor = RGB(255, 255, 226)
                Next
            End If
            For intCount = 0 To 4
                If Not blnIsAssistant(intCount) Then
                    If .TextMatrix(lngRowCount, 32 + intCount) <> "0" Then
                        blnIsAssistant(intCount) = True
                    End If
                End If
            Next
        Next
        For intCount = 0 To 4
            If .ColWidth(7 + intCount) = 0 Then
                If blnIsAssistant(intCount) Then
                    .ColWidth(7 + intCount) = mclsListSet.ColumnWidth(8 + intCount + 1)
                End If
            End If
        Next
        
        strSql = "SELECT * FROM Setting WHERE strKey Like '自定项目*' Order By strKey"
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recTemp.EOF Then
        recTemp.MoveLast
        recTemp.MoveFirst
        For intCount = 0 To recTemp.RowCount / 2 - 1
            .TextMatrix(0, 23 + intCount) = recTemp("strSetting")
            recTemp.MoveNext
            If recTemp("strSetting") = "False" Then
                .ColWidth(23 + intCount) = 0
            End If
            recTemp.MoveNext
        Next
        End If
        recTemp.Close
        
        .RowHeightMin = 270
        .ColAlignment(16) = 7
        .ColAlignment(18) = 7
        .ColAlignment(19) = 7
        .ColAlignment(21) = 7
        .ColAlignment(14) = 7
        .ColAlignment(15) = 7
        .ColWidth(46) = 0
        .ColWidth(47) = 0
'        #If conVersionType = 16 Then
'            For intCount = 12 To 28
'                If intCount <> 15 And intCount <> 18 And intCount <> 19 Then
'                    .ColWidth(intCount) = 0
'                End If
'            Next
'        #End If
        mclsMainControl_ListEditMenu 0
        mlngRow = .Rows - 1
        mintCol = 0
    End With
    For intCount = 0 To 7
        intColumn(intCount) = GetSetting(App.title, "CusInit", "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 = 30
        Case 4
            getID = 31
        Case 7 To 13
            getID = 25 + intCol
        Case 20
            getID = 39
        Case 23 To 28
            getID = 17 + intCol
        Case Else
            getID = 0
    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
    Dim strQuantity As String
    Dim dblFactor As Double
    Dim dblOldFactor 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