dlgquerystr.frm

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

VERSION 5.00
Begin VB.Form Dlgquerystr 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "请选择查询条件"
   ClientHeight    =   2745
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6030
   FillStyle       =   0  'Solid
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2745
   ScaleWidth      =   6030
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdref 
      Height          =   255
      Index           =   2
      Left            =   4800
      Style           =   1  'Graphical
      TabIndex        =   15
      Top             =   1680
      Width           =   255
   End
   Begin VB.CommandButton cmdref 
      Height          =   255
      Index           =   1
      Left            =   4800
      Style           =   1  'Graphical
      TabIndex        =   14
      Top             =   960
      Width           =   255
   End
   Begin VB.CommandButton cmdref 
      Height          =   255
      Index           =   0
      Left            =   4800
      Style           =   1  'Graphical
      TabIndex        =   13
      Top             =   240
      Width           =   255
   End
   Begin VB.ComboBox Cmblogic 
      Height          =   300
      Index           =   1
      ItemData        =   "Dlgquerystr.frx":0000
      Left            =   5160
      List            =   "Dlgquerystr.frx":0002
      Style           =   2  'Dropdown List
      TabIndex        =   12
      Top             =   960
      Width           =   735
   End
   Begin VB.ComboBox Cmblogic 
      Height          =   300
      Index           =   0
      ItemData        =   "Dlgquerystr.frx":0004
      Left            =   5160
      List            =   "Dlgquerystr.frx":0006
      Style           =   2  'Dropdown List
      TabIndex        =   11
      Top             =   240
      Width           =   735
   End
   Begin VB.TextBox txtstr 
      Height          =   270
      Index           =   2
      Left            =   2760
      MaxLength       =   40
      TabIndex        =   10
      Top             =   1680
      Width           =   2295
   End
   Begin VB.TextBox txtstr 
      Height          =   270
      Index           =   1
      Left            =   2760
      MaxLength       =   40
      TabIndex        =   9
      Top             =   960
      Width           =   2295
   End
   Begin VB.TextBox txtstr 
      Height          =   270
      Index           =   0
      Left            =   2760
      MaxLength       =   40
      TabIndex        =   8
      Top             =   240
      Width           =   2295
   End
   Begin VB.ComboBox Cmbopr 
      Height          =   300
      Index           =   2
      ItemData        =   "Dlgquerystr.frx":0008
      Left            =   1800
      List            =   "Dlgquerystr.frx":000A
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   1680
      Width           =   855
   End
   Begin VB.ComboBox Cmbopr 
      Height          =   300
      Index           =   1
      ItemData        =   "Dlgquerystr.frx":000C
      Left            =   1800
      List            =   "Dlgquerystr.frx":000E
      Style           =   2  'Dropdown List
      TabIndex        =   6
      Top             =   960
      Width           =   855
   End
   Begin VB.ComboBox Cmbopr 
      Height          =   300
      Index           =   0
      ItemData        =   "Dlgquerystr.frx":0010
      Left            =   1800
      List            =   "Dlgquerystr.frx":0012
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   240
      Width           =   855
   End
   Begin VB.ComboBox CmbFld 
      Height          =   300
      Index           =   2
      ItemData        =   "Dlgquerystr.frx":0014
      Left            =   240
      List            =   "Dlgquerystr.frx":0016
      Style           =   2  'Dropdown List
      TabIndex        =   4
      Top             =   1680
      Width           =   1455
   End
   Begin VB.ComboBox CmbFld 
      Height          =   300
      Index           =   1
      ItemData        =   "Dlgquerystr.frx":0018
      Left            =   240
      List            =   "Dlgquerystr.frx":001A
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   960
      Width           =   1455
   End
   Begin VB.ComboBox CmbFld 
      CausesValidation=   0   'False
      Height          =   300
      Index           =   0
      ItemData        =   "Dlgquerystr.frx":001C
      Left            =   240
      List            =   "Dlgquerystr.frx":001E
      Style           =   2  'Dropdown List
      TabIndex        =   2
      Top             =   240
      Width           =   1455
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   3600
      TabIndex        =   1
      Top             =   2280
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   375
      Left            =   1440
      TabIndex        =   0
      Top             =   2280
      Width           =   1215
   End
End
Attribute VB_Name = "Dlgquerystr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'软件著作权：北京用友软件集团股份有限公司
'  系统名称：信用评价查询单位条件窗口
'  功能说明：定义信用评价查询单位条件
'      作者：罗涛
'      时间：2002-05-18

