查询条件界面.frm

财务信息管理系统,适合做毕业论文的人使用

    If rtn Is Nothing Then
        Exit Sub
    End If
    
    While Not rtn.EOF
        str = str & "" & rtn(Node.getAttribute("showfield")) & ","
        rtn.MoveNext
    Wend
    If str <> "" Then
        txtCheck.Text = mID(str, 1, Len(str) - 1)
    End If
End Sub

Private Sub btnCheck_LostFocus()
    btnCheck.Visible = False
End Sub

Private Sub btndEnd_LostFocus()
    btndEnd.Visible = False
End Sub

Private Sub btndStart_LostFocus()
    btndStart.Visible = False
End Sub

Private Sub btnOk_Click()
    '组成串
    sWhere = Trim(GetQuery) & " order by fd_budgethead.accunit_id,fd_budgethead.dstart"
    Unload Me
End Sub

Private Sub btnUnitName_Click()
    Dim rtn As ADODB.Recordset
    Dim str As String
    Dim Node As IXMLDOMElement
    
    On Error Resume Next
    
    Set Node = m_objRefTree.documentElement.selectSingleNode("unit")
    Set rtn = objShowCommonRef(Node.getAttribute("sql"), Node.getAttribute("fieldname"), True)
        
    If rtn Is Nothing Then
        Exit Sub
    End If
    
    While Not rtn.EOF
        str = str & "" & rtn(Node.getAttribute("showfield")) & ","
        rtn.MoveNext
    Wend
    If str <> "" Then
        txtUnitName.Text = mID(str, 1, Len(str) - 1)
    End If
End Sub

Private Sub btnUnitName_LostFocus()
    btnUnitName.Visible = False
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyF1 Then
        SendKeys "{F1}"
    ElseIf KeyCode = vbKeySeparator Or KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    ElseIf KeyCode = vbKeyF2 Then
        Select Case Me.ActiveControl.Name
            Case "txtdStart"
                btndStart_Click
            Case "txtdEnd"
                btndEnd_Click
            Case "txtUnitName"
                btnUnitName_Click
            Case "txtBill"
                btnBill_Click
            Case "txtCheck"
                btnCheck_Click
            Case "txtUnitName"
                btnUnitName_Click
        End Select
    End If
End Sub

Private Sub Form_Load()
    LoadRefPic
End Sub


Private Sub txtBill_GotFocus()
    btnBill.Visible = True
End Sub


Private Sub txtBill_LostFocus()
    Static tmp As String
    
    If Me.ActiveControl.Name = "btnBill" Then
        Exit Sub
    End If
        
    tmp = Trim(txtBill)
    If tmp <> "" Then
        If mID(tmp, 1, 1) = "," Then    '去掉多余的,号
            tmp = mID(tmp, 2)
            txtBill = tmp
            txtBill_LostFocus
        ElseIf mID(tmp, Len(tmp), 1) = "," Then
            tmp = mID(tmp, 1, Len(tmp) - 1)
            txtBill = tmp
            txtBill_LostFocus
        End If
    End If
    btnBill.Visible = False
End Sub

Private Sub txtCheck_GotFocus()
    btnCheck.Visible = True
End Sub

Private Sub txtCheck_LostFocus()
    Static tmp As String
    
    If Me.ActiveControl.Name = "btnCheck" Then
        Exit Sub
    End If
        
    tmp = Trim(txtCheck)
    If tmp <> "" Then
        If mID(tmp, 1, 1) = "," Then    '去掉多余的,号
            tmp = mID(tmp, 2)
            txtCheck = tmp
            txtCheck_LostFocus
        ElseIf mID(tmp, Len(tmp), 1) = "," Then
            tmp = mID(tmp, 1, Len(tmp) - 1)
            txtCheck = tmp
            txtCheck_LostFocus
        End If
    End If
    btnCheck.Visible = False
End Sub

Private Sub txtdEnd_GotFocus()
    btndEnd.Visible = True
End Sub

Private Sub txtdStart_GotFocus()
    btndStart.Visible = True
End Sub


Private Sub txtUnitName_GotFocus()
    btnUnitName.Visible = True
End Sub

Private Sub txtUnitName_LostFocus()
    Static tmp As String
    
    If Me.ActiveControl.Name = "btnUnitName" Then
        Exit Sub
    End If
        
    tmp = Trim(txtUnitName)
    If tmp <> "" Then
        If mID(tmp, 1, 1) = "," Then    '去掉多余的,号
            tmp = mID(tmp, 2)
            txtUnitName = tmp
            txtUnitName_LostFocus
        ElseIf mID(tmp, Len(tmp), 1) = "," Then
            tmp = mID(tmp, 1, Len(tmp) - 1)
            txtUnitName = tmp
            txtUnitName_LostFocus
        End If
    End If
    btnUnitName.Visible = False
End Sub

