frmyh_yhdzdlr.frm

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

    With mfgYhdzdlr
        Select Case KeyCode
            Case vbKeyLeft
                If .col > 1 Then
                    .col = .col - 1
                End If
            Case vbKeyRight
                If .col < .Cols - 1 Then
                    .col = .col + 1
                End If
            Case vbKeyReturn
                If .col < .Cols - 1 Then
                    .col = .col + 1
                End If
        End Select
    End With
End Sub


Private Sub cmdHelp_Click()
    frmH_Summ.ubSelectStatus = True
    frmH_Summ.usKmdm = frmYH_Yhkmxz.kmdm
    frmH_Summ.Show 1, Me
    If frmH_Summ.Ok Then
        txtEdit.text = frmH_Summ.txtName
    End If
    Unload frmH_Summ
End Sub

'根据所按方向键改变表格的焦点
Private Sub dtpEdit_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
     With mfgYhdzdlr
          dtpEdit.Visible = False
         .TextMatrix(.row, .col) = Format(dtpEdit.value, "YYYY-MM-DD")
         If .col < .Cols - 1 Then
            .col = .col + 1
         End If
        .Refresh
      End With
   End If
'     With mfgYhdzdlr
'        Select Case KeyCode
'            Case vbKeyReturn
'                If .col < .Cols - 1 Then
'                    .col = .col + 1
'                End If
'        End Select
'    End With
End Sub

'当进入新的单元格时, 判断新的单元格的行数是否于老的单元格行数不同并且老的单元格行数不等于0
'并且当前不是在表格刷新状态,
'如果是, 判断老的单元格所在行的数据是否合法,
'如果合法, 判断老的单元格所在行的数据是否被修改并且当前行不是在增加状态,
'如果条件为真, 则修改数据库中表的内容
Private Sub mfgYhdzdlr_Entercell()
On Error GoTo err_handle
    With mfgYhdzdlr
        If .Visible And OldRow > 0 And .row > 0 And Not IsRefresh And Not IsDelete Then
            NewRow = .row
            If NewRow <> OldRow Then
                NewCol = .col
                If Not IsValidate Then
                    IsRefresh = True
                    .row = OldRow
                    .col = ErrorCol
                    IsRefresh = False
                    Exit Sub
                ElseIf IsModify Then
                    If NewRow < OldRow Then
                        If Not tBr.Buttons("new").Enabled 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
                        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 Then
                        IsDateModify = False
                        Call AutoDateSort
                    End If
                    Call RefreshYe
                End If
            End If
        End If
        mfgYhdzdlr_GotFocus1
    End With
Exit Sub
err_handle:
  dtpEdit.Visible = False
  txtEdit.Visible = False
  cboEdit.Visible = False
End Sub

'表格中的单元格获得焦点后, 动态的移动相应的控件到当前的单元格;
Private Sub mfgYhdzdlr_GotFocus1()
Dim i As Integer
    On Error GoTo err_handle
    With mfgYhdzdlr
        If .Visible And .row > 0 And Not IsRefresh And Not IsDelete Then
'            If .TextMatrix(.Row, 1) <> "1" And .CellBackColor <> &HFFFFC0 Then
             If .CellBackColor <> &HFFFFC0 Then

                Select Case True
                    Case .col = 2
                        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 = 3
                        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 = 4
                        txtEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                        txtEdit.Visible = True
                        txtEdit.SetFocus
                        txtEdit.text = .text
                        
                    Case .col = 5 Or .col = 6
                        txtEdit.Move .Left + .CellLeft, .Top + .CellTop, .cellWidth, .cellHeight
                        txtEdit.Visible = True
                        txtEdit.SetFocus
                        txtEdit.text = Format(.text, "###0.00")
                        
                    Case .col = 8
                        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 If
    End With
Exit Sub
err_handle:
  dtpEdit.Visible = False
  txtEdit.Visible = False
  cboEdit.Visible = False
End Sub

'当余额单元格获得焦点时, 按回车键后下一个单元格获得焦点;
Private Sub mfgYhdzdlr_KeyPress(KeyAscii As Integer)
    With mfgYhdzdlr
        If KeyAscii = 13 Then
            If .col < .Cols - 1 Then
                .col = .col + 1
            ElseIf .row < .Rows - 1 Then
                .row = .row + 1
                .col = 2
            End If
        End If
    End With
End Sub

'离开当前单元格处理
Private Sub mfgYhdzdlr_LeaveCell()
   On Error GoTo err_handle
    With mfgYhdzdlr
        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 Trim(.text) <> cboEdit.text Then
                        .text = Trim(cboEdit.text)
                        IsModify = True
                    End If
                    cboEdit.Visible = False
                Case txtEdit.Visible, cmdHelp.Visible
                    If .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
                    ElseIf .col = 6 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:
  dtpEdit.Visible = False
  txtEdit.Visible = False
  cboEdit.Visible = False

End Sub

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

Private Sub mfgYhdzdlr_Scroll()
With mfgYhdzdlr
    If .ColIsVisible(.col) And .ColPos(.col) + .ColWidth(.col) <= .Width And .RowPos(.row) + .RowHeight(.row) <= .Height And .RowIsVisible(.row) Then
        mfgYhdzdlr_Entercell
    Else
        mfgYhdzdlr_LeaveCell
    End If
End With
'Dim i As Integer
'Dim j As Integer
'dtpEdit.Visible = False
'cboEdit.Visible = False
'txtEdit.Visible = False
'cmdHelp.Visible = False
'
''''''''''20021018
'With mfgYhdzdlr
'    i = 1
'    While Not .ColIsVisible(i)
'        i = i + 1
'    Wend
'    j = .Cols - 1
'    While Not .ColIsVisible(j)
'        j = j - 1
'    Wend
'    If .col > j Then
'        .col = j
'    ElseIf .col < i Then
'        .col = i
'    End If
'End With
'''''''''
End Sub

'点击表格滚动条后, 执行获得焦点的过程;
'==================================2002.9.5 yao revise======================================================
'Private Sub mfgYhdzdlr_Scroll()
'    Call mfgYhdzdlr_GotFocus1
'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