frmpz_search.frm

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

            '客户
            i = i + 1
            If Trim$(txtCustomer.text) <> "" Then
                Set rSt = New Recordset
                rSt.Open "Select * from tZW_Customer" + glo.sOperateYear + " where cCusCode='" + txtCustomer + "' or  cCusName='" + txtCustomer + "'", glo.cnnMain, adOpenKeyset, adLockOptimistic
                If rSt.EOF = True Then
                    MsgBox "此客户不存在！", vbInformation
                    Exit Sub
                Else
                    sStr(i) = " B.cCusCode='" + Trim$(rSt.Fields("cCusCode").value) + "'"
                End If
            End If
            '供应商
            i = i + 1
            If Trim$(txtVendor.text) <> "" Then
                Set rSt = New Recordset
                rSt.Open "Select * from tZW_Vendor" & glo.sOperateYear & " where cVenCode='" + txtVendor + "' or  cVenName='" + txtVendor + "'", glo.cnnMain, adOpenKeyset, adLockOptimistic
                If rSt.EOF = True Then
                    MsgBox "此供应商不存在！", vbInformation
                    Exit Sub
                Else
                    sStr(i) = " B.cVenCode='" + Trim$(rSt.Fields("cVenCode").value) + "'"
                End If
            End If
        End If
        If Trim$(txtDepartment) <> "" Or Trim$(txtItem) <> "" Then
            sTable = sTable + " ,tFz_xmbmpzsj" + glo.sOperateYear + " C "
            i = i + 1
            sStr(i) = " A.pzzl=C.pzzl and A.pzbh=C.pzbh" + _
                " and A.Kjqj=C.Kjqj "
            '部门
            i = i + 1
            If Trim$(txtDepartment) <> "" Then
                Set rSt = New Recordset
                rSt.Open "Select * from tUSU_Department" & glo.sOperateYear & " where cDepCode='" + txtDepartment + "' or  cDepName='" + txtDepartment + "'", glo.cnnMain, adOpenKeyset, adLockOptimistic
                If rSt.EOF = True Then
                    MsgBox "此部门不存在！", vbInformation
                    Exit Sub
                Else
                    sStr(i) = " C.bmdm='" + Trim$(rSt.Fields("cDepCode").value) + "'"
                End If
            End If
            '项目
            i = i + 1
            If Trim$(txtItem) <> "" Then
                Set rSt = New Recordset
                rSt.Open "Select * from tZW_Item" & glo.sOperateYear & " where cCode='" + txtItem + "' or  cName='" + txtItem + "'", glo.cnnMain, adOpenKeyset, adLockOptimistic
                If rSt.EOF = True Then
                    MsgBox "此项目不存在！", vbInformation
                    Exit Sub
                Else
                    sStr(i) = " C.xmdm='" + Trim$(rSt.Fields("cCode").value) + "'"
                End If
            End If
        End If
        '票号
        i = i + 1
        If Trim(txtBillNo1.text) = "" And Trim(txtBillNo2.text) = "" Then
            sStr(i) = ""
        ElseIf Trim(txtBillNo1.text) <> "" And Trim(txtBillNo2.text) <> "" Then
            If Val(txtBillNo1.text) > Val(txtBillNo2.text) Then
                MsgBox "票号范围输入的下界值大于上界值！", vbInformation
                Call FullSelTextbox(txtBillNo2)
                Exit Sub
            Else
                sStr(i) = "(A.yhdz_bill>='" & txtBillNo1.text & _
                    "' AND A.yhdz_bill<='" & txtBillNo2.text & _
                    "') "
            End If
        ElseIf Trim(txtBillNo1.text) <> "" Then
            sStr(i) = "(A.yhdz_bill>='" & Trim(txtBillNo1.text) & "')"
        Else
            sStr(i) = "(A.yhdz_bill<='" & Trim(txtBillNo2.text) & "')"
        End If
   End If
   
'二、将查询的每个条件置入数组
    'Condition 1: "Range"
    Select Case True
        Case optEntire.value
   '================================2002.8.14= yao revise================================
