使用计划汇总查询.frm

用友U8财务软件VB源程序, 本版本为2002年版本

    ElseIf KeyCode = vbKeySeparator Or KeyCode = vbKeyReturn Then
        SendKeys "{tab}"
    ElseIf KeyCode = vbKeyF2 Then
        If Me.ActiveControl.Name = "txtSDeclare" Then
            btnSDeclare_Click
        ElseIf Me.ActiveControl.Name = "txtEDeclare" Then
            btnEDeclare_Click
        ElseIf Me.ActiveControl.Name = "txtSApprove" Then
            btnSApprove_Click
        ElseIf Me.ActiveControl.Name = "txtEApprove" Then
            btnEApprove_Click
        ElseIf Me.ActiveControl.Name = "txtUnitName" Then
            btnUnitName_Click
        ElseIf Me.ActiveControl.Name = "txtPrjName" Then
            btnPrjName_Click
        ElseIf Me.ActiveControl.Name = "txtCurName" Then
            btnCurName_Click
        End If
    End If
End Sub

'窗体方法
Private Sub Form_Load()
    btnUnitName.Picture = LoadResPicture(129, vbResBitmap)
    btnPrjName.Picture = LoadResPicture(129, vbResBitmap)
    btnSDeclare.Picture = LoadResPicture(1108, vbResBitmap)
    btnEDeclare.Picture = LoadResPicture(1108, vbResBitmap)
    btnSApprove.Picture = LoadResPicture(1108, vbResBitmap)
    btnEApprove.Picture = LoadResPicture(1108, vbResBitmap)
    btnCurName.Picture = LoadResPicture(129, vbResBitmap)
    Me.Icon = LoadResPicture(109, vbResIcon)
'    FillCur cboCurName
'    Set m_objQuery = m_objAid.objMakeNode("query")
End Sub

Private Sub btnQuit_Click()
    m_sWhere = ""
    Unload Me
End Sub

Private Sub btnOk_Click()
    m_sWhere = GetQuery
    Unload Me
End Sub

'项目名称参照
Private Sub btnPrjName_Click()
    Dim rtn As ADODB.Recordset
    Dim str As String
    Dim Node As IXMLDOMElement
    
    On Error Resume Next
    
    Set Node = m_objRefTree.documentElement.selectSingleNode("prj")
    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
        txtPrjName.Text = mID(str, 1, Len(str) - 1)
    End If
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
    
    txtUnitName.Text = ""
    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 txtCurName_GotFocus()
    btnCurName.Visible = True
End Sub

Private Sub txtCurName_LostFocus()
    Dim tmp
    
    txtCurName = Trim(txtCurName)
    If Me.ActiveControl.Name = "btnQuit" Or Me.ActiveControl.Name = "btnCurName" Then
        Exit Sub
    ElseIf txtCurName = "" Then '不能为空
        iShowMsg "必须选择币种!"
        txtCurName.SetFocus
    Else
        tmp = vCheckExist("cur", txtCurName)
        If IsNull(tmp) Then '必须存在
            iShowMsg "币种错误!"
            txtCurName.SetFocus
        Else
            m_strCur = tmp
            btnCurName.Visible = False
        End If
    End If
End Sub

Private Sub txtEApprove_GotFocus()
    btnEApprove.Visible = True
End Sub

Private Sub txtEDeclare_GotFocus()
    btnEDeclare.Visible = True
End Sub

'时间控制
Private Sub txtEDeclare_LostFocus()
    Dim tmp As String
    
    If Me.ActiveControl.Name <> "btnEDeclare" And Trim(txtEDeclare.Text) = "" Then
        btnEDeclare.Visible = False
        Exit Sub
    End If
        
    If Me.ActiveControl.Name = "btnEDeclare" Then
        Exit Sub
    End If
   
    tmp = m_objAid.sCheckDate(txtEDeclare.Text)
    If tmp = "" Then
        iShowMsg "输入的日期格式不合法!"
        txtEDeclare.SetFocus
        Exit Sub
    End If
    
    If txtSDeclare.Text = txtEDeclare.Text Then
    
    ElseIf m_objAid.iDateDiff(txtSDeclare.Text, txtEDeclare.Text, "d") < 0 Then
        iShowMsg "起始日期不得大于截至日期!"
        txtEDeclare.SetFocus
        Exit Sub
    End If
    txtEDeclare.Text = tmp
    btnEDeclare.Visible = False
