frmac_dailyselect.frm

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

Public Property Get ubIncludeBlankKm() As Boolean
     ubIncludeBlankKm = m_bIncludeBlankKm
End Property

Private Sub chkUnChecked_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then SendKeys "{tab}"
End Sub

Private Sub cmdCancel_Click()
    Me.Hide
End Sub

Private Sub cmdHelp_Click()
    Call ShowHelp
End Sub

Private Sub cmdOk_Click()
    Dim i As Integer
    If IsDate(txtYear.text & "-" & Format(txtMonth.text, "00") & _
            "-" & Format(txtDay.text, "00")) = False Then
            MsgBox "请输入合法日期!", vbInformation, ""
            Exit Sub
    End If
    
'    m_sMonthFrom = Mid(cboMonthFrom.text, InStr(1, cboMonthFrom.text, ".") + 1)
'    m_sMonthTo = Mid(cboMonthTo.text, InStr(1, cboMonthTo.text, ".") + 1)
        If SqlStringValid(txtSubjectCodeFrom.text) = False Then
        MsgBox "起始科目不能含有非法的字符！", vbInformation, "提示"
        Exit Sub
    End If
    If SqlStringValid(txtSubjectCodeTo.text) = False Then
        MsgBox "终止科目不能含有非法的字符！", vbInformation, "提示"
        Exit Sub
    End If
    m_sSubjectCodeFrom = ""
    m_sSubjectNameFrom = ""
    If Trim$("" & txtSubjectCodeFrom.text) <> "" Then
        If txtSubject_Validate(txtSubjectCodeFrom) Then
            m_sSubjectCodeFrom = CSubject.SubjectCode
            m_sSubjectNameFrom = CSubject.SubjectName
        Else
            MsgBox "科目输入不正确！", vbInformation
            txtSubjectCodeFrom.SetFocus
            Exit Sub
        End If
    End If
    
    m_sSubjectCodeTo = ""
    m_sSubjectNameTo = ""
    If Trim$("" & txtSubjectCodeTo.text) <> "" Then
        If txtSubject_Validate(txtSubjectCodeTo) Then
            m_sSubjectCodeTo = CSubject.SubjectCode
            m_sSubjectNameTo = CSubject.SubjectName
            txtSubjectCodeTo.SetFocus
        Else
            MsgBox "科目输入不正确！", vbInformation
            Exit Sub
        End If
    End If
    
    If m_sSubjectCodeFrom <> "" And m_sSubjectCodeTo <> "" Then
        If m_sSubjectCodeFrom > m_sSubjectCodeTo Then
            MsgBox "起始科目不能小于结束科目！"
            Exit Sub
        End If
    End If
    m_bIncludeNotRecordVoucher = IIf(chkUnChecked.value = 0, False, True)
    m_bIncludeBlankKm = IIf(ChkBlankKm.value = 0, False, True)
    Ok = True
    Me.Hide
    
End Sub

Private Sub cmdSubject_Click()
    With frmUSU_KmHelp
        .ubSelAll = True
        .Show 1
        If .Valid Then
            txtSubjectCodeFrom.text = .SubjectCode & "=" & .SubjectName
        End If
    End With
End Sub

Private Sub cmdSubjectHelpOne_Click()
    With frmUSU_KmHelp
        .ubSelAll = True
        .Show 1
        If .Valid Then
            txtSubjectCodeFrom.text = .SubjectCode & "=" & .SubjectName
        End If
        Unload frmUSU_KmHelp
    End With
End Sub

Private Sub cmdSubjectHelpTwo_Click()
    With frmUSU_KmHelp
        .ubSelAll = True
        .Show 1
        If .Valid Then
            txtSubjectCodeTo.text = .SubjectCode & "=" & .SubjectName
        End If
        Unload frmUSU_KmHelp
    End With
End Sub