'            sStr(1) = "NOT (xgbz IS NULL)"
            sStr(1) = ""
   '=====================================================================================
        Case optChalked.value
            sStr(1) = "A.xgbz='2'"
        Case optUnChalked.value And optAll.value
            sStr(1) = "A.xgbz<>'2'"
        Case optUnChalked.value And optChecked.value
            sStr(1) = "A.xgbz='1'"
        Case optUnChalked.value And optWrong.value
            sStr(1) = "A.xgbz='9'"
        Case optUnChalked.value And optUnChecked.value
            sStr(1) = "A.xgbz='0'"
    End Select
    'Condition 2: "Time"
    Select Case True
        Case optPeriod.value
            sStr(2) = "A.kjqj=" & CStr(cboPeriod.ItemData(cboPeriod.ListIndex))
        Case optDateSect.value
            sStr(2) = "(A.pzrq>=" & GetDateString(g_FLAT, dtpDateFrom.value) & _
                " AND A.pzrq<=" & GetDateString(g_FLAT, dtpDateTo.value) & _
                ") AND A.kjqj<=12"
        Case optOneDay.value
            sStr(2) = "A.pzrq=" & GetDateString(g_FLAT, dtpOneDay.value) & _
                " AND A.kjqj<=12"
    End Select
    'Condition 3: "Voucher type"
    If chkPzType.Enabled And chkPzType.value Then
        sStr(3) = "A.pzzl='" & Trim(cboPzType.text) & "'"
    Else
        sStr(3) = ""
    End If
    'Condition 4: "Voucher number"
    If chkPzbh.Enabled And chkPzbh.value Then
        If Trim(txtPzbhFrom.text) <> "" And Trim(txtPzbhTo.text) <> "" Then
            sStr(4) = "(A.pzbh>='" & Trim(txtPzbhFrom.text) & _
                "' AND A.pzbh<='" & Trim(txtPzbhTo.text) & "')"
        ElseIf Trim(txtPzbhFrom.text) <> "" Then
            sStr(4) = "(A.pzbh>='" & Trim(txtPzbhFrom.text) & "')"
        Else
            sStr(4) = "(A.pzbh<='" & Trim(txtPzbhTo.text) & "')"
        End If
    End If
    'Condition 5: "Bill man"
    If chkZDr.Enabled And chkZDr.value Then
        sStr(5) = "(A.zdrm='" & Trim(cboZDr.text) & "' or A.zdrmCode='" + Trim(cboZDr.text) + "')"
    End If
    'Condition 6: "Check man"
    If chkFHr.Enabled And chkFHr.value Then
        sStr(6) = "(A.fhrm='" & Trim(cboFHr.text) & "' or A.fhrmCode='" + Trim(cboFHr.text) + "')"
    End If
    
'三、连接各条件
    m_sSQL = ""
    For i = LBound(sStr) To UBound(sStr)
        If sStr(i) <> "" Then
            m_sSQL = m_sSQL & sStr(i) & " AND "
        End If
    Next i

