frmin_pztypelist.frm

一个用VB写的财务软件源码

    Set frmUSU_KmHelp = Nothing
    frmUSU_KmHelp.MultiSelNode = True
    frmUSU_KmHelp.ubSelAll = True
    Load frmUSU_KmHelp
    frmUSU_KmHelp.Show 1, Me
    If frmUSU_KmHelp.Valid Then
'        If txtTemp.text <> "" Then
'            txtTemp.text = txtTemp.text & "," & frmUSU_KmHelp.strChk
'        Else
            txtTemp.text = frmUSU_KmHelp.strChk
        'End If
    End If
    Unload frmUSU_KmHelp
    Set frmUSU_KmHelp = Nothing
End Sub

Private Sub cmdKmList_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyLeft
            If mfgPzType.col > 0 Then mfgPzType.col = mfgPzType.col - 1
        Case vbKeyRight
            If mfgPzType.col < mfgPzType.Cols - 1 Then mfgPzType.col = mfgPzType.col + 1
        Case vbKeyUp
            If mfgPzType.row > 1 Then mfgPzType.row = mfgPzType.row - 1
        Case vbKeyDown
            If mfgPzType.row < mfgPzType.Rows - 1 Then mfgPzType.row = mfgPzType.row + 1
    End Select
    KeyCode = 0
End Sub

Private Sub cmdUp_Click()
    Dim grdSary(4) As String
    Dim i As Integer
    
    If mfgPzType.row = 0 Then Exit Sub
    With mfgPzType
        If .row = 1 Then
            cmdUp.Enabled = False
            cmdDown.Enabled = True
        Else
            For i = 0 To .Cols - 1
                grdSary(i) = .TextMatrix(.row, i)
            Next i
            For i = 0 To .Cols - 1
                .TextMatrix(.row, i) = .TextMatrix(.row - 1, i)
            Next i
            For i = 0 To .Cols - 1
                .TextMatrix(.row - 1, i) = grdSary(i)
            Next i
            Select Case .col
                Case 0, 1, 3
                    txtTemp.text = .TextMatrix(.row, .col)
                Case 2
                    cboPzType.text = .TextMatrix(.row, .col)
            End Select
            .row = .row - 1
            If .row = 1 Then
                cmdUp.Enabled = False
                cmdDown.Enabled = True
            End If
        End If
    End With
    mfgPzType.SetFocus
    If txtTemp.Visible Or cboPzType.Visible Then mfgPzType_Click
    
End Sub

Private Sub form_load()
    Dim i As Integer
    bChk = True
    FrmAct = False
    Set rSt = New ADODB.Recordset
    rSt.CursorLocation = adUseClient
    rSt.Open "select * from tZw_Type" & glo.sOperateYear & " order by SignID", glo.cnnMain, adOpenStatic, adLockOptimistic
    If Not rSt.BOF Then rSt.MoveFirst
    With mfgPzType
        .ColWidth(0) = 1000
        .ColWidth(1) = 1300
        .ColWidth(2) = 1300
        .ColWidth(3) = 3150
        .RowHeight(0) = 270
        cboPzType.Width = .ColWidth(2)
        
        For i = 0 To 3
            .row = 0
            .col = i
            .CellFontBold = True
            .CellAlignment = 4
        Next i
        .ColAlignment(3) = 1
        
        .TextMatrix(0, 0) = "类别字"
        .TextMatrix(0, 1) = "类别名称"
        .TextMatrix(0, 2) = "限制类型"
        .TextMatrix(0, 3) = "限制科目"
        
        mfgPzType.Rows = rSt.RecordCount + 1
        For i = 1 To .Rows - 1
            .RowHeight(i) = 300
        Next i
        
        For i = 1 To rSt.RecordCount
            .TextMatrix(i, 0) = rSt.Fields("sign")
            .TextMatrix(i, 1) = rSt.Fields("signtext")
            If Not IsNull(rSt.Fields("jfbykm")) Then
                .TextMatrix(i, 2) = cboPzType.List(0)
                .TextMatrix(i, 3) = rSt.Fields("jfbykm")
            ElseIf Not IsNull(rSt.Fields("jfbwkm")) Then
                .TextMatrix(i, 2) = cboPzType.List(1)
                .TextMatrix(i, 3) = rSt.Fields("jfbwkm")
            ElseIf Not IsNull(rSt.Fields("dfbykm")) Then
                .TextMatrix(i, 2) = cboPzType.List(2)
                .TextMatrix(i, 3) = rSt.Fields("dfbykm")
            ElseIf Not IsNull(rSt.Fields("dfbwkm")) Then
                .TextMatrix(i, 2) = cboPzType.List(3)
                .TextMatrix(i, 3) = rSt.Fields("dfbwkm")
            ElseIf Not IsNull(rSt.Fields("pzbykm")) Then
                .TextMatrix(i, 2) = cboPzType.List(4)
                .TextMatrix(i, 3) = rSt.Fields("pzbykm")
            ElseIf Not IsNull(rSt.Fields("pzbwkm")) Then
                .TextMatrix(i, 2) = cboPzType.List(5)
                .TextMatrix(i, 3) = rSt.Fields("pzbwkm")
            Else
                .TextMatrix(i, 2) = cboPzType.List(6)
            End If
            rSt.MoveNext
        Next i
