frmxcpbmcx.frm

vb程序设计仁宇人份管理

            AutoSize        =   -1  'True
            Caption         =   "逻辑连接符："
            Height          =   180
            Index           =   8
            Left            =   90
            TabIndex        =   5
            Top             =   1275
            Width           =   1080
         End
      End
   End
End
Attribute VB_Name = "frmXcpbmcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'实现XCP表的查询
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 4
        'DataGrid1.Refresh
        cmdtj(0).Enabled = True
    End Select
End Sub
'关闭
Private Sub CmdExit_Click(Index As Integer)
   Unload Me
   frmXCPbm.Show vbModal
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 commZcsx_Click(Index As Integer)

End Sub

Private Sub DataGrid1_DblClick()
      frmXCPbm.Tag = rsCx("新产品编码")
      frmXCPbm.Show vbModal
'  Dim i As Integer
'  For i = 0 To 20
'     If rsCx(i) <> "" Then frmKHBM.txtfields(i).text = rsCx(i)
'  Next
'     If rsCx(23) <> "" Then frmKHBM.txtfields(21) = rsCx(23)
'     frmKHBM.lblStatus.Caption = "查询选中的记录"
'     frmKHBM.Show
     
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 to_char(日期,'yyyy-mm-dd'),新产品编码 from xcp"
    strSQL = "select * from xcp"
    rsCx.Open strSQL & " order by 新产品编码 ", dblgjx, adOpenDynamic, adLockOptimistic
    WrtCell 4
    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
    
    For j = 0 To FldCount - 1
      Cell1.DoAppendCol 1
      Cell1.DoSetCellString j, -1, rsCx(j).Name
    Next
    
    If rsCx.RecordCount <= 0 Then
       Exit Sub
    End If
    
    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
Private Sub Cell1_OnDClickGrid(ByVal col As Long, ByVal row As Long)
Cell1.DoGetCellData 1, row, strBm
frmXCPbm.Tag = strBm
If strBm <> "" Then frmXCPbm.Show vbModal

End Sub

Private Sub Cell1_OnDClickSideLabel(ByVal row As Long)
Cell1.DoGetCellData 1, row, strBm
frmXCPbm.Tag = strBm
If strBm <> "" Then frmXCPbm.Show vbModal

End Sub