frmsfbmcx.frm

vb程序设计仁宇人份管理

            Caption         =   "输入条件值："
            Height          =   180
            Index           =   2
            Left            =   90
            TabIndex        =   6
            Top             =   945
            Width           =   1080
         End
         Begin VB.Label labHead 
            AutoSize        =   -1  'True
            Caption         =   "逻辑连接符："
            Height          =   180
            Index           =   8
            Left            =   90
            TabIndex        =   5
            Top             =   1275
            Width           =   1080
         End
      End
   End
End
Attribute VB_Name = "frmSfbmcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'实现SFBM表的查询
Dim rsCx As Recordset
Dim nType As Integer
Dim strLjf As String
Dim strSQL As String
''选择运算符
Private Sub CmbYsf_Click()
    If Trim(CmbYsf.Text) = "" Then Exit Sub
    Text1 = ""
    Text2 = ""
    txtV1 = ""
    nType = 0
    Select Case rsCx.Fields(CmbZd.ListIndex).Type
    Case adVarChar, adChar
        pctValue1.Visible = True
        pctValue2.Visible = False
        pctDate1.Visible = False
        pctDate2.Visible = False
        If CmbYsf.ListIndex = 0 Then nType = 10
        If CmbYsf.ListIndex = 1 Then nType = 11
        If CmbYsf.ListIndex = 2 Then nType = 12
        If CmbYsf.ListIndex = 3 Then nType = 13
        If CmbYsf.ListIndex = 4 Then nType = 14
        If CmbYsf.ListIndex = 5 Then nType = 15

    Case adNumeric, adVarNumeric
        If CmbYsf.ListIndex = 6 Then
            pctValue1.Visible = False
            pctValue2.Visible = True
            pctDate1.Visible = False
            pctDate2.Visible = False
            nType = 26
        Else
            pctValue1.Visible = True
            pctValue2.Visible = False
            pctDate1.Visible = False
            pctDate2.Visible = False
            nType = 20
        End If
    Case adDBTimeStamp
        If CmbYsf.ListIndex = 6 Then
            pctValue1.Visible = False
            pctValue2.Visible = False
            pctDate1.Visible = False
            pctDate2.Visible = True
            nType = 36
        Else
            pctValue1.Visible = False
            pctValue2.Visible = False
            pctDate1.Visible = True
            pctDate2.Visible = False
            nType = 30
        End If
    End Select
End Sub

Private Sub CmbZd_Click()
    Text1 = ""
    Text2 = ""
    txtV1 = ""
    ''''根据字段的不同类型添加不同的运算符
    Select Case rsCx.Fields(CmbZd.ListIndex).Type
    Case adVarChar, adChar
        CmbYsf.Clear
        CmbYsf.AddItem "包 含"
        CmbYsf.AddItem "向前包含"
        CmbYsf.AddItem "向后包含"
        CmbYsf.AddItem "等 于                       ="
        CmbYsf.AddItem "大 于                       >"
        CmbYsf.AddItem "小 于                       <"

    Case adNumeric, adVarNumeric, adDBTimeStamp
        CmbYsf.Clear
        CmbYsf.AddItem "等于                       ="
        CmbYsf.AddItem "小于                       <"
        CmbYsf.AddItem "小于等于                  <="
        CmbYsf.AddItem "大于                       >"
        CmbYsf.AddItem "大于等于                  >="
        CmbYsf.AddItem "不等于                    <>"
        CmbYsf.AddItem "介于"
    End Select

End Sub
'查询
Private Sub CmdCx_Click(Index As Integer)
    Dim strWhere As String
    Select Case Index
    Case 0
    Case 1
      
    Case 2
        If rsCx.State = adStateOpen Then rsCx.Close
        If listTj.ListCount = 0 Then
            rsCx.Open strSQL, dblgjx, adOpenDynamic, adLockOptimistic
        Else
            strWhere = ""
            For i = 0 To listTj.ListCount - 1
                strWhere = strWhere & listTj.List(i) & " "
            Next
            strWhere = Mid(strWhere, 1, Len(strWhere) - 4)
            rsCx.Open strSQL & " where  " & strWhere & " order by 省份编码 ", dblgjx, adOpenDynamic, adLockOptimistic
        End If
        WrtCell 2
        cmdtj(0).Enabled = True
        
    End Select
    
End Sub
'关闭
Private Sub CmdExit_Click(Index As Integer)
frmSfbm.Show
Unload Me
End Sub
'统计
Private Sub cmdtj_Click(Index As Integer)
  If rsCx.RecordCount > 0 Then
     MsgBox "符合条件的记录共有" & rsCx.RecordCount & "条！", 64, "统计结果"
  Else
     MsgBox "不存在符合条件的记录！", 64, "统计结果"
  End If
End Sub
'添加或移除条件
Private Sub Command1_Click(Index As Integer)
    Dim strTj As String
    Select Case Index
    Case 0
        If CmbZd.ListIndex >= 0 And CmbYsf.ListIndex >= 0 Then
            Select Case nType
            Case 10
                If Trim(txtV1) <> "" Then
                    strTj = Trim(CmbZd.Text) & " like '%" & Trim(txtV1) & "%'"
                Else
                    Exit Sub
                End If
            Case 11
                If Trim(txtV1) <> "" Then
                    strTj = Trim(CmbZd.Text) & " like '" & Trim(txtV1) & "%'"
                Else
                    Exit Sub
                End If
            Case 12
                If Trim(txtV1) <> "" Then
                    strTj = Trim(CmbZd.Text) & " like '%" & Trim(txtV1) & "'"
                Else
                    Exit Sub
                End If

            Case 13, 14, 15    '''''''''等于,小于,大于
                If Trim(txtV1) <> "" Then
                    strTj = Trim(CmbZd.Text) & Right(CmbYsf.Text, 1) & "'" & Trim(txtV1) & "'"
                Else
                    Exit Sub
                End If
            Case 20
                If Trim(txtV1) <> "" And IsNumeric(txtV1) Then
                    strTj = Trim(CmbZd.Text) & Trim(Right(CmbYsf.Text, 2)) & Trim(txtV1)
                Else
                    Exit Sub
                End If
            Case 26
                If Trim(Text1) <> "" And Trim(Text2) <> "" And IsNumeric(Text1) And IsNumeric(Text2) Then
                    strTj = Trim(CmbZd.Text) & " between " & Trim(Text1) & " and " & Trim(Text2)
                Else
                    Exit Sub
                End If
            Case 30
                strTj = Trim(CmbZd.Text) & Trim(Right(CmbYsf.Text, 2)) & "to_date('" & Format(DTPicker1.Value, "yyyymmdd") & "','yyyymmdd')"
            Case 36
                strTj = Trim(CmbZd.Text) & " between " & "to_date('" & Format(DTPicker2.Value, "yyyymmdd") & "','yyyymmdd') and " & "to_date('" & Format(DTPicker3.Value, "yyyymmdd") & "','yyyymmdd')"
            End Select
            
            listTj.AddItem strTj & strLjf
        Else
            MsgBox "请选择需查询的字段！"
        End If
    Case 1
        If listTj.ListIndex <> -1 Then
            listTj.RemoveItem listTj.ListIndex
        End If
    End Select