'        .Row = .Rows - 1
        .row = 0
        .col = 0
        If .Rows = 1 Then
            tbrPzType.Buttons("Delete").Enabled = False
            tbrPzType.Buttons("Save").Enabled = False
            mnuDelete.Enabled = False
            mnuSave.Enabled = False
        End If
    End With
    tbrPzType.Buttons("Cancel").Enabled = False
    mnuCancel.Enabled = False
    
'    mfgPzType_Click
    FrmAct = True
    MousePointer = vbDefault
    Cell1.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    rSt.Close
    Set rSt = Nothing
End Sub

Private Sub mfgPzType_Click()
    Dim i As Integer
    
    If mfgPzType.row = 0 Then Exit Sub
    If mfgPzType.row <> 1 Then
        cmdUp.Enabled = True
    Else
        cmdUp.Enabled = False
    End If
    If mfgPzType.row <> mfgPzType.Rows - 1 Then
        cmdDown.Enabled = True
    Else
        cmdDown.Enabled = False
    End If
    If AddFlag Then GoTo 100        '增加状态
    rSt.Filter = "signtext='" & mfgPzType.TextMatrix(mfgPzType.row, 1) & "'"
    rSt.Requery
    If rSt.BOF And rSt.EOF Then GoTo 100
    If IsNull(rSt.Fields("otheruse")) Then GoTo 100
    '有误
    If rSt.Fields("otheruse") Then
    '========
        lblUse.Visible = True
        txtTemp.Visible = False
        cboPzType.Visible = False
        cmdKmList.Visible = False
    Else
100:
        lblUse.Visible = False
        With mfgPzType
            If .col = 2 Then
                cboPzType.Visible = True
                txtTemp.Visible = False
                cmdKmList.Visible = False
                cboPzType.Top = .CellTop + .Top + Frame1.Top
                cboPzType.Left = .CellLeft + .Left + Frame1.Left
                cboPzType.Width = .cellWidth
                For i = 0 To cboPzType.ListCount - 1
                    If cboPzType.List(i) = .TextMatrix(.row, .col) Then Exit For
                Next i
                If i = cboPzType.ListCount Then
                    cboPzType.text = ""
                Else
                    cboPzType.ListIndex = i
                End If
                'If cboPzType.Visible = True Then cboPzType.SetFocus
            ElseIf Not (.col = 3 And Trim$("" & .TextMatrix(.row, 2)) = "无限制") Then
                cboPzType.Visible = False
                txtTemp.Visible = True
                txtTemp.Top = .CellTop + .Top + Frame1.Top
                txtTemp.Left = .CellLeft + .Left + Frame1.Left
                txtTemp.Width = .cellWidth
                txtTemp.Height = .cellHeight
                txtTemp = Trim$("" & .TextMatrix(.row, .col))
                Select Case .col
                    Case 0
                        txtTemp.MaxLength = 4
                    Case 1
                        txtTemp.MaxLength = 40
                    Case 3
                        txtTemp.MaxLength = 60
                End Select
                If .col = 3 Then
                    cmdKmList.Top = txtTemp.Top
                    cmdKmList.Left = .Left + .CellLeft + Frame1.Left + .cellWidth - cmdKmList.Width
                    cmdKmList.Visible = True
                Else
                    cmdKmList.value = False
                End If
                txtTemp.SelStart = 0
                txtTemp.SelLength = Len(txtTemp)
'                txtTemp.SetFocus
            End If
        End With
    End If
    If rSt.State = adStateOpen Then rSt.Close
    rSt.Open "select * from tZW_Type" & glo.sOperateYear, glo.cnnMain, adOpenStatic, adLockOptimistic

End Sub

Private Sub mfgPzType_EnterCell()
    Dim i As Integer
    
    
    txtTemp.MaxLength = 0
    If mfgPzType.col = 0 Then
        If Not IsUsed(mfgPzType.text) Then Exit Sub
        txtTemp.Tag = mfgPzType.text
    End If
    If txtTemp.Visible And FrmAct Then txtTemp = mfgPzType.TextMatrix(mfgPzType.row, mfgPzType.col)
    If cboPzType.Visible And FrmAct Then
        For i = 0 To cboPzType.ListCount - 1
            If cboPzType.List(i) = mfgPzType.TextMatrix(mfgPzType.row, mfgPzType.col) Then Exit For
        Next i
        If i = cboPzType.ListCount Then
            cboPzType.text = ""
        Else
            cboPzType.ListIndex = i
        End If
    End If

