frmac_detailselect.frm

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

        SendKeys "{tab}"
    End If
End Sub

Private Sub ChkTd_Click()
If ChkTd.value = 1 Then
    chkBlankKm.Enabled = False
Else
    chkBlankKm.Enabled = True
End If
End Sub

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

'2002.10.19
Private Sub chkZy_Click()
If chkZy.value = 1 Then
    txtZY.Enabled = True
    ChkTd.Enabled = False
    ChkTd.value = 0
Else
    txtZY.Enabled = False
    ChkTd.Enabled = True
End If
End Sub

Private Sub chkZy_Validate(Cancel As Boolean)
If chkZy.value = 1 Then
    txtZY.Enabled = True
    ChkTd.Enabled = False
    ChkTd.value = 0
Else
    txtZY.Enabled = False
    ChkTd.Enabled = True
End If
End Sub

Private Sub cmdFzCondition_Click()
If Me.Height <= 3375 Then
    Me.Height = 4530
Else
    Me.Height = 3375
End If
End Sub

Private Sub cmdHelp_Click()
      Dim nRet As Integer
    
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable to display Help Contents. There is no Help associated with this project.", vbInformation
    Else
        On Error Resume Next
        nRet = HtmlHelp(Me.hwnd, App.Path & "\Help Files\" & App.ProductName & ".chm", _
        HH_HELP_CONTEXT, CLng(Me.HelpContextID))
        If Err Then
            MsgBox Err.Dscription
        End If
    End If
End Sub

Private Sub cmdSubjectEnd_Click()
    With frmUSU_KmHelp
'        .usCondition = "*" ' isrjz=0"-------- changjh delete----------------
        .ubSelAll = True
        .Show 1
        If .Valid Then
            txtSubjectEnd.text = .SubjectCode & "=" & .SubjectName
        End If
        Unload frmUSU_KmHelp
    End With
End Sub

Private Sub cmdSubjectStart_Click()
    With frmUSU_KmHelp
         
'        .usCondition = "*" ' isrjz=0"-------- changjh delete----------------可以选择日记账
        .ubSelAll = True
        .Show 1
        If .Valid Then
            txtSubjectStart.text = .SubjectCode & "=" & .SubjectName
        End If
        Unload frmUSU_KmHelp
    End With
End Sub

Private Sub Form_Initialize()
    Ok = False
End Sub