Private Sub form_load()
    ''''
    '注册表
    Me.chkUnChecked.value = Abs(CBool(GetSetting(App.Title, "Settings\frmAc_DailySelect", "NotRecord", True)))
    Me.ChkBlankKm.value = Abs(CBool(GetSetting(App.Title, "Settings\frmAc_DailySelect", "BlankKm", False)))
    '取当前登录时间为默认的年、月、日
    txtYear.text = Year(glo.sOperateDate)
    updMonth.value = Month(glo.sOperateDate)
    updDay.value = Day(glo.sOperateDate)
'    chkUnChecked.Value = -1
End Sub

Private Sub txtDay_GotFocus()
    txtDay.SelStart = 0
    txtDay.SelLength = Len(txtDay.text)
End Sub

Private Sub txtDay_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        KeyAscii = IntegerEnabled(KeyAscii)
    End If
End Sub

Private Sub txtDay_Validate(Cancel As Boolean)
    If Val(txtDay.text) < 1 Or Val(txtDay.text) > 31 Then
        MsgBox "日期值超出范围！", vbExclamation
        Cancel = True
        txtDay.SelStart = 0
        txtDay.SelLength = Len(txtDay.text)
    ElseIf Not IsDate(txtYear.text & "-" & Format(txtMonth.text, "00") & _
            "-" & Format(txtDay.text, "00")) Then
        MsgBox "该日期不存在！", vbInformation
        Cancel = True
        txtDay.SelStart = 0
        txtDay.SelLength = Len(txtDay.text)
    End If
End Sub


Private Sub txtMonth_GotFocus()
    txtMonth.SelStart = 0
    txtMonth.SelLength = 0
End Sub

Private Sub txtMonth_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        KeyAscii = IntegerEnabled(KeyAscii)
    End If
End Sub

Private Sub txtMonth_Validate(Cancel As Boolean)
    If Val(txtMonth.text) < 1 Or Val(txtMonth.text) > 12 Then
        MsgBox "请输入一个合法的月份值！", vbExclamation
        Cancel = True
        txtMonth.SelStart = 0
        txtMonth.SelLength = 0
    End If
End Sub

Private Sub txtYear_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        KeyAscii = IntegerEnabled(KeyAscii)
    End If
End Sub

Private Sub updDay_DownClick()
  If updDay.value = updDay.Min Then
     updDay.value = updDay.Max
  End If
End Sub

Private Sub updDay_UpClick()
    If updDay.value = updDay.Max Then
         updDay.value = updDay.Min
    End If
End Sub


Private Sub txtSubjectCodeFrom_GotFocus()
    txtSubjectCodeFrom.Alignment = 0
    txtSubjectCodeFrom.SelStart = 0
    txtSubjectCodeFrom.SelLength = Len(txtSubjectCodeFrom.text)
End Sub

Private Sub txtSubjectCodeFrom_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim CtrlDown As Boolean
    
    CtrlDown = (Shift And vbCtrlMask) > 0
    If KeyCode = vbKeyF And CtrlDown Then
        Call cmdSubjectHelpOne_Click
    End If
End Sub

Private Sub txtSubjectCodeFrom_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = 8 Or KeyAscii = 10 Or KeyAscii = Asc(glo.sSeparateSubject) Then
            If KeyAscii = Asc("0") And txtSubjectCodeFrom.text = "" Then
                KeyAscii = 0
            Else
                KeyAscii = KeyAscii
            End If
        Else
            KeyAscii = 0
        End If
    End If
End Sub

Private Sub txtSubjectCodeTo_GotFocus()
    txtSubjectCodeTo.Alignment = 0
    txtSubjectCodeTo.SelStart = 0
    txtSubjectCodeTo.SelLength = Len(txtSubjectCodeTo.text)
End Sub

Private Sub txtSubjectCodeTo_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim CtrlDown As Boolean
    
    CtrlDown = (Shift And vbCtrlMask) > 0
    If KeyCode = vbKeyF And CtrlDown Then
        Call cmdSubjectHelpTwo_Click
    End If
End Sub

Private Sub txtSubjectCodeTo_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
    Else
        If (KeyAscii >= Asc("0") And KeyAscii <= Asc("9")) Or KeyAscii = 8 Or KeyAscii = 10 Or KeyAscii = Asc(glo.sSeparateSubject) Then
            If KeyAscii = Asc("0") And txtSubjectCodeTo.text = "" Then
                KeyAscii = 0
            Else
                KeyAscii = KeyAscii
            End If
        Else
            KeyAscii = 0
        End If
    End If
End Sub

Private Function txtSubject_Validate(ByVal txtControl As Control) As Boolean
    Dim iTemp As Integer

    txtSubject_Validate = False
    If Trim$("" & txtControl.text) <> "" Then
        iTemp = InStr(1, txtControl.text, "=")
        If iTemp <> 0 Then
            CSubject.Init Left$(Trim$("" & txtControl.text), iTemp - 1), glo.sOperateYear
        Else
            CSubject.Init Trim$("" & txtControl.text), glo.sOperateYear
        End If
    End If
    If CSubject.SubjectIsExist Then
        txtSubject_Validate = True
    End If
End Function