End Sub


Private Sub mfgPzType_KeyPress(KeyAscii As Integer)
    Dim i As Integer
    
    If AddFlag Then GoTo 100
    rSt.Filter = "signtext='" & mfgPzType.TextMatrix(mfgPzType.row, 1) & "'"
    rSt.Requery
    If rSt.BOF And rSt.EOF Then GoTo 100
    If IsNull(rSt.Fields("otheruse").value) Then GoTo 100
    If rSt.Fields("otheruse") Then
        lblUse.Visible = True
        txtTemp.Visible = False
        cboPzType.Visible = False
        cmdKmList.Visible = False
        tbrPzType.Buttons("Delete").Enabled = False
        tbrPzType.Buttons("Save").Enabled = False
        mnuDelete.Enabled = False
        mnuSave.Enabled = False
    Else
100:
        lblUse.Visible = False
        tbrPzType.Buttons("Save").Enabled = True
        mnuSave.Enabled = True
        With mfgPzType
            If .col = 2 Then
                cboPzType.Visible = True
                txtTemp.Visible = False
                cmdKmList.value = False
                cboPzType.Top = .CellTop + .Top + Frame1.Top
                cboPzType.Left = .CellLeft + .Left + Frame1.Left
                cboPzType.Width = .cellWidth
                For i = 0 To cboPzType.ListCount - 1
                    If cboPzType.List(i) = .TextMatrix(.row, .col) Then Exit For
                Next i
                If i = cboPzType.ListCount Then
                    cboPzType.text = ""
                Else
                    cboPzType.ListIndex = i
                End If
                If cboPzType.Visible = True Then cboPzType.SetFocus
            ElseIf Not (.col = 3 And Trim$("" & .TextMatrix(.row, 2)) = "无限制") Then
                cboPzType.Visible = False
                txtTemp.Visible = True
                txtTemp.Top = .CellTop + .Top + Frame1.Top
                txtTemp.Left = .CellLeft + .Left + Frame1.Left
                txtTemp.Width = .cellWidth
                txtTemp.Height = .cellHeight
                txtTemp = Trim$("" & .TextMatrix(.row, .col))
                Select Case .col
                    Case 0
                        txtTemp.MaxLength = 4
                    Case 1
                        txtTemp.MaxLength = 40
                    Case 3
                        txtTemp.MaxLength = 60
                End Select
                If .col = 3 Then
                    cmdKmList.Top = txtTemp.Top
                    cmdKmList.Left = .CellLeft + .Left + Frame1.Left + .cellWidth - cmdKmList.Width
                    cmdKmList.Visible = True
                Else
                    cmdKmList.Visible = False
                End If
                txtTemp.SelStart = 0
                txtTemp.SelLength = Len(txtTemp.text)
                If txtTemp.Visible = True Then txtTemp.SetFocus
            End If
        End With
    End If

End Sub

Private Sub mfgPzType_LeaveCell()
    If txtTemp.Visible Then
        With mfgPzType
            .TextMatrix(.row, .col) = txtTemp.text
        End With
    ElseIf cboPzType.Visible Then
        With mfgPzType
            .TextMatrix(.row, .col) = cboPzType.text
        End With
    End If
    If Not AddFlag Then
        If mfgPzType.col = 3 Then
            txtTemp.Visible = False
            cmdKmList.Visible = False
            If Trim$("" & mfgPzType.TextMatrix(mfgPzType.row, 3)) = "" Then mfgPzType.TextMatrix(mfgPzType.row, 2) = cboPzType.List(6)
        End If
    End If
    txtTemp.Visible = False
    cboPzType.Visible = False
End Sub

Private Sub mfgPzType_RowColChange()
    If FrmAct Then
        mfgPzType_Click
    End If
End Sub

Private Sub mfgPzType_Scroll()
    cboPzType.Visible = False
    txtTemp.Visible = False
End Sub

Private Sub mnuCancel_Click()
    Call Operate("CANCEL")
End Sub

Private Sub mnuDelete_Click()
    Call Operate("DELETE")
End Sub

Private Sub mnuExit_Click()
    Unload Me
    Unload frmUSU_Print
End Sub

Private Sub mnuHelp_Click()
    Call Operate("HELP")
End Sub

Private Sub mnuNew_Click()
    Call Operate("ADD")
End Sub

Private Sub mnuPreview_Click()
    Call Operate("PREVIEW")
End Sub

Private Sub mnuPrint_Click()
    Call Operate("PRINT")