Private Sub txtdEnd_LostFocus()
    Dim tmp As String
    
    
    If Trim(txtdEnd.Text) = "" And Me.ActiveControl.Name <> "btndEnd" Then
        btndEnd.Visible = False
        Exit Sub
    End If
    
    If Me.ActiveControl.Name = "btndEnd" Then
        Exit Sub
    End If
    
    tmp = m_objAid.sCheckDate(Trim(txtdEnd.Text))
    If tmp = "" Then
        iShowMsg "输入的结束日期格式不正确!"
        txtdEnd.SetFocus
    End If
    
    '检查日期合法否
    If txtdEnd.Text = txtdStart Then
    
    ElseIf m_objAid.iDateDiff(txtdEnd.Text, txtdStart) > 0 Then
        iShowMsg "结束日期不应小于起始日期!!"
        txtdEnd.SetFocus
    End If
    
    txtdEnd.Text = tmp
    btndEnd.Visible = False
End Sub

Private Sub txtdStart_LostFocus()
    Dim tmp As String
    
    If Trim(txtdStart.Text) = "" And Me.ActiveControl.Name <> "btndStart" Then
        btndStart.Visible = False
        Exit Sub
    End If
    
    If Me.ActiveControl.Name = "btndStart" Then
        Exit Sub
    End If
    tmp = m_objAid.sCheckDate(Trim(txtdStart.Text))
    If tmp = "" Then
        iShowMsg "输入的起始日期格式不正确!"
        txtdStart.SetFocus
    End If
    
    If txtdEnd.Text = txtdStart Then
    
    ElseIf m_objAid.iDateDiff(txtdEnd.Text, txtdStart.Text) > 0 Then
        iShowMsg "结束日期不应小于起始日期!!"
        txtdStart.SetFocus
    End If
    
    txtdStart.Text = tmp
    btndStart.Visible = False
End Sub

Private Sub btndEnd_Click()
    Dim tmp As New CalendarAPP.ICaleCom
    tmp.Caption = "日期"
    txtdEnd.Text = tmp.Calendar(txtdEnd.hWnd)
    tmp.left = txtdEnd.left
    tmp.top = txtdEnd.top
End Sub

Private Sub btndStart_Click()
    Dim tmp As New CalendarAPP.ICaleCom
    tmp.Caption = "日期"
    txtdStart.Text = tmp.Calendar(txtdStart.hWnd)
    tmp.left = txtdStart.left
    tmp.top = txtdStart.top
End Sub

'获取查询条件
Private Function GetQuery() As String
    Dim tmp As String
    
    '加stype
    GetQuery = " left join fd_accunit on fd_accunit.accunit_id=fd_budgethead.accunit_id where fd_budgethead.btype='" & stype & "'"
    
    '如果是分析,必须已经审核的
    If cboBook.Visible Then
        GetQuery = GetQuery & " and fd_budgethead.dapprove is not null "
    End If
    
    '单据编号
    tmp = Trim(txtStartID)
    If tmp <> "" Then
        GetQuery = GetQuery & " and fd_budgethead.sname>='" & tmp & "' "
    End If
    
    tmp = Trim(txtEndID)
    If tmp <> "" Then
        GetQuery = GetQuery & " and fd_budgethead.sname<='" & tmp & "' "
    End If
    
    '单位名称
    tmp = Trim(txtUnitName)
    If Trim(txtUnitName) <> "" Then
       GetQuery = GetQuery & " and fd_accunit.cUnitName in (" & FillWithDot(tmp) & ") "
    End If
    
    '日期
    tmp = Trim(txtdStart)
    If tmp <> "" Then
       GetQuery = GetQuery & " and fd_budgethead.ddeclare>='" & tmp & "' "
    End If
    
    tmp = Trim(txtdEnd.Text)
    If tmp <> "" Then
        GetQuery = GetQuery & " and fd_budgethead.ddeclare<='" & tmp & "' "
    End If
    
    '制单人
    tmp = Trim(txtBill.Text)
    If tmp <> "" Then
        GetQuery = GetQuery & " and fd_budgethead.sbill in (" & FillWithDot(tmp) & ") "
    End If
    
    '审核人
    tmp = Trim(txtCheck.Text)
    If tmp <> "" Then
        GetQuery = GetQuery & " and fd_budgethead.scheck in (" & FillWithDot(tmp) & ") "
    End If
End Function

Private Sub LoadRefPic()
    btndStart.Picture = LoadResPicture(1108, vbResBitmap)
    btndEnd.Picture = LoadResPicture(1108, vbResBitmap)
    btnUnitName.Picture = LoadResPicture(129, vbResBitmap)
    btnBill.Picture = LoadResPicture(129, vbResBitmap)
    btnCheck.Picture = LoadResPicture(129, vbResBitmap)
    Me.Icon = LoadResPicture(109, vbResIcon)
End Sub