End Sub

Private Sub txtSApprove_GotFocus()
    btnSApprove.Visible = True
End Sub

Private Sub txtSDeclare_GotFocus()
    btnSDeclare.Visible = True
End Sub

Private Sub txtSDeclare_LostFocus()
    Dim tmp As String
    
    If Me.ActiveControl.Name <> "btnSDeclare" And Trim(txtSDeclare.Text) = "" Then
        btnSDeclare.Visible = False
        Exit Sub
    End If
        
    If Me.ActiveControl.Name = "btnSDeclare" Then
        Exit Sub
    End If
    
    tmp = m_objAid.sCheckDate(txtSDeclare.Text)
    
    If tmp = "" Then
        iShowMsg "输入的日期格式不合法!"
        txtSDeclare.SetFocus
        Exit Sub
    End If
    
    If txtSDeclare.Text = txtEDeclare.Text Then
    
    ElseIf m_objAid.iDateDiff(txtSDeclare.Text, txtEDeclare.Text, "d") < 0 Then
        iShowMsg "起始日期不得大于截至日期!"
        txtEDeclare.SetFocus
        Exit Sub
    End If
    txtSDeclare.Text = tmp
    btnSDeclare.Visible = False
End Sub

Private Sub txtEApprove_LostFocus()
    Dim tmp As String
    
    If Me.ActiveControl.Name <> "btnEApprove" And Trim(txtEApprove.Text) = "" Then
        btnEApprove.Visible = False
        Exit Sub
    End If
    
    If Me.ActiveControl.Name = "btnEApprove" Then
        Exit Sub
    End If
    
    tmp = m_objAid.sCheckDate(txtEApprove.Text)
    If tmp = "" Then
        iShowMsg "输入的日期格式不合法!"
        txtEApprove.SetFocus
        Exit Sub
    End If
    
    If txtSApprove.Text = txtEApprove Then
    
    ElseIf m_objAid.iDateDiff(txtSApprove.Text, txtEApprove.Text, "d") < 0 Then
        iShowMsg "起始日期不得大于截至日期!"
        txtEApprove.SetFocus
        Exit Sub
    End If
    txtEApprove.Text = tmp
    btnEApprove.Visible = False
End Sub

Private Sub txtSApprove_LostFocus()
    Dim tmp As String
    
    If Me.ActiveControl.Name <> "btnSApprove" And Trim(txtSApprove.Text) = "" Then
        btnSApprove.Visible = False
        Exit Sub
    End If
    
    If Me.ActiveControl.Name = "btnSApprove" Then
        Exit Sub
    End If
    
    tmp = m_objAid.sCheckDate(txtSApprove.Text)
    
    If tmp = "" Then
        iShowMsg "输入的日期格式不合法!"
        txtSApprove.SetFocus
        Exit Sub
    End If
    
    If txtSApprove.Text = txtEApprove Then
    
    ElseIf m_objAid.iDateDiff(txtSApprove.Text, txtEApprove.Text, "d") < 0 Then
        iShowMsg "起始日期不得大于截至日期!"
        txtEApprove.SetFocus
        Exit Sub
    End If
    txtSApprove.Text = tmp
    btnSApprove.Visible = False
End Sub

Private Sub btnEApprove_Click()
    ShowDateRef Me.txtEApprove
End Sub

'时间参照
Private Sub btnEDeclare_Click()
    ShowDateRef Me.txtEDeclare
End Sub

Private Sub btnSApprove_Click()
    ShowDateRef Me.txtSApprove
End Sub

Private Sub btnSDeclare_Click()
    ShowDateRef Me.txtSDeclare
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.Text)
    If tmp <> "" Then
        If mID(tmp, 1, 1) = "," Then    '去掉多余的,号
            tmp = mID(tmp, 2)
            txtUnitName.Text = tmp
            txtUnitName_LostFocus
        ElseIf mID(tmp, Len(tmp), 1) = "," Then
            tmp = mID(tmp, 1, Len(tmp) - 1)
            txtUnitName.Text = tmp
            txtUnitName_LostFocus
        End If
    End If
    txtUnitName.Text = tmp
    btnUnitName.Visible = False
End Sub

Private Sub txtPrjName_GotFocus()
    btnPrjName.Visible = True
End Sub

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