'四、生成查询语句
    m_sSQL = Left$(m_sSQL, Len(m_sSQL) - 5)
    
    Select Case m_uFunction
    '“凭证汇总”
        Case pzsForTotal
            lLen = m_aryKmCodeLen(Val(txtLevel.text))
            Select Case g_FLAT
                '在 SQL 平台下可以执行如下形式的子查询
                Case "SQL"
                    m_sSQL = "SELECT DISTINCT LEFT(A.kmdm," & lLen & ") AS 'SubjCode'," & _
                        "(SELECT kmmc FROM tZW_km" & glo.sOperateYear & " WHERE kmdm=LEFT(A.kmdm," & lLen & ")) AS 'SubjName'," & _
                        "(SELECT SUM(je) FROM (SELECT je FROM tZW_pzsj" & glo.sOperateYear & " WHERE LEFT(kmdm," & lLen & _
                            ")=LEFT(A.kmdm," & lLen & ") AND " & m_sSQL & " AND fx='借') B) 'MoneyJ'," & _
                        "(SELECT SUM(je) FROM (SELECT je FROM tZW_pzsj" & glo.sOperateYear & " WHERE LEFT(kmdm," & lLen & _
                            ")=LEFT(A.kmdm," & lLen & ") AND " & m_sSQL & " AND fx='贷') C) 'MoneyD'" & _
                        " FROM tZW_pzsj" & glo.sOperateYear & " A " + sTable + " WHERE " & m_sSQL & " ORDER BY 1"
                
                '在 ORACLE 平台不支持如上形式的子查询
                Case "ORACLE"
                    m_sSqlDistinct = "SELECT DISTINCT SUBSTR(kmdm,1," & lLen & ") " & _
                        "FROM tZW_pzsj" & glo.sOperateYear & " A " + sTable + " WHERE " & m_sSQL & _
                        " ORDER BY 1"
            End Select
    '“凭证查询”、“凭证复核”
        Case pzsForSearchOnly, pzsforCheck
            Select Case g_FLAT
            Case "ORACLE"
            m_sSqlDistinct = "SELECT X.kjqj,X.pzzl,X.pzbh,X.pzrq,X.pzzy,X.fjzs,X.zdrm,X.fhrm,X.zgrm,X.xgbz,X.bSpecial,X.bSplitRec" + _
                " FROM tZW_pzsj" + glo.sOperateYear + " X, " + _
                " (SELECT A.kjqj||A.pzzl||A.pzbh||Min(A.jlhm) ID" & _
                " FROM tZW_pzsj" & glo.sOperateYear & " A " + sTable + _
                " WHERE " & m_sSQL & _
                " GROUP BY A.kjqj,A.pzzl,A.pzbh ) Y" + _
                " where X.kjqj||X.pzzl||X.pzbh||X.jlhm = Y.ID Order by X.kjqj,X.pzzl,X.pzbh"
            Case "SQL"
            m_sSqlDistinct = "SELECT X.kjqj,X.pzzl,X.pzbh,X.pzrq,X.pzzy,X.fjzs,X.zdrm,X.fhrm,X.zgrm,X.xgbz,X.bSpecial,X.bSplitRec" + _
                " FROM tZW_pzsj" + glo.sOperateYear + " X, " + _
                " (SELECT cast(A.kjqj as varchar)+A.pzzl+A.pzbh+cast(Min(A.jlhm) as varchar) ID" & _
                " FROM tZW_pzsj" & glo.sOperateYear & " A " + sTable + _
                " WHERE " & m_sSQL & _
                " GROUP BY A.kjqj,A.pzzl,A.pzbh ) Y" + _
                " where cast(X.kjqj as varchar)+X.pzzl+X.pzbh+cast(X.jlhm as varchar) = Y.ID Order by X.kjqj,X.pzzl,X.pzbh"
            End Select
    End Select
    
    Ok = True
    Me.Hide
              
End Sub

Private Sub cmdCancel_Click()
    Ok = False
    Unload Me
End Sub


Private Sub mvwOccurDate_DateDblClick(ByVal DateDblClicked As Date)
    txtOccurDate.text = Format(DateDblClicked, e_FMT_DATE)
    txtOccurDate.SetFocus
End Sub

Private Sub mvwOccurDate_LostFocus()
    mvwOccurDate.Visible = False
End Sub

Private Sub optChalked_Click()
    optAll.Enabled = False
    optChecked.Enabled = False
    optWrong.Enabled = False
    optUnChecked.Enabled = False
    chkFHr.Enabled = True
    cboFHr.Enabled = chkFHr.value
    cboFHr.BackColor = IIf(cboFHr.Enabled, vbWindowBackground, vbButtonFace)
End Sub

Private Sub optEntire_Click()
    optAll.Enabled = False
    optChecked.Enabled = False
    optWrong.Enabled = False
    optUnChecked.Enabled = False
    chkFHr.Enabled = False
    cboFHr.Enabled = False
    cboFHr.BackColor = vbButtonFace
End Sub

Private Sub optUnChalked_Click()
    optAll.Enabled = True
    optChecked.Enabled = True
    optWrong.Enabled = True
    optUnChecked.Enabled = True
    chkFHr.Enabled = optChecked.value
    If chkFHr.Enabled Then
        cboFHr.Enabled = chkFHr.value
        cboFHr.BackColor = IIf(cboFHr.Enabled, vbWindowBackground, vbButtonFace)
    Else
        cboFHr.Enabled = False
        cboFHr.BackColor = vbButtonFace
    End If
End Sub

Private Sub optAll_Click()
    chkFHr.Enabled = True
'    cboFHr.Enabled = True
    cboFHr.BackColor = vbButtonFace
End Sub

Private Sub optChecked_Click()
    chkFHr.Enabled = True
    cboFHr.Enabled = chkFHr.value
    If cboFHr.Enabled Then
        cboFHr.BackColor = vbWindowBackground
    Else
        cboFHr.BackColor = vbButtonFace
    End If
End Sub

Private Sub optWrong_Click()
    chkFHr.Enabled = False
    cboFHr.Enabled = False
    cboFHr.BackColor = vbButtonFace
End Sub

Private Sub optUnChecked_Click()
    chkFHr.Enabled = False
    cboFHr.Enabled = False
    cboFHr.BackColor = vbButtonFace
End Sub

