budgetlist.frm

金算盘软件代码

    End With
End Sub

'查看变换
Private Sub ShowChange(ByVal Index As Integer)
    Dim intCount As Integer
    Dim lngRowCount As Long
    Dim intCnt As Integer
    
    With msgBudget(0)
        SaveColWidth
         For intCount = 24 To 77
            If .ColWidth(intCount) = 0 And .ColData(intCount) <> 1 Then .ColWidth(intCount) = mclsListSet.ColumnWidth(intCount - 11)
        Next
        Select Case Index
            Case 0
                For intCount = 0 To 2
                    For lngRowCount = 1 To 3
                        .ColWidth(23 + 18 * intCount + 4 * lngRowCount) = 0
                    Next lngRowCount
                    .ColWidth(23 + 18 * intCount + 17) = 0
                Next intCount
            Case 1
                For intCount = 0 To 2
                    For lngRowCount = 1 To 3
                        For intCnt = 1 To 3
                            .ColWidth(23 + 18 * intCount + 4 * (lngRowCount - 1) + intCnt) = 0
                        Next intCnt
                    Next lngRowCount
                    For intCnt = 1 To 3
                        .ColWidth(23 + 18 * intCount + 12 + intCnt) = 0
                    Next intCnt
                    .ColWidth(23 + 18 * intCount + 16) = 0
                Next intCount
            Case 2
                For intCount = 0 To 2
                    For lngRowCount = 1 To 17
                        .ColWidth(23 + 18 * intCount + lngRowCount) = 0
                    Next lngRowCount
                Next intCount
        End Select
        If mintPeriodNO = 12 Then
            .ColWidth(39) = 0
            .ColWidth(57) = 0
            .ColWidth(75) = 0
        End If
        .LeftCol = 0
    End With
    With frmMain
        .mnuListActivityMenu(mintShowStatus).Checked = False
        mintShowStatus = Index
        .mnuListActivityMenu(mintShowStatus).Checked = True
    End With
End Sub

'画MS FLEXGRID边框
Public Sub FlexGridBorder(ByVal hwnd, x1, y1, x2, y2, X3, Y3 As Long)
    Dim hdc As Long
    Dim hPen1 As Long, hPen2 As Long, hPen3 As Long, hPen4 As Long, hSavePen As Long
    Dim Point As POINTAPI
    Static lngX1 As Long, lngX2 As Long, lngX3 As Long, lngY1 As Long, lngY2 As Long, lngY3 As Long
    
    hdc = GetDC(hwnd)

    x1 = x1 / Screen.TwipsPerPixelX
    x2 = x2 / Screen.TwipsPerPixelX
    X3 = X3 / Screen.TwipsPerPixelX
    y1 = y1 / Screen.TwipsPerPixelY
    y2 = y2 / Screen.TwipsPerPixelY
    Y3 = Y3 / Screen.TwipsPerPixelY

    hPen1 = CreatePen(PS_SOLID, 1, RGB(192, 192, 192))
    hSavePen = SelectObject(hdc, hPen1)
    Rectangle hdc, lngX1 - 1, lngY1 - 1, lngX2 + 1, lngY2 + 1
    MoveToEx hdc, lngX1 - 2, lngY1 - 2, Point
    LineTo hdc, lngX2 - 1, lngY1 - 2
    MoveToEx hdc, lngX1 - 2, lngY1 - 2, Point
    LineTo hdc, lngX1 - 2, lngY2
    MoveToEx hdc, lngX1 - 2, lngY2 + 1, Point
    LineTo hdc, lngX2, lngY2 + 1
    MoveToEx hdc, lngX2 + 1, lngY1 - 2, Point
    LineTo hdc, lngX2 + 1, lngY2 + 2
    If lngX2 <> lngX3 Then
        MoveToEx hdc, lngX3, lngY1 - 2, Point
        LineTo hdc, lngX3, lngY3
    End If

    hPen2 = CreatePen(PS_SOLID, 1, RGB(128, 128, 128))
    SelectObject hdc, hPen2
    Rectangle hdc, x1 - 1, y1 - 1, x2 + 1, y2 + 1

    hPen3 = CreatePen(PS_SOLID, 1, RGB(0, 0, 0))
    SelectObject hdc, hPen3
    MoveToEx hdc, x1 - 2, y1 - 2, Point
    LineTo hdc, x2 - 1, y1 - 2
    MoveToEx hdc, x1 - 2, y1 - 2, Point
    LineTo hdc, x1 - 2, y2
    If x2 <> X3 Then
        MoveToEx hdc, X3, y1 - 2, Point
        LineTo hdc, X3, Y3
    End If

    hPen4 = CreatePen(PS_SOLID, 1, RGB(255, 255, 255))
    SelectObject hdc, hPen4
    MoveToEx hdc, x1 - 2, y2 + 1, Point
    LineTo hdc, x2, y2 + 1
    MoveToEx hdc, x2 + 1, y1 - 2, Point
    LineTo hdc, x2 + 1, y2 + 2

    SelectObject hdc, hSavePen
    DeleteObject hPen1
    DeleteObject hPen2
    DeleteObject hPen3
    DeleteObject hPen4

    ReleaseDC hwnd, hdc
    lngX1 = x1
    lngX2 = x2
    lngX3 = X3
    lngY1 = y1
    lngY2 = y2
    lngY3 = Y3