Private Sub form_load()
    Dim rstTemp As ADODB.Recordset
    Dim sSQL As String
    Dim i As Integer
    
    ''''
    '注册表
    Me.ChkNotRecord.value = Abs(CBool(GetSetting(App.Title, "Settings\frmAc_DetailSelect", "NotRecord", True)))
    Me.chkBlankKm.value = Abs(CBool(GetSetting(App.Title, "Settings\frmAc_DetailSelect", "BlankKm", False)))
    
    Set CSubject = New clsSubject
    '年份设计为不允许修改
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    sSQL = "SELECT * FROM tSYS_SubSysUsed WHERE AccountID = '" & glo.sAccountID & _
            "' AND SubSysID = '" & gloSys.sSubSysId & "'"
    rstTemp.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount > 0 Then
            If Val(glo.sOperateYear) > Val(.Fields("ModiYear").value) Then
                updMonthFrom.Tag = 1
            Else
                updMonthFrom.Tag = IIf(Val(glo.sOperateYear) = Val(.Fields("BeginYear").value), .Fields("BeginMonth").value, 1)
            End If
        End If
    End With
    
    '取当前登录时间为默认的年、月
    txtYear.text = Year(glo.sOperateDate)
    updMonthFrom.value = Month(glo.sOperateDate)
    updMonthTo.value = Month(glo.sOperateDate)
    txtMonthFrom.text = Month(glo.sOperateDate)
    txtMonthTo.text = Month(glo.sOperateDate)

End Sub

Private Sub cmdCancel_Click()
    Me.Hide
End Sub

Private Sub cmdOk_Click()
   Dim iTemp As Integer
   Dim sSubjectStart As String
   Dim sSubjectEnd As String
   Dim sSQL As String
   Dim rstRec As New ADODB.Recordset
   Dim gradeStart As Integer
   Dim gradeEnd As Integer
   If SqlStringValid(txtSubjectStart) = False Then
        MsgBox "起始科目中含有非法字符！"
        Exit Sub
   End If
   If SqlStringValid(txtSubjectEnd) = False Then
        MsgBox "结束科目中含有非法字符！"
        Exit Sub
   End If
   If SqlStringValid(txtZY.text) = False Then
        MsgBox "摘要中含有非法字符！"
        Exit Sub
   End If
   If Not IsNumeric(txtGradeStart.text) Then
        gradeStart = 0
   Else
        gradeStart = CInt(txtGradeStart.text) - 1
   End If
   If Not IsNumeric(txtGradeEnd.text) Then
        gradeEnd = 10
   Else
        gradeEnd = CInt(txtGradeEnd.text) - 1
   End If
   If gradeEnd < gradeStart Then
        MsgBox "起始科目级次要小于等于终止科目级次"
        Exit Sub
   End If
   If chkZy.value = 1 And Trim(txtZY.text) = "" Then
        If MsgBox("您没有输入摘要,是否放弃使用摘要查询的条件?" + vbCrLf + "若不放弃,则重新选择。", vbQuestion + vbYesNo, "提示") = vbNo Then Exit Sub
   End If
   If chkJe.value = 1 And Trim(txtStartJe.text) = "" And Trim(txtEndJe.text) = "" Then
        If MsgBox("您没有输入金额范围,是否放弃使用金额范围查询的条件?" + vbCrLf + "若不放弃,则重新选择。", vbQuestion + vbYesNo, "提示") = vbNo Then Exit Sub
   End If
   '检查起始科目
    If Trim$("" & txtSubjectStart.text) <> "" Then
        iTemp = InStr(1, txtSubjectStart.text, "=")
         If iTemp <> 0 Then
             sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Left$(Trim$("" & txtSubjectStart.text), iTemp - 1) & "'" ' and isrjz=0"---- changjh delete----
         Else
             sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Trim$("" & txtSubjectStart.text) & "'" ' and isrjz=0"---- changjh delete----
         End If
         rstRec.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
         If Not (rstRec.EOF And rstRec.BOF) Then
            If iTemp <> 0# Then
                 m_sSubjectCodeStart = Left$(Trim$("" & txtSubjectStart.text), iTemp - 1)
                 m_sSubjectNameStart = rstRec.Fields("kmmc").value & ""
            Else
                 m_sSubjectCodeStart = Trim$("" & txtSubjectStart.text)
                 m_sSubjectNameStart = rstRec.Fields("kmmc").value & ""
            End If
         Else
              MsgBox "起始科目代码错误！", vbInformation
              txtSubjectStart.SelStart = 0
              txtSubjectStart.SelLength = Len(txtSubjectStart.text)
              txtSubjectStart.SetFocus
              Set rstRec = Nothing
              Exit Sub
         End If
         rstRec.Close
     Else
        m_sSubjectCodeStart = ""
        m_sSubjectNameStart = ""
     End If
    
   '检查终止科目
    If Trim$("" & txtSubjectEnd.text) <> "" Then
               iTemp = InStr(1, txtSubjectEnd.text, "=")
         If iTemp <> 0 Then
             sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Left$(Trim$("" & txtSubjectEnd.text), iTemp - 1) & "'" ' and isrjz=0"---- changjh delete----
         Else
             sSQL = "select * from tzw_km" & glo.sOperateYear & "  where kmdm='" & Trim$("" & txtSubjectEnd.text) & "'" ' and isrjz=0"---- changjh delete----
         End If
         rstRec.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
         If Not (rstRec.EOF And rstRec.BOF) Then
            If iTemp <> 0# Then
                 m_sSubjectCodeEnd = Left$(Trim$("" & txtSubjectEnd.text), iTemp - 1)
                 m_sSubjectNameEnd = rstRec.Fields("kmmc").value & ""
            Else
                 m_sSubjectCodeEnd = Trim$("" & txtSubjectEnd.text)
                 m_sSubjectNameEnd = rstRec.Fields("kmmc").value & ""
            End If
         Else
              'MsgBox "起始科目代码错误或为日记账科目！", vbInformation
              MsgBox "起始科目代码错误！", vbInformation '-------------changjh delete and edit-----------
              txtSubjectEnd.SelStart = 0
              txtSubjectEnd.SelLength = Len(txtSubjectEnd.text)
              txtSubjectEnd.SetFocus
              Set rstRec = Nothing
              Exit Sub
         End If
         rstRec.Close
     Else
        m_sSubjectCodeEnd = ""
        m_sSubjectNameEnd = ""
     End If
     
     Set rstRec = Nothing
     '判断起始科目编码要是否小于终止科目编码
     If m_sSubjectCodeEnd <> "" Then
        If Trim(m_sSubjectCodeStart > m_sSubjectCodeEnd) Then
               MsgBox "起始科目编码要小于等于终止科目编码！", vbInformation
               txtSubjectStart.SetFocus
               txtSubjectStart.SelStart = 0
               txtSubjectStart.SelLength = Len(txtSubjectStart.text)
               Exit Sub
        End If
     End If
     
    Ok = True
    Me.Hide

End Sub





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

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

Private Sub txtMonthFrom_LostFocus()
    If Val(txtMonthFrom.text) > Val(txtMonthTo.text) Then
        txtMonthTo.text = Val(txtMonthFrom.text)
    End If
    If txtMonthFrom.text < updMonthFrom.Min Then
        txtMonthFrom.text = updMonthFrom.Min
    End If
End Sub

Private Sub txtMonthFrom_GotFocus()
    txtMonthFrom.SelStart = 0
    txtMonthFrom.SelLength = Len(txtMonthFrom.text)
End Sub

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


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

Private Sub txtMonthTo_LostFocus()
    If Val(txtMonthTo.text) < Val(txtMonthFrom.text) Then
        txtMonthFrom.text = Val(txtMonthTo.text)
    End If
    If txtMonthTo.text > updMonthTo.Max Then
        txtMonthTo.text = updMonthTo.Max
    End If
End Sub

Private Sub txtMonthTo_GotFocus()
    txtMonthTo.SelStart = 0
    txtMonthTo.SelLength = Len(txtMonthTo.text)
End Sub

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

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

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

Private Sub txtSubjectStart_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
    SendKeys "{tab}"
 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 txtStartJe_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
    SendKeys "{tab}"
 End If
End Sub

Private Sub updMonthFrom_Change()
    If Trim(txtMonthFrom.text) <> "" Then
        updMonthTo.Min = txtMonthFrom.text
    End If
    
End Sub

Public Property Get uiGradeStart() As Integer
   If Not IsNumeric(txtGradeStart.text) Then
        uiGradeStart = 0
   Else
        uiGradeStart = CInt(txtGradeStart.text) - 1
   End If
End Property

Public Property Get uiGradeEnd() As Integer
   If Not IsNumeric(txtGradeEnd.text) Then
        uiGradeEnd = 10
   Else
        uiGradeEnd = CInt(txtGradeEnd.text) - 1
   End If
End Property

Public Property Get udJeStart() As Double
   If Not IsNumeric(txtStartJe.text) Then
        udJeStart = 0
   Else
        udJeStart = CDbl(txtStartJe.text)
   End If
End Property

Public Property Get udJeEnd() As Double
   If Not IsNumeric(txtEndJe.text) Then
        udJeEnd = 0
   Else
        udJeEnd = CDbl(txtEndJe.text)
   End If
End Property

Private Sub updMonthFrom_DownClick()
    If Val(updMonthFrom.Tag) > Val(updMonthFrom.value) Then
        updMonthFrom.value = 0
    End If
End Sub

Private Sub updMonthFrom_UpClick()
    If Val(updMonthFrom.Tag) > Val(updMonthFrom.value) Then
        updMonthFrom.value = updMonthFrom.Tag
    End If
End Sub

Private Sub updMonthTo_DownClick()
    If Val(updMonthFrom.Tag) > Val(updMonthTo.value) Then
        updMonthTo.value = 0
    End If
End Sub

Private Sub updMonthTo_UpClick()
    If Val(updMonthFrom.Tag) > Val(updMonthTo.value) Then
        updMonthTo.value = updMonthFrom.Tag
    End If
End Sub