Private Sub chkFHr_Click()
    cboFHr.Enabled = chkFHr.value
    cboFHr.BackColor = IIf(cboFHr.Enabled, vbWindowBackground, vbButtonFace)
End Sub

Private Sub chkPzbh_Click()
    txtPzbhFrom.Enabled = chkPzbh.value
    txtPzbhTo.Enabled = chkPzbh.value
    txtPzbhFrom.BackColor = IIf(txtPzbhFrom.Enabled, vbWindowBackground, vbButtonFace)
    txtPzbhTo.BackColor = IIf(txtPzbhTo.Enabled, vbWindowBackground, vbButtonFace)
End Sub

Private Sub chkPzType_Click()
    cboPzType.Enabled = chkPzType.value
    If cboPzType.Enabled Then
        cboPzType.BackColor = vbWindowBackground
    Else
        cboPzType.BackColor = vbButtonFace
    End If
End Sub

Private Sub chkZDr_Click()
    cboZDr.Enabled = chkZDr.value
    If cboZDr.Enabled Then
        cboZDr.BackColor = vbWindowBackground
    Else
        cboZDr.BackColor = vbButtonFace
    End If
End Sub

Private Sub optDateSect_Click()
    cboPeriod.Enabled = False
    cboPeriod.BackColor = vbButtonFace
    dtpDateFrom.Enabled = True
    dtpDateTo.Enabled = True
    dtpOneDay.Enabled = False
End Sub

Private Sub optOneDay_Click()
    cboPeriod.Enabled = False
    cboPeriod.BackColor = vbButtonFace
    dtpDateFrom.Enabled = False
    dtpDateTo.Enabled = False
    dtpOneDay.Enabled = True
End Sub

Private Sub optPeriod_Click()
    cboPeriod.Enabled = True
    cboPeriod.BackColor = vbWindowBackground
    dtpDateFrom.Enabled = False
    dtpDateTo.Enabled = False
    dtpOneDay.Enabled = False
End Sub

Private Sub txtAmount1_KeyPress(KeyAscii As Integer)
    KeyAscii = DoubleEnabled(txtAmount1.text, KeyAscii)
End Sub

Private Sub txtAmount2_KeyPress(KeyAscii As Integer)
    KeyAscii = DoubleEnabled(txtAmount2.text, KeyAscii)
End Sub

Private Sub txtBillNo1_KeyPress(KeyAscii As Integer)
    KeyAscii = IntegerEnabled(KeyAscii)
End Sub

Private Sub txtBillNo2_KeyPress(KeyAscii As Integer)
    KeyAscii = IntegerEnabled(KeyAscii)
End Sub

Private Sub txtCBD_LostFocus()
If Not SqlStringValid(txtCBD.text) Then
    MsgBox e_MSG_SQLVALID, vbInformation
    Call FullSelTextbox(txtCBD)
End If
End Sub

Private Sub txtCountMode_LostFocus()
If Not SqlStringValid(txtCountMode.text) Then
    MsgBox e_MSG_SQLVALID, vbInformation
    Call FullSelTextbox(txtCountMode)
End If
End Sub

Private Sub txtCustomer_LostFocus()
If Not SqlStringValid(txtCustomer.text) Then
    MsgBox e_MSG_SQLVALID, vbInformation
    Call FullSelTextbox(txtCustomer)
End If
End Sub

Private Sub txtDepartment_LostFocus()
If Not SqlStringValid(txtDepartment.text) Then
    MsgBox e_MSG_SQLVALID, vbInformation
    Call FullSelTextbox(txtDepartment)
End If
End Sub

Private Sub txtForeign1_KeyPress(KeyAscii As Integer)
    KeyAscii = DoubleEnabled(txtForeign1.text, KeyAscii)
End Sub

Private Sub txtForeign2_KeyPress(KeyAscii As Integer)
    KeyAscii = DoubleEnabled(txtForeign2.text, KeyAscii)
End Sub

Private Sub txtItem_LostFocus()
If Not SqlStringValid(txtItem.text) Then
    MsgBox e_MSG_SQLVALID, vbInformation
    Call FullSelTextbox(txtItem)
End If
End Sub

Private Sub txtLevel_KeyPress(KeyAscii As Integer)
    KeyAscii = IntegerEnabled(KeyAscii)
End Sub

Private Sub txtMoney1_KeyPress(KeyAscii As Integer)
    KeyAscii = NegativeDoubleEnabled(txtMoney1, KeyAscii)
End Sub

Private Sub txtMoney2_KeyPress(KeyAscii As Integer)