📄 frmcpbmcx.frm

📁 vb程序设计仁宇人份管理
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
            AutoSize        =   -1  'True
            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 = "frmcpbmcx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'实现产品编码的查询
Dim rsCx As Recordset
Dim nType As Integer
Dim strLjf As String
Dim strSQL As String
'双击以切换到产品编码维护界面
Private Sub Cell1_OnDClickGrid(ByVal col As Long, ByVal row As Long)
Cell1.DoGetCellData 0, row, strBm  '''''从当前行第0列中取数据以获得编码
frmCPBM.Tag = strBm
If strBm <> "" Then frmCPBM.Show vbModal
End Sub
'保证双击CELL边框仍能正常切换
Private Sub Cell1_OnLClickSideLabel(ByVal row As Long, ByVal UpDn As Boolean)
Cell1.DoGetCellData 0, row, strBm
frmCPBM.Tag = strBm
If strBm <> "" Then frmCPBM.Show vbModal
End Sub
'选择运算符
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()
        Dim strWhere As String
        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 12
        cmdtj.Enabled = True
End Sub
'关闭此窗口
Private Sub CmdExit_Click()
Unload Me
frmCPBM.Show vbModal
End Sub
'打印
Private Sub CmdPrt_Click()
Cell1.DoPrintPreview True
End Sub
'统计
Private Sub cmdtj_Click()
  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 Form_Load()
Cell1.DoLogin "HOLLYWAY", 294, "1404900178057C05E403710A870A"
    Set rsCx = New Recordset
    strSQL = "select * from cpbm "
    rsCx.Open strSQL & " order by 产品编码 ", dblgjx, adOpenDynamic, adLockOptimistic
    WrtCell 12
    For i = 0 To rsCx.Fields.Count - 1
        CmbZd.AddItem rsCx.Fields(i).Name
    Next
    strLjf = " and"
    cmdtj.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
'向CELL中间写数据
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
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -