frmyh_dwrjzqc.frm

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

                                .text = Format(txtEdit.text, "##,##0.00")
                            End If
                            IsModify = True
                        End If
                    ElseIf .Col = 8 Then
                        If .text <> Format(txtEdit.text, "##,##0.00") Then
                            If Val(Format(txtEdit.text, "##,##0.00")) = 0 Then
                                .text = ""
                            Else
                                .text = Format(txtEdit.text, "##,##0.00")
                            End If
                            IsModify = True
                        End If
                    Else
                        If .text <> Trim$("" & txtEdit.text) Then
                            .text = Trim$("" & txtEdit.text)
                            IsModify = True
                        End If
                    End If
                    txtEdit.Visible = False
                    cmdHelp.Visible = False
                Case txtPjrq.Visible
                    If .text <> txtPjrq.text Then
                        If .text = "" And txtPjrq.text <> "____-__-__" Then
                            .text = txtPjrq.text
                            IsModify = True
                        ElseIf .text <> "" And txtPjrq = "____-__-__" Then
                            .text = ""
                            IsModify = True
                        ElseIf .text <> "" And txtPjrq <> "____-__-__" Then
                            .text = txtPjrq.text
                            IsModify = True
                        End If
                    End If
                    txtPjrq.Visible = False
            End Select
       End If
    End With
    Exit Sub
err_handle:
 dtpEdit.Visible = False
 cboEdit.Visible = False
 txtEdit.Visible = False
 txtPjrq.Visible = False
End Sub

'表格中获得焦点的单元格变化后, 执行获得焦点的过程;
Private Sub mfgDwrjzqc_RowColChange()
'    Call mfgDwrjzqc_GotFocus1
End Sub

'点击表格滚动条后, 执行获得焦点的过程;
Private Sub mfgDwrjzqc_Scroll()
    With mfgDwrjzqc
    If .ColIsVisible(.Col) And .ColPos(.Col) + .ColWidth(.Col) <= .Width And .RowPos(.Row) + .RowHeight(.Row) <= .Height And .RowIsVisible(.Row) Then
        mfgDwrjzqc_EnterCell
    Else
        mfgDwrjzqc_LeaveCell
    End If
End With
End Sub

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

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

Private Sub mnuExit_Click()
    Call Operate("EXIT")
End Sub

Private Sub mnuFilter_Click()
    Call Operate("FILTER")
End Sub

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

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

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

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

Private Sub mnuSave_Click()
    Call Operate("SAVE")
End Sub

'工具条
Private Sub tbr_ButtonClick(ByVal Button As MSComctlLib.Button)
    Call Operate(UCase(Button.Key))
End Sub

