frmsqlexpression.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

Attribute VB_Exposed = False
Option Explicit

Private Sub btnCancel_Click()
      Unload Me
End Sub

Private Sub btnOK_Click()
      Dim objDs As soDataSource
      Dim objDtVector As soDatasetVector
      Dim objRecordset As soRecordset
      Dim objDt As soDataset
      
      Set objDtVector = FrmMain.SuperMap1.Layers.Item(cmbLayerName.Text).Dataset
      If objDtVector Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      End If
      objDtVector.Open
      
      If chkSort.Value = vbChecked Then
            If optAscend.Value = True Then
                  Set objRecordset = objDtVector.Query(Trim$(txtExpression.Text), False, , "order by " & cmbSortfield.Text & " ASC")
            ElseIf optDescend.Value = True Then
                  Set objRecordset = objDtVector.Query(Trim$(txtExpression.Text), False, , "order by " & cmbSortfield.Text & " Desc")
            End If
      Else
            Set objRecordset = objDtVector.Query(Trim$(txtExpression.Text), True)
      End If
      
      If objRecordset Is Nothing Then
            MsgBox "错误！ ", vbInformation
            Exit Sub
      End If
      FrmMain.strDtName = ""
      If (chkSaveAsDt.Value = vbChecked) Then                    '保存为数据集
            If cmbDSName.ListIndex = -1 Then
                  MsgBox "请选择目标数据源！", vbInformation
                  cmbDSName.SetFocus
                  Exit Sub
            Else
                  Set objDs = FrmMain.SuperWorkspace1.Datasources.Item(cmbDSName.Text)
            End If
            If objDs Is Nothing Then
                  MsgBox "错误！", vbInformation
                  Exit Sub
            ElseIf objDs.IsAvailableDatasetName(txtDtName.Text) = True Then
		  Set objRecordset = objDtVector.Query(Trim$(txtExpression.Text), True)
                  Set objDt = objDs.RecordsetToDataset(objRecordset, Trim$(txtDtName.Text))
                  If objDt Is Nothing Then
                        MsgBox "错误！", vbInformation
                        Exit Sub
                  Else
                        FrmMain.strDtName = txtDtName
                        FrmMain.btnShowDt.Enabled = True
                  End If
            Else
                   MsgBox "数据集名称不合法或已被使用！", vbInformation
                  Exit Sub
            End If
            Set objDs = Nothing
      End If
      
      FrmMain.SuperMap1.selection.FromRecordset objRecordset
      If chkBrowse.Value = vbChecked Then                      '浏览查询结果
            Load frmDataSetStru
            Set frmDataSetStru.objRecordset = objRecordset
            Set frmDataSetStru.objDt = objDtVector
            Unload Me
            frmDataSetStru.Show , FrmMain
      End If
      
      Set objDtVector = Nothing
      Set objRecordset = Nothing
      Set objDt = Nothing
      Unload Me
End Sub

Private Sub chkBrowse_Click()
      '选中此项则显示查询结果
      If chkBrowse.Value = vbChecked Then
            chkSort.Enabled = True
            If chkSort.Value = vbChecked Then
                  cmbSortfield.BackColor = &H80000005
                  cmbSortfield.Enabled = True
                  optAscend.Enabled = True
                  optDescend.Enabled = True
            Else
                  cmbSortfield.BackColor = &H80000004
                  cmbSortfield.Enabled = False
                  optAscend.Enabled = False
                  optDescend.Enabled = False
            End If
      Else
            chkSort.Enabled = False
            cmbSortfield.BackColor = &H80000004
            cmbSortfield.Enabled = False
            optAscend.Enabled = False
            optDescend.Enabled = False
      End If
End Sub

Private Sub chkSaveAsDt_Click()
      '选中此项则把查询的结果保存到一个新的数据集中
      If chkSaveAsDt.Value = vbChecked Then
            cmbDSName.BackColor = &H80000005
            cmbDSName.Enabled = True
            cmbDSName.SetFocus
            txtDtName.Enabled = True
            txtDtName.BackColor = &H80000005
      Else
            txtDtName.Enabled = False
            txtDtName.BackColor = &H80000004
            cmbDSName.BackColor = &H80000004
            cmbDSName.Enabled = False
      End If