Option Explicit
Private sqlstr As String

Private Sub CancelButton_Click()
    cre_Where = ""
    Unload Me
End Sub


Private Sub CmbFld_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
            Cmbopr(Index).SetFocus
    ElseIf KeyCode = vbKeyUp Then
        If Index > 0 Then
            Cmblogic(Index - 1).SetFocus
        End If
    End If
End Sub

Private Sub Cmblogic_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
        CmbFld(Index + 1).SetFocus
    ElseIf KeyCode = vbKeyUp Then
        txtstr(Index).SetFocus
    End If
End Sub

Private Sub Cmbopr_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
            txtstr(Index).SetFocus
    ElseIf KeyCode = vbKeyUp Then
            CmbFld(Index).SetFocus
    End If
End Sub

Private Sub cmdref_Click(Index As Integer)
    sqlstr = ""
    If CmbFld(Index).ListIndex = 2 Then
        sqlstr = "select distinct itype As 单位类型编号,case itype when 0 then '个人' when 1 then '部门' when 2 then '银行' when 3 then '客户' when 4 then '供应商' when 5 then '项目' end as 单位类型 from Fd_accunit order by itype"
    ElseIf CmbFld(Index).ListIndex = 0 Then
        sqlstr = "select iid As '序号',cUnitname As '单位名称' from fd_accunit order by iid"
    ElseIf CmbFld(Index).ListIndex = 1 Then
        sqlstr = "select iid As '序号',cUnitcode As '单位代码' from fd_accunit order by iid"
    End If
    
    If sqlstr = "" Then
        MsgBox "请先选择字段名", vbInformation, " 查询条件"
        Exit Sub
    End If
    
    Dim rs1 As New ADODB.Recordset
    Dim rfd As New UFReferC.UFReferClient
    rfd.SetLogin zjLogInfo
    rfd.SetReferSQLString sqlstr
    rfd.SetReferDisplayMode enuGrid
    rfd.Show
    If rfd.recmx Is Nothing Then Exit Sub
    Set rs1 = rfd.recmx
    If CmbFld(Index).ListIndex <> 2 Then
        txtstr(Index).Text = Trim(rs1(1))
    Else
        txtstr(Index).Text = Trim(rs1(0))
    End If
    Set rfd = Nothing
    Set rs1 = Nothing
    
End Sub

Private Sub Form_Load()
Dim i As Integer

sqlstr = ""
Me.Icon = LoadResPicture(109, vbResIcon)

For i = 0 To 2
    cmdref(i).Picture = LoadResPicture(129, vbResBitmap)
Next
For i = 0 To 2
    CmbFld(i).clear
    CmbFld(i).AddItem "单位名称", 0
    CmbFld(i).AddItem "单位代码", 1
    CmbFld(i).AddItem "单位类型", 2
Next
For i = 0 To 2
    Cmbopr(i).clear
    Cmbopr(i).AddItem "="
    Cmbopr(i).AddItem "<>"
    Cmbopr(i).AddItem "like"
Next
For i = 0 To 1
    Cmblogic(i).clear
    Cmblogic(i).AddItem "And"
    Cmblogic(i).AddItem "Or"
Next
End Sub

Private Sub OKButton_Click()
    Dim str As String
    cre_Where = ""
    
    If CmbFld(0).Text <> "" And Cmbopr(0).Text <> "" Then
        str = CmbFld(0).Text & Cmbopr(0).Text & txtstr(0).Text
        Select Case CmbFld(0).ListIndex
            Case 0
                cre_Where = cre_Where & " cUnitName "
            Case 1
                cre_Where = cre_Where & " cUnitCode "
            Case 2
                cre_Where = cre_Where & " itype "
        End Select
        If Cmbopr(0).ListIndex <> 2 Then
            If CmbFld(0).ListIndex <> 2 Then
                cre_Where = cre_Where & Cmbopr(0).Text & "'" & Trim(txtstr(0).Text) & "'"
            Else
                If IsNumeric(txtstr(0).Text) Then
                    If Int(txtstr(0).Text) < 6 And Int(txtstr(0).Text >= 0) Then
                        cre_Where = cre_Where & Cmbopr(0).Text & CInt(Trim(txtstr(0).Text))
                    Else
                        MsgBox "单位类型只能是0-5的整数", vbInformation, "输入错误"
                        Exit Sub
                    End If
                Else
                    MsgBox "单位类型只能是0-5的整数", vbInformation, "输入错误"
                    Exit Sub
                End If
            End If
        Else
            cre_Where = cre_Where & " " & Cmbopr(0).Text & " " & "'%" & Trim(txtstr(0).Text) & "%'"
        End If
    End If
    
    If CmbFld(1).Text <> "" And Cmbopr(1).Text <> "" Then
        If Cmblogic(0).Text <> "" Then
            str = str & " " & Cmblogic(0).Text
            If Trim(cre_Where) <> "" Then cre_Where = cre_Where & " " & Cmblogic(0).Text
        Else
            str = str & " And "
            If Trim(cre_Where) <> "" Then cre_Where = cre_Where & " And "
        End If
        str = str & " " & CmbFld(1).Text & Cmbopr(1).Text & Trim(txtstr(1).Text)
        Select Case CmbFld(1).ListIndex
            Case 0
                cre_Where = cre_Where & " cUnitName"
            Case 1
                cre_Where = cre_Where & " cUnitCode"
            Case 2
                cre_Where = cre_Where & " itype"
        End Select
        If Cmbopr(1).ListIndex <> 2 Then
            If CmbFld(1).ListIndex <> 2 Then
                cre_Where = cre_Where & Cmbopr(1).Text & "'" & Trim(txtstr(1).Text) & "'"
            Else
                If IsNumeric(txtstr(1).Text) Then
                    If Int(txtstr(1).Text) < 6 And Int(txtstr(1).Text >= 0) Then
                        cre_Where = cre_Where & Cmbopr(1).Text & Trim(txtstr(1).Text)
                    Else
                        MsgBox "单位类型只能是0-5的整数", vbInformation, "输入错误"
                        Exit Sub
                    End If
                Else
                    MsgBox "单位类型只能是0-5的整数", vbInformation, "输入错误"
                    Exit Sub
                End If
            End If
        Else
            cre_Where = cre_Where & " " & Cmbopr(1).Text & " " & "'%" & Trim(txtstr(1).Text) & "%'"
        End If
    End If
    
    If CmbFld(2).Text <> "" And Cmbopr(2).Text <> "" Then
        If Cmblogic(1).Text <> "" Then
            str = str & " " & Cmblogic(1).Text
            If Trim(cre_Where) <> "" Then cre_Where = cre_Where & " " & Cmblogic(1).Text
        Else
            str = str & " And "
            If Trim(cre_Where) <> "" Then cre_Where = cre_Where & " And "
        End If
        str = str & " " & CmbFld(2).Text & Cmbopr(2).Text & txtstr(2).Text
        Select Case CmbFld(2).ListIndex
            Case 0
                cre_Where = cre_Where & " cUnitName"
            Case 1
                cre_Where = cre_Where & " cUnitCode"
            Case 2
                cre_Where = cre_Where & " itype"
        End Select
        If Cmbopr(2).ListIndex <> 2 Then
            If CmbFld(2).ListIndex <> 2 Then
                cre_Where = cre_Where & Cmbopr(2).Text & " '" & Trim(txtstr(2).Text) & "'"
            Else
                If IsNumeric(txtstr(2).Text) Then
                    If Int(txtstr(2).Text) < 6 And Int(txtstr(2).Text >= 0) Then
                        cre_Where = cre_Where & Cmbopr(2).Text & Trim(txtstr(2).Text)
                    Else
                        MsgBox "单位类型只能是0-5的整数", vbInformation, "输入错误"
                        Exit Sub
                    End If
                Else
                    MsgBox "单位类型只能是0-5的整数", vbInformation, "输入错误"
                    Exit Sub
                End If
            End If
        Else
            cre_Where = cre_Where & " " & Cmbopr(2).Text & " " & "'%" & Trim(txtstr(2).Text) & "%'"
        End If
    End If
'    Dim result As VbMsgBoxResult
'    result = MsgBox("您选择的查找条件是:" & str & vbCrLf & "请确认！", vbOKCancel, "查找条件")
'    If result = vbOK Then
        Unload Me
'    Else
'        'Me.Unload 1
'    End If
End Sub

Private Sub txtstr_KeyUp(Index As Integer, KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyF2 And Shift = 0 Then
        cmdref_Click (Index)
    ElseIf KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
        If Index < 2 Then
            Cmblogic(Index).SetFocus
        End If
    ElseIf KeyCode = vbKeyUp Then
            Cmbopr(Index).SetFocus
    End If
End Sub