End Sub

'初始化MS FELEXGRID
Private Sub InitFlexGrid()
    Dim intCount As Integer, lngRowCount As Long
    
    With msgBudget(0)
        .Cols = 78
        For intCount = 0 To .Cols - 1
            .ColAlignment(intCount) = 4
        Next
        For intCount = 0 To 1
            .Row = intCount
            .TextMatrix(intCount, 0) = "科目"
            .TextMatrix(intCount, 1) = "商品"
            .TextMatrix(intCount, 2) = "单位"
            .TextMatrix(intCount, 3) = "部门"
            .TextMatrix(intCount, 4) = "职员"
            .TextMatrix(intCount, 5) = "工程"
            .TextMatrix(intCount, 6) = "统计"
            .TextMatrix(intCount, 7) = "项目"
            .TextMatrix(intCount, 8) = "币种"
            .TextMatrix(intCount, 9) = "商品类型"
            .TextMatrix(intCount, 10) = "单位类型"
            .TextMatrix(intCount, 11) = "地区"
        Next
        For intCount = 0 To 17
            .TextMatrix(0, 24 + intCount) = "原币"
            .TextMatrix(0, 42 + intCount) = "本币"
            .TextMatrix(0, 60 + intCount) = "数量"
        Next
        For intCount = 0 To 2
            .TextMatrix(1, 24 + 18 * intCount) = "1"
            .TextMatrix(1, 25 + 18 * intCount) = "2"
            .TextMatrix(1, 26 + 18 * intCount) = "3"
            .TextMatrix(1, 27 + 18 * intCount) = "1季度"
            .TextMatrix(1, 28 + 18 * intCount) = "4"
            .TextMatrix(1, 29 + 18 * intCount) = "5"
            .TextMatrix(1, 30 + 18 * intCount) = "6"
            .TextMatrix(1, 31 + 18 * intCount) = "2季度"
            .TextMatrix(1, 32 + 18 * intCount) = "7"
            .TextMatrix(1, 33 + 18 * intCount) = "8"
            .TextMatrix(1, 34 + 18 * intCount) = "9"
            .TextMatrix(1, 35 + 18 * intCount) = "3季度"
            .TextMatrix(1, 36 + 18 * intCount) = "10"
            .TextMatrix(1, 37 + 18 * intCount) = "11"
            .TextMatrix(1, 38 + 18 * intCount) = "12"
            .TextMatrix(1, 39 + 18 * intCount) = "13"
            .TextMatrix(1, 40 + 18 * intCount) = "4季度"
            .TextMatrix(1, 41 + 18 * intCount) = "总计"
        Next
        .MergeCells = flexMergeFree
        .MergeRow(0) = True
        .MergeRow(1) = True
        For intCount = 0 To .Cols - 1
            .MergeCol(intCount) = True
        Next
        If mintFlag = 1 Then
            .ColWidth(0) = 0
            .ColWidth(8) = 0
        Else
            .ColWidth(1) = 0
            .ColWidth(9) = 0
            .ColWidth(10) = 0
            .ColWidth(11) = 0
        End If
    End With
End Sub

'保存列宽度
Private Sub SaveColWidth()
    Dim intCount As Integer
    
    With msgBudget(0)
        For intCount = 0 To 11
            If .ColWidth(intCount) > 0 Then
                mclsListSet.ColumnWidth(intCount + 1) = .ColWidth(intCount)
            End If
        Next
        For intCount = 24 To 77
            If .ColWidth(intCount) > 0 Then
                mclsListSet.ColumnWidth(intCount - 11) = .ColWidth(intCount)
            End If
        Next
    End With