Private Sub Operate(strKey As String)
    Dim CurrentColNum As Integer
    Dim IsAddRow As Boolean          '判断当前单元行是否是新增行中的某一行
    On Error Resume Next
    Select Case strKey
        Case "PRINT"
            With mfgDwrjzqc
                If .Row > 0 Then
                    Call mfgDwrjzqc_LeaveCell
                    If IsValidate Then
                        Call ShowPrintResult("PRINT")
                    Else
                        .Col = ErrorCol
                        Call mfgDwrjzqc_GotFocus1
                    End If
                Else
                    Call ShowPrintResult("PRINT")
                End If
            End With
        Case "PREVIEW"
            With mfgDwrjzqc
                If .Row > 0 Then
                    Call mfgDwrjzqc_LeaveCell
                    If IsValidate Then
                        Call ShowPrintResult("PREVIEW")
                    Else
                        .Col = ErrorCol
                        Call mfgDwrjzqc_GotFocus1
                    End If
                Else
                    Call ShowPrintResult("PREVIEW")
                End If
            End With
           
        Case "NEW"
            With mfgDwrjzqc
                If .Row > 0 And .CellBackColor <> &HFFFFC0 Then
                    Call mfgDwrjzqc_LeaveCell
                    If IsValidate Then
                        If IsModify Then
                            Call UpdateCurrentRow
                        End If
                        IsRefresh = True
                        Call AddNewRow
                        IsRefresh = False
                        Call mfgDwrjzqc_GotFocus1
                    Else
                        .Col = ErrorCol
                        Call mfgDwrjzqc_GotFocus1
                    End If
                Else
                    Call AddNewRow
                End If
            End With
        
        Case "SAVE"
            Call mfgDwrjzqc_LeaveCell
            NewRow = mfgDwrjzqc.Row
            NewCol = mfgDwrjzqc.Col
            If IsValidate Then
                Call InsertCurrentRow
                OldPzzl = mfgDwrjzqc.TextMatrix(mfgDwrjzqc.Row, 3)
                OldPzbh = mfgDwrjzqc.TextMatrix(mfgDwrjzqc.Row, 4)
                With tbr
                    .Buttons("print").Enabled = True
                    .Buttons("preview").Enabled = True
                    .Buttons("new").Enabled = True
                    .Buttons("save").Enabled = False
                    .Buttons("cancel").Enabled = False
                    .Buttons("delete").Enabled = True
                    .Buttons("filter").Enabled = True
                    .Buttons("exit").Enabled = True
                    mnuPrint.Enabled = True
                    mnuPreview = True
                    mnuNew.Enabled = True
                    mnuSave.Enabled = False
                    mnuCancel.Enabled = False
                    mnuDelete.Enabled = True
                    mnuFilter.Enabled = True
                    mnuExit.Enabled = True
                End With
                Call AutoDateSort
                IsModify = False
                IsDateModify = False
            Else
                mfgDwrjzqc.Col = ErrorCol
                Call mfgDwrjzqc_GotFocus1
            End If
        Case "CANCEL"
            With tbr
                .Buttons("print").Enabled = True
                .Buttons("preview").Enabled = True
                .Buttons("new").Enabled = True
                .Buttons("save").Enabled = False
                .Buttons("cancel").Enabled = False
                .Buttons("delete").Enabled = True
                .Buttons("filter").Enabled = True
                .Buttons("exit").Enabled = True
                mnuPrint.Enabled = True
                mnuPreview = True
                mnuNew.Enabled = True
                mnuSave.Enabled = False
                mnuCancel.Enabled = False
                mnuDelete.Enabled = True
                mnuFilter.Enabled = True
                mnuExit.Enabled = True
            End With
            Call mfgDwrjzqc_LeaveCell
            With mfgDwrjzqc
                CurrentColNum = .Col
                If .Rows = 2 Then
                    .Rows = 1
                    tbr.Buttons("delete").Enabled = False
                    mnuDelete.Enabled = False
                Else
                    .RemoveItem (.Row)
                End If
                If .Row = 0 Then
                    .Col = 0
                Else
                    .Col = CurrentColNum
                End If
            End With
        Case "DELETE"
            With mfgDwrjzqc
                If .Row > 0 And .CellBackColor <> &HFFFFC0 Then
                    Call mfgDwrjzqc_LeaveCell
                    IsDelete = True
'                    If IsValidate Then
'                        If IsModify Then
'                            Call UpdateCurrentRow
'                        End If
'
                        CurrentColNum = .Col
                        .ScrollBars = flexScrollBarNone
                        For j = .Cols - 1 To 0 Step -1
                            .Col = j
                            .CellBackColor = vbMagenta
                        Next j
                        If MsgBox("确认删除当前行?", vbYesNo + vbQuestion + vbDefaultButton2) = vbYes Then
                            
                            IsChangeCurrentTable = True
                            adoCmd.CommandText = "DELETE FROM tZW_Pzsj" & glo.sOperateYear & _
                                                " WHERE kjqj = " & .TextMatrix(OldRow, 0) & _
                                                " AND jlhm = " & .TextMatrix(OldRow, 1) & _
                                                " AND pzzl = '" & OldPzzl & _
                                                "' AND pzbh = '" & OldPzbh & "'"
                            adoCmd.Execute
                            '当总行数为2时, 不能用'removeitem" 方法, 只能设置总行数为1
                            IsDelete = False
                            If .Rows = 2 Then
                                .Rows = 1
                                tbr.Buttons("delete").Enabled = False
                                mnuDelete.Enabled = False
                            Else
                                .RemoveItem (.Row)
                                OldPzzl = .TextMatrix(.Row, 3)
                                OldPzbh = .TextMatrix(.Row, 4)
                            End If
                            .ScrollBars = flexScrollBarBoth
                        Else
                            For j = .Cols - 1 To 0 Step -1
                            .Col = j
                            .CellBackColor = vbWhite
                            Next j
                            .ScrollBars = flexScrollBarBoth
                            IsDelete = False
                        End If
                        If .Row = 0 Then
                            .Col = 0
                        Else
                            .Col = CurrentColNum
                        End If
'                    Else
'                        IsDelete = False
'                        .Col = ErrorCol
'                        Call mfgDwrjzqc_GotFocus1
'                    End If
                End If
            End With
        Case "FILTER"
            IsChangeCurrentTable = True
            With mfgDwrjzqc
                If .Row > 0 And .CellBackColor <> &HFFFFC0 Then
                    .Col = 0
                    If IsValidate Then
                        If IsModify Then
                            Call UpdateCurrentRow
                        End If
                        Call QueryConditionInput
                    Else
                        .Col = ErrorCol
                    End If
                Else
                    Call QueryConditionInput
                End If
                '为了筛选后不要调用isvalidate程序,将oldrow设置为零
                OldRow = 0
            End With
        Case "HELP"
            Call ShowHelp
        Case "EXIT"
            Unload Me