End Sub

Private Sub chkSort_Click()
      '选中此项则按指定的字段、指定的排序显示查询结果
      If chkSort.Value = vbChecked Then
            cmbSortfield.BackColor = &H80000005
            cmbSortfield.Enabled = True
            optAscend.Enabled = True
            optDescend.Enabled = True
      Else
            cmbSortfield.BackColor = &H80000004
            cmbSortfield.Enabled = False
            optAscend.Enabled = False
            optDescend.Enabled = False
      End If
End Sub

Private Sub cmbDsName_Click()
      '选择用来保存新的数据集的数据源
      If cmbDSName.ListIndex = -1 Then
            txtDtName.Enabled = False
            txtDtName.BackColor = &H80000004
      Else
            txtDtName.Enabled = True
            txtDtName.BackColor = &H80000005
      End If
End Sub

Private Sub cmbFieldName_Click()
      txtExpression.Text = txtExpression.Text & cmbFieldName.Text
End Sub

Private Sub cmbLayerName_Click()
      '选择查询的数据集
      Dim objLayer As soLayer
      Dim objDtVector As soDatasetVector
      Dim objFieldInfo As soFieldInfo
      Dim i As Integer
      
      cmbLayerName.ToolTipText = cmbLayerName.Text
      txtExpression.Text = ""
      
      Set objLayer = FrmMain.SuperMap1.Layers.Item(cmbLayerName.Text)
      If objLayer Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      End If
      Set objDtVector = objLayer.Dataset
      If objDtVector Is Nothing Then
             MsgBox "错误！", vbInformation
            Exit Sub
      End If
      cmbFieldName.Clear
      cmbSortfield.Clear
      '装载查询数据集的字段信息
      For i = 1 To objDtVector.FieldCount
            Set objFieldInfo = objDtVector.GetFieldInfo(i)
            If objFieldInfo Is Nothing Then
                  MsgBox "错误！", vbInformation
                  Exit Sub
            End If
            cmbFieldName.AddItem objFieldInfo.Name
            cmbSortfield.AddItem objFieldInfo.Name
      Next
      '释放内存
      Set objLayer = Nothing
      Set objDtVector = Nothing
      Set objFieldInfo = Nothing
      
End Sub

Private Sub cmbOperator_Click()
      txtExpression.Text = txtExpression.Text & cmbOperator.Text
End Sub

Private Sub Form_Load()
      '装载基本的查询对象和查询操作符
      Dim objDs As soDataSource
      Dim objLayers As soLayers
      Dim i As Integer
      
      lblMapName.Caption = FrmMain.Caption
      lblMapName.ToolTipText = lblMapName.Caption
      
      Set objLayers = FrmMain.SuperMap1.Layers
      If objLayers Is Nothing Then
            MsgBox "错误！", vbInformation
            Exit Sub
      End If
      cmbLayerName.Clear
      For i = 1 To objLayers.Count
            cmbLayerName.AddItem objLayers.Item(i).Name
      Next
      cmbLayerName.ListIndex = 0
      cmbOperator.Clear
      With cmbOperator              '运算符列表
            .AddItem "="
            .AddItem "<"
            .AddItem ">"
            .AddItem "<="
            .AddItem ">="
            .AddItem "<>"
            .AddItem "+"
            .AddItem "-"
            .AddItem "x"
            .AddItem "/"
            .AddItem "^"
            .AddItem "()"
            .AddItem """"
            .AddItem " In "
            .AddItem " Between "
            .AddItem " Like "
            .AddItem " is NULL "
            .AddItem " is True "
            .AddItem " is False "
            .AddItem " AND "
            .AddItem " OR "
            .AddItem " NOT "
      End With
      For Each objDs In FrmMain.SuperWorkspace1.Datasources
            cmbDSName.AddItem objDs.Alias
      Next
      Set objDs = Nothing
      Set objLayers = Nothing
End Sub


Private Sub txtDtName_LostFocus()
      txtDtName.Text = Trim$(txtDtName.Text)
End Sub