End Sub

'设置MS FELEXGRID栏目
Private Sub SetFlexGrid0()
    Dim intCount As Integer
    Dim strSql As String, recTemp As rdoResultset
    Dim intCnt As Integer, intCnt1 As Integer
    
    
    With msgBudget(0)
        For intCount = 0 To 11
            .ColWidth(intCount) = mclsListSet.ColumnWidth(intCount + 1)
        Next
        For intCount = 24 To 77
            .ColWidth(intCount) = mclsListSet.ColumnWidth(intCount - 11)
            .ColData(intCount) = 0
        Next
        For intCount = 12 To 23
            .ColWidth(intCount) = 0
        Next
        If mlngBudgetID > 0 Then
             strSql = "Select * From Budget Where lngBudgetID=" & mlngBudgetID
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTemp.EOF Then
                'If Not recTemp("blnIsAccount") Then .ColWidth(0) = 0
                'If Not recTemp("blnIsItem") Then .ColWidth(1) = 0
                'If Not recTemp("blnIsCustomer") Then .ColWidth(2) = 0
                'If Not recTemp("blnIsDepartment") Then .ColWidth(3) = 0
                'If Not recTemp("blnIsEmployee") Then .ColWidth(4) = 0
                'If Not recTemp("blnIsJob") Then .ColWidth(5) = 0
                'If Not recTemp("blnIsClass1") Then .ColWidth(6) = 0
                'If Not recTemp("blnIsClass2") Then .ColWidth(7) = 0
                'If Not recTemp("blnIsItemType") Then .ColWidth(9) = 0
                'If Not recTemp("blnIsCustomerType") Then .ColWidth(10) = 0
                'If Not recTemp("blnIsArea") Then .ColWidth(11) = 0
                If recTemp("blnIsAccount") = 0 Then .ColWidth(0) = 0
                If recTemp("blnIsItem") = 0 Then .ColWidth(1) = 0
                If recTemp("blnIsCustomer") = 0 Then .ColWidth(2) = 0
                If recTemp("blnIsDepartment") = 0 Then .ColWidth(3) = 0
                If recTemp("blnIsEmployee") = 0 Then .ColWidth(4) = 0
                If recTemp("blnIsJob") = 0 Then .ColWidth(5) = 0
                If recTemp("blnIsClass1") = 0 Then .ColWidth(6) = 0
                If recTemp("blnIsClass2") = 0 Then .ColWidth(7) = 0
                If recTemp("blnIsItemType") = 0 Then .ColWidth(9) = 0
                If recTemp("blnIsCustomerType") = 0 Then .ColWidth(10) = 0
                If recTemp("blnIsArea") = 0 Then .ColWidth(11) = 0
                If mintFlag = 0 Then
                    'If Not recTemp("blnIsQuantity") Then
                    If recTemp("blnIsQuantity") = 0 Then
                        For intCount = 60 To 77
                            .ColWidth(intCount) = 0
                            .ColData(intCount) = 1
                        Next
                    End If
                    'If Not recTemp("blnIsOriginalCurrency") Then
                    If recTemp("blnIsOriginalCurrency") = 0 Then
                        For intCount = 24 To 41
                            .ColWidth(intCount) = 0
                            .ColData(intCount) = 1
                        Next
                    End If
                    'mblnIsNatualCurrency = recTemp("blnIsNatualCurrency")
                    'mblnIsOriginalCurrency = recTemp("blnIsOriginalCurrency")
                    'mblnIsQuantity = recTemp("blnIsQuantity")
                    mblnIsNatualCurrency = IIf(recTemp("blnIsNatualCurrency") = 1, True, False)
                    mblnIsOriginalCurrency = IIf(recTemp("blnIsOriginalCurrency") = 1, True, False)
                    mblnIsQuantity = IIf(recTemp("blnIsQuantity") = 1, True, False)
                Else
                    For intCount = 0 To 2
                        mstrObjectName(intCount) = ""
                    Next
                    intCnt = 0
                    For intCount = 18 To 43
                        If recTemp.rdoColumns(intCount).Value = 1 Then
                            mstrObjectName(intCnt) = mstrName(intCount - 18)
                            intCnt = intCnt + 1