frmyh_yhdzdqc.frm

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

                                .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.Enabled = True
                                mnuNew.Enabled = True
                                mnuSave.Enabled = False
                                mnuCancel.Enabled = False
                                mnuDelete.Enabled = True
                                mnuFilter.Enabled = True
                                mnuExit.Enabled = True
                            End With
                        Else
                            Call UpdateCurrentRow
                        End If
                    Else
                        If Not tbr.Buttons("new").Enabled Then
                            Call InsertCurrentRow
                        Else
                            Call UpdateCurrentRow
                        End If
                    End If
                    IsModify = False
'                    If IsDateModify And tBr.Buttons("new").Enabled Then
                    If IsDateModify Then
                        IsDateModify = False
                        Call AutoDateSort
                    End If
                End If
            End If
        End If
    End With
    mfgYhdzdqc_GotFocus1
End Sub

'表格中的单元格获得焦点后, 动态的移动相应的控件到当前的单元格;
Private Sub mfgYhdzdqc_GotFocus1()
    On Error GoTo err_handle
    With mfgYhdzdqc
        If .Visible And .row > 0 And .CellBackColor <> &HFFFFC0 And Not IsRefresh And Not IsDelete Then
            Select Case True
                Case .col = 1
                    dtpEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    dtpEdit.Visible = True
                    If .text <> "" Then
                        dtpEdit.value = .text
                    ElseIf .row > 1 Then
                        dtpEdit.value = CDate(.TextMatrix(.row - 1, .col))
                    Else
                        dtpEdit.value = Date
                    End If
                    dtpEdit.SetFocus
                Case .col = 2
                    cboEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth
                    cboEdit.Visible = True
                    cboEdit.SetFocus
'for循环功能: 找出与表格中选中的结算方式相匹配的组合列表框内容;
                    cboEdit.ListIndex = -1
                    For i = 0 To cboEdit.ListCount - 1
                        If Trim(cboEdit.List(i)) = Trim(.text) Then
                            cboEdit.ListIndex = i
                            Exit For
                        End If
                    Next i
                    
                Case .col = 3
                    txtEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    txtEdit.Visible = True
                    txtEdit.SetFocus
                    txtEdit.text = .text
                    
                Case .col = 4 Or .col = 5
                    txtEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    txtEdit.Visible = True
                    txtEdit.SetFocus
                    txtEdit.text = Format(.text, "###0.00")
                    
                Case .col = 6
                    txtEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                    txtEdit.Visible = True
                    txtEdit.SetFocus
                    txtEdit.text = .text
                    cmdHelp.Move .Left + .CellLeft + .cellWidth - cmdHelp.Width, .Top + .CellTop + .cellHeight - cmdHelp.Height
                    cmdHelp.Visible = True
            End Select
        End If
    End With
    Exit Sub
err_handle:
    dtpEdit.Visible = False
    txtEdit.text = ""
    cboEdit.ListIndex = -1
    txtEdit.Visible = False
    cboEdit.Visible = False
End Sub

'离开当前单元格处理
Private Sub mfgYhdzdqc_LeaveCell()
   On Error GoTo err_handle
    With mfgYhdzdqc
        If .Visible And .row > 0 And Not IsRefresh And Not IsDelete Then
    '赋值当前单元格所在的行数给变量oldrow;
            OldRow = .row
    '隐藏当前表格中活动的控件 ;
'            IsModify = False
            Select Case True
                Case dtpEdit.Visible
                    If .text <> Format(dtpEdit.value, "yyyy-mm-dd") Then
                        .text = Format(dtpEdit.value, "yyyy-mm-dd")
                        IsModify = True
                        IsDateModify = True
                    End If
                    dtpEdit.Visible = False
                Case cboEdit.Visible
                    If .text <> Trim(cboEdit.text) Then
                        .text = Trim(cboEdit.text)
                        IsModify = True
                    End If
                    cboEdit.Visible = False
                Case txtEdit.Visible, cmdHelp.Visible
                    If .col = 4 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
                    ElseIf .col = 5 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
            End Select
       End If
    End With
    Exit Sub
err_handle:
  IsModify = False
  dtpEdit.Visible = False
  txtEdit.text = ""
  txtEdit.Visible = False
  cboEdit.Visible = False
  cboEdit.ListIndex = -1
  cmdHelp.Visible = False
End Sub

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

Private Sub mfgYhdzdqc_Scroll()
    With mfgYhdzdqc
        If .ColIsVisible(.col) And .ColPos(.col) + .ColWidth(.col) <= .Width And .RowPos(.row) + .RowHeight(.row) <= .Height And .RowIsVisible(.row) Then
            mfgYhdzdqc_EnterCell
        Else
            mfgYhdzdqc_LeaveCell
        End If
    End With
End Sub

'点击表格滚动条后, 执行获得焦点的过程;
'Private Sub mfgYhdzdqc_Scroll()
'    Call mfgYhdzdqc_GotFocus
'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 mfgYhdzdqc
                If .row > 0 Then
                    Call mfgYhdzdqc_LeaveCell
                    If IsValidate Then
                        Call ShowPrintResult("PRINT")
                    Else
                        .col = ErrorCol
                        Call mfgYhdzdqc_GotFocus1
                        Exit Sub
                    End If
                Else
                    Call ShowPrintResult("PRINT")
                End If
                
            End With
        Case "PREVIEW"
            With mfgYhdzdqc
                If .row > 0 Then
                    Call mfgYhdzdqc_LeaveCell
                    If IsValidate Then
                        Call ShowPrintResult("PREVIEW")
                    Else
                        .col = ErrorCol
                        Call mfgYhdzdqc_GotFocus1
                        Exit Sub
                    End If
                Else
                    Call ShowPrintResult("PREVIEW")
                End If
                
            End With
           
        Case "NEW"
            With mfgYhdzdqc
                If .row > 0 And .CellBackColor <> &HFFFFC0 Then
                    Call mfgYhdzdqc_LeaveCell
                    If IsValidate Then
                        If IsModify Then
                            Call UpdateCurrentRow
                        End If
                        IsRefresh = True
                        Call AddNewRow
                        IsRefresh = False
                        Call mfgYhdzdqc_GotFocus1
                    Else
                        .col = ErrorCol
                        Call mfgYhdzdqc_GotFocus1
                    End If
                Else
                    Call AddNewRow
                End If
            End With
        
        Case "SAVE"
            Call mfgYhdzdqc_LeaveCell
            NewRow = mfgYhdzdqc.row
            NewCol = mfgYhdzdqc.col
            If IsValidate Then
                Call InsertCurrentRow
                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.Enabled = 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
                mfgYhdzdqc.col = ErrorCol
                Call mfgYhdzdqc_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.Enabled = True