frmsearchsql.frm

师兄做的一个利用VB结合mapx组件做的超市查询小系统

VERSION 5.00
Begin VB.Form frmSearchSQL 
   Caption         =   "SQL查询"
   ClientHeight    =   3315
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7710
   LinkTopic       =   "Form1"
   ScaleHeight     =   3315
   ScaleWidth      =   7710
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton cmdExecute 
      Caption         =   "执行"
      Height          =   375
      Left            =   5520
      TabIndex        =   7
      Top             =   2400
      Width           =   1455
   End
   Begin VB.ComboBox cboValue 
      Height          =   300
      Left            =   5880
      TabIndex        =   6
      Top             =   1680
      Width           =   1575
   End
   Begin VB.ComboBox cboSymbol 
      Height          =   300
      Left            =   5880
      TabIndex        =   4
      Top             =   1020
      Width           =   1575
   End
   Begin VB.ComboBox cboField 
      Height          =   300
      Left            =   5880
      TabIndex        =   3
      Top             =   360
      Width           =   1575
   End
   Begin VB.TextBox txtSQLExpress 
      Height          =   2535
      Left            =   240
      MultiLine       =   -1  'True
      TabIndex        =   0
      Top             =   360
      Width           =   4575
   End
   Begin VB.Label Label4 
      Caption         =   "值"
      Height          =   255
      Left            =   5085
      TabIndex        =   5
      Top             =   1680
      Width           =   495
   End
   Begin VB.Label Label2 
      Caption         =   "运算符"
      Height          =   375
      Left            =   5085
      TabIndex        =   2
      Top             =   1020
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "列"
      Height          =   375
      Left            =   5085
      TabIndex        =   1
      Top             =   360
      Width           =   735
   End
End
Attribute VB_Name = "frmSearchSQL"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim oLayer As MapXLib.Layer
Dim DS As MapXLib.DataSet
Dim strSQL As String
Dim strFldType As Integer
Dim strFldName As String
Dim Lyr As MapXLib.Layer

Private Sub cboField_Click()
  Dim i As Integer
  Dim J As Integer
  
  J = cboField.ListIndex + 1
  cboValue.Clear
  Set oLayer = frmMain.MapDisp.Layers(frmMain.lstLayers.List(frmMain.lstLayers.ListIndex))
  Set DS = frmMain.MapDisp.DataSets(frmMain.lstLayers.List(frmMain.lstLayers.ListIndex))
  
  For i = 1 To DS.RowCount
      cboValue.AddItem DS.Value(i, J)
  Next i
  
  
  strSQL = strSQL + "" + Trim(cboField.Text)
  Me.txtSQLExpress.Text = strSQL
  
  strFldName = DS.fields(J).Name
  strFldType = DS.fields(J).Type
  J = 0
End Sub


Private Sub cboSymbol_Click()
    If cboField.Text = "" Then
        MsgBox "请先选择字段！", vbInformation
        Exit Sub
    End If
    
    If Trim(LCase(cboSymbol.Text)) = "like" Then
        strSQL = strSQL + " " + Trim(cboSymbol.Text) + " " + Chr(34) + "%"
    Else
        strSQL = strSQL + " " + Trim(cboSymbol.Text) + " "
    End If
    
    Me.txtSQLExpress.Text = strSQL
End Sub

Private Sub cboValue_Click()
    strSQL = strSQL + cboValue.Text
    Me.txtSQLExpress.Text = strSQL
End Sub

Private Sub cmdExecute_Click()
  
  strSQL = ""
  
  If Me.txtSQLExpress.Text = "" Then
    MsgBox "请输入查询条件！", vbInformation
  Else
    
    Dim FTRS As MapXLib.Features
    Set DS = frmMain.MapDisp.DataSets.Add(miDataSetLayer, oLayer)
    Set Lyr = DS.Layer
    
    Select Case strFldType
      Case miTypeString
        Set FTRS = Lyr.Search(Trim(Me.txtSQLExpress.Text + Chr(34)))
        Lyr.Selection.ClearSelection
        ListAttribute = False
        Lyr.Selection.Add FTRS
        
        If FTRS.Count > 1 Then
          frmMain.MapDisp.Bounds = FTRS.Bounds
        Else
          frmMain.MapDisp.CenterX = FTRS.Item(1).CenterX
          frmMain.MapDisp.CenterY = FTRS.Item(1).CenterY
          frmMain.MapDisp.Zoom = 2
        End If
      Case miTypeNumeric
        Set FTRS = Lyr.Search(Trim(Me.txtSQLExpress.Text))
        Lyr.Selection.ClearSelection
        ListAttribute = False
        Lyr.Selection.Add FTRS
        frmMain.MapDisp.Bounds = FTRS.Bounds
    End Select
    
    If Lyr.Selection.Count = 0 Then
        MsgBox "对不起，找不到记录！", vbInformation
    Else
        MsgBox "共找到" & Lyr.Selection.Count & "条记录", vbInformation
         Me.txtSQLExpress.Text = ""
    End If
  End If
  
 
End Sub

Private Sub Form_Load()
  Dim i As Integer
  
  Set oLayer = frmMain.MapDisp.Layers(frmMain.lstLayers.List(frmMain.lstLayers.ListIndex))
  Set DS = frmMain.MapDisp.DataSets(frmMain.lstLayers.List(frmMain.lstLayers.ListIndex))
  
  For i = 1 To DS.fields.Count
      cboField.AddItem DS.fields(i).Name
  Next i
  
  Set DS = Nothing
  
    cboSymbol.AddItem "+"
    cboSymbol.AddItem "-"
    cboSymbol.AddItem "*"
    cboSymbol.AddItem "/"
    cboSymbol.AddItem "\"
    cboSymbol.AddItem "^"
    cboSymbol.AddItem "="
    cboSymbol.AddItem "<>"
    cboSymbol.AddItem ">"
    cboSymbol.AddItem "<"
    cboSymbol.AddItem ">="
    cboSymbol.AddItem "<="
    cboSymbol.AddItem "and"
    cboSymbol.AddItem "or"
    cboSymbol.AddItem "not"
    cboSymbol.AddItem "like"
    
  Set DS = Nothing
  Set oLayer = Nothing
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Me.txtSQLExpress = ""
End Sub