End Sub
'打印
Private Sub Command2_Click()
Cell1.DoPrintPreview True
End Sub

Private Sub Form_Load()
Cell1.DoLogin "HOLLYWAY", 294, "1404900178057C05E403710A870A"
    Set rsCx = New Recordset
    strSQL = "select * from sfbm "
    rsCx.Open strSQL & " order by 省份编码 ", dblgjx, adOpenDynamic, adLockOptimistic
    WrtCell 2
    For i = 0 To rsCx.Fields.Count - 1
        CmbZd.AddItem rsCx.Fields(i).Name
    Next
    strLjf = " and"
    cmdtj(0).Enabled = False
    CmbZd.ListIndex = 0
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If rsCx.State = adStateOpen Then rsCx.Close
End Sub
'选择逻辑运算符
Private Sub Option1_Click(Index As Integer)
    If Index = 0 Then
        strLjf = " and"
    Else
        strLjf = " or"
    End If
End Sub
'写数据模块
Private Sub WrtCell(FldCount As Integer)
    '清空足够的行列空间以实现写数据时的行列动态变化
    Cell1.DoDeleteCol 0, 30
    Cell1.DoDeleteRow 1, 2000
    '判断有否数据
    If rsCx.RecordCount <= 0 Then
       Exit Sub
    End If
     '写上边框字段名
    For j = 0 To FldCount - 1
      Cell1.DoAppendCol 1
      Cell1.DoSetCellString j, -1, rsCx(j).Name
    Next
    '写数据
    rsCx.MoveFirst
    Cell1.DoAppendRow rsCx.RecordCount - 1
    For i = 0 To rsCx.RecordCount - 1
      For j = 0 To FldCount - 1
        If rsCx(j) <> "" Then Cell1.DoSetCellString j, i, rsCx(j)
      Next
      rsCx.MoveNext
    Next
    '设只读
    For i = 0 To FldCount - 1
      For j = 0 To rsCx.RecordCount - 1
        Cell1.DoSetCellReadOnly i, j, True
      Next
    Next
End Sub
'双击cell,弹出对应的编码维护窗口
Private Sub Cell1_OnDClickGrid(ByVal col As Long, ByVal row As Long)
Cell1.DoGetCellData 0, row, strBm
frmSfbm.Tag = strBm
If strBm <> "" Then frmSfbm.Show vbModal
End Sub
'双击cell,弹出对应的编码维护窗口(双击边框时也有效)
Private Sub Cell1_OnDClickSideLabel(ByVal row As Long)
Cell1.DoGetCellData 0, row, strBm
frmSfbm.Tag = strBm
If strBm <> "" Then frmSfbm.Show vbModal
End Sub