query.frm

mapgis二次开发,vb示例 mapgis二次开发,vb示例

VERSION 5.00
Begin VB.Form TQuery 
   Caption         =   "空间查询"
   ClientHeight    =   3780
   ClientLeft      =   165
   ClientTop       =   735
   ClientWidth     =   4785
   Icon            =   "Query.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   3780
   ScaleWidth      =   4785
   StartUpPosition =   3  'Windows Default
   Begin VB.Menu AttAskQuery 
      Caption         =   "属性条件检索"
      Begin VB.Menu AttAskToList 
         Caption         =   "检索到列表"
      End
      Begin VB.Menu AttAskToArea 
         Caption         =   "检索到新工作区"
      End
      Begin VB.Menu AttAskToOnCon 
         Caption         =   "由条件检索到列表"
      End
      Begin VB.Menu AttCrossAskToArea 
         Caption         =   "交叉属性条件查询"
      End
      Begin VB.Menu sp0 
         Caption         =   "-"
      End
      Begin VB.Menu SqlQuery 
         Caption         =   "SQL条件查询"
      End
   End
   Begin VB.Menu QueryMap 
      Caption         =   "查询图元"
      Begin VB.Menu LayerAskToArea 
         Caption         =   "图层查询图元"
      End
      Begin VB.Menu sp1 
         Caption         =   "-"
      End
      Begin VB.Menu RectAskToArea 
         Caption         =   "矩形查询图元到新区"
      End
      Begin VB.Menu RectAskToList 
         Caption         =   "矩形查询图元到列表"
      End
      Begin VB.Menu sp2 
         Caption         =   "-"
      End
      Begin VB.Menu RegAskQuery 
         Caption         =   "区域查询"
      End
   End
   Begin VB.Menu QueryOrDecide 
      Caption         =   "查找与判断"
      Begin VB.Menu SeekReg 
         Caption         =   "查找点所在区域"
      End
      Begin VB.Menu LinNearPnt 
         Caption         =   "查找线上最近点"
      End
      Begin VB.Menu QueryNearEntity 
         Caption         =   "查找离点最近的实体"
      End
      Begin VB.Menu sp3 
         Caption         =   "-"
      End
      Begin VB.Menu PntAndRectPos 
         Caption         =   "点与矩形的位置关系"
      End
      Begin VB.Menu LinAndRectPos 
         Caption         =   "线与矩形的位置关系"
      End
      Begin VB.Menu NetAndRectPos 
         Caption         =   "网与矩形的位置关系"
      End
      Begin VB.Menu NetAndRegPos 
         Caption         =   "网络与区的位置关系"
      End
      Begin VB.Menu RegAndRectPos 
         Caption         =   "区与矩形的位置关系"
      End
      Begin VB.Menu RegInterRegPos 
         Caption         =   "区与区域的位置关系"
      End
   End
   Begin VB.Menu ExpCalculate 
      Caption         =   "表达式计算"
      Begin VB.Menu InputExpresion 
         Caption         =   "输入条件表达式"
      End
      Begin VB.Menu ExpresionValid 
         Caption         =   "表达式合法性检查"
      End
      Begin VB.Menu ExpValue 
         Caption         =   "计算表达式"
      End
   End
End
Attribute VB_Name = "TQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'======================================================================================================
'主要功能:
'       本例主要演示了Query对象(属性检索对象)的使用方法.包括矩形检索,条件检索以及通过空间实体之间的位置关系来检索
'       等.
'
'
'======================================================================================================

Option Explicit
Dim objQuery As MAPGISBASCOM1Lib.Query
'全局变量声明
Dim bRes As Boolean
Dim lRes As Long
Dim nRes As Integer

Private Sub AttAskToArea_Click()
'不妨以线工作区为例
Dim ai As New LinArea
Dim ai1 As New LinArea

If ai.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = ai
Else: Exit Sub
End If

'属性检索(此处还可以检索其他实体，如gisPNT_ENTITY等
'检索结果放入ai1工作区(方法一)
lRes = objQuery.AttAskToArea(gisLIN_ENTITY, ai1)
ai1.SaveAs
MsgBox lRes
ai1.Clear

'检索结果放入ai1工作区 (方法二)
'注意：类型要一致，lin实体就应对应lin工作区
lRes = objQuery.AttAskToArea0(gisLIN_ENTITY, "ID>100", ai1)
ai1.SaveAs
MsgBox lRes

Set ai = Nothing
Set ai1 = Nothing
End Sub

Private Sub AttAskToList_Click()
'不妨以区工作区为例
Dim ai As New RegArea
Dim ai1 As New RegArea
Dim objIDList As IDList
Dim regnum As Long

If ai.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = ai
Else: Exit Sub
End If

'检索结果放入列表对象(方法一)
Set objIDList = objQuery.AttAskToList(gisREG_ENTITY)
'下面取列表中的区实体号
For regnum = 0 To objIDList.count - 1
MsgBox objIDList(regnum)
Next regnum
Set objIDList = Nothing

'检索结果放入列表对象(方法二)
Set objIDList = objQuery.AttAskToList0(gisREG_ENTITY, "ID>10")
'下面取列表中的区实体号
For regnum = 0 To objIDList.count - 1
MsgBox objIDList(regnum)
Next regnum

Set ai = Nothing
Set ai1 = Nothing
Set objIDList = Nothing
End Sub

Private Sub AttAskToOnCon_Click()
'不妨以线工作区为例
Dim ai As New LinArea
Dim ai1 As New LinArea
Dim objIDList As IDList
Dim regnum As Long

If ai.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = ai
Else: Exit Sub
End If

'根据外挂数据库号查找属性
Set objIDList = objQuery.AttAskToListOnDbNo(gisLIN_ENTITY, "ID", 1)
For regnum = 0 To objIDList.count - 1
MsgBox objIDList(regnum)
Next regnum
Set objIDList = Nothing

'//根据外挂数据库及条件表达式查找对应属性
'//1.若exp==NULL，则要求用户重新输入表达式
'//2.若exp!=NULL,但表达式非法，则返回NULL
Set objIDList = objQuery.AttAskToListOnDbExp(gisLIN_ENTITY, "ID", 1, "ID<30")
For regnum = 0 To objIDList.count - 1
MsgBox objIDList(regnum)
Next regnum
Set objIDList = Nothing

Set ai = Nothing
Set ai1 = Nothing
Set objIDList = Nothing
End Sub

Private Sub AttCrossAskToArea_Click()
'不妨以线工作区为例
Dim ai As New LinArea
Dim ai1 As New LinArea
Dim ai2 As New LinArea
Dim objIDList As IDList

If ai.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = ai
Else: Exit Sub
End If

If Not ai1.Load Then
Exit Sub
End If

'交叉属性条件查询,此处以ID为连接字段,查询结果保存到ai2工作区
lRes = objQuery.AttCrossAskToArea("ID<200", "ID", ai1, ai2)
ai2.SaveAs

'交叉属性条件查询,此处以ID为连接字段,查询结果保存到IDList列表对象中
Set objIDList = objQuery.AttCrossAskToList("ID>100", "ID", ai1)
'......objIDlist的操作

Set ai = Nothing
Set ai1 = Nothing
Set ai2 = Nothing
Set objIDList = Nothing
End Sub

Private Sub ExpresionValid_Click()
Dim RegAi As RegArea
Dim MyExpObj As ExpObj
Dim expStr As String

Set RegAi = New RegArea
If RegAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi
Else
Set RegAi = Nothing
Exit Sub
End If

'输入表达式
nRes = objQuery.InputExpresion(RegAi.RegAtt.stru, "输入表达式", expStr)
If nRes Then
'表达式合法性检查
'方法一
'依据属性结构，解释表达式字符串，如果正确就创建一个表达式对象，并返回
Set MyExpObj = objQuery.ExpStrValid(RegAi.RegAtt, expStr)
End If

'方法二
'返回成功1或失败0。注意当使用InputExpresion方法时无须使用ExpresionValid
'方法来检验合法性，因为InputExpresion方法内部已经调用了此方法
nRes = objQuery.ExpresionValid(RegAi.RegAtt.stru, expStr)
If nRes Then
    MsgBox "输入的表达式合法！"
Else
    MsgBox "输入的表达式不合法！"
End If

Set RegAi = Nothing
Set MyExpObj = Nothing
End Sub

Private Sub ExpValue_Click()
Dim RegAi As RegArea
Dim MyExpObj As ExpObj
Dim expStr As String
Dim rtl As Double
Dim ATT As Record
Dim domainErrNo As Integer

Set RegAi = New RegArea
If RegAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi
Else
Set RegAi = Nothing
Exit Sub
End If

'输入表达式
nRes = objQuery.InputExpresion(RegAi.RegAtt.stru, "输入表达式", expStr)
'表达式合法性检查
If nRes Then
'方法一
'依据属性结构，解释表达式字符串，如果正确就创建一个表达式对象，并返回
Set MyExpObj = objQuery.ExpStrValid(RegAi.RegAtt, expStr)
End If

If MyExpObj Is Nothing Then
   MsgBox "表达式为空"
   Exit Sub
End If
'计算表达式的值
'如果创建对象的表达式属于算术表达式，则返回计算结果，若为逻辑表达式，则
'返回1或0，以表示真和假
'首先要得到属性记录(这里假定是第一条记录)

If RegAi.RegAtt.Get(1, ATT) Then
rtl = objQuery.ExpValue(MyExpObj, ATT, domainErrNo)
End If
MsgBox "所求值为：" & rtl


Set ATT = Nothing
Set MyExpObj = Nothing
'方法二
'输入条件表达式 , 返回表达式对象
'Set MyExpObj = objQuery.InputExpOBJ(RegAi.RegAtt.stru, "条件检索")
'If MyExpObj is Nothing Then
   'MsgBox "表达式为空"
   'Exit Sub
'End If
'If RegAi.RegAtt.Get(1, ATT) Then
'rtl = objQuery.ExpValue(MyExpObj, ATT, domainErrNo)
'End If
'MsgBox "所求值为：" & rtl

Set ATT = Nothing
Set RegAi = Nothing
Set MyExpObj = Nothing
End Sub

Private Sub Form_Load()
Set objQuery = New MAPGISBASCOM1Lib.Query
End Sub

Private Sub Form_Unload(Cancel As Integer)
Set objQuery = Nothing
End Sub

Private Sub InputExpresion_Click()
Dim RegAi As RegArea
Dim MyExpObj As ExpObj
Dim expStr As String

Set RegAi = New RegArea
If RegAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = RegAi
Else
Set RegAi = Nothing
Exit Sub
End If

'(方法一）
'注意：该函数创建对话框，并调用ExpressionValid检查表达式合法性
'若成功，则将表达式字符串存在expStr参数中,如果非法，则要求用户重新输入表达式
nRes = objQuery.InputExpresion(RegAi.RegAtt.stru, "输入表达式", expStr)
If nRes Then
    MsgBox "输入的表达式合法！"
Else
    MsgBox "输入的表达式不合法！"
End If

'(方法二)
'输入条件表达式 , 返回表达式对象
Set MyExpObj = objQuery.InputExpOBJ(RegAi.RegAtt.stru, "条件检索")
'注意: 该函数返回的是一个对象,一般与ExpValue方法连用......

Set RegAi = Nothing
Set MyExpObj = Nothing
End Sub

Private Sub LayerAskToArea_Click()
Dim lay As Integer
Dim LinAi As New LinArea
Dim ai1 As New LinArea
Dim objIDList As IDList

If LinAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = LinAi
Else: Exit Sub
End If

'图层查询图元，返回图元素
'如下：把第0层的线实体保存到ai1工作区
lRes = objQuery.LayerAskToArea(gisLIN_ENTITY, 0, ai1)

'如下：把第0层的线实体保存到objIDList列表对象中
Set objIDList = objQuery.LayerAskToList(gisLIN_ENTITY, 0)
'......对objIDList的操作

Set ai1 = Nothing
Set LinAi = Nothing
Set objIDList = Nothing
End Sub

Private Sub LinAndRectPos_Click()
Dim xy As D_DotSet
Dim rc As D_Rect
Dim lrc As D_Rect
Dim LinAi As LinArea
Dim count As Long
Dim dimen As Integer
Dim inf As Lin_Info

Set LinAi = New LinArea
If LinAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = LinAi
Else
    Set LinAi = Nothing
    Exit Sub
End If

Set rc = New D_Rect
rc.xmin = 10
rc.xmax = 300
rc.ymin = 10
rc.ymax = 300

'判断线是否与矩形范围相交
'若线与矩形框相交或被矩形框包含则返回1，否则返回0
'找出当前工作区中与矩形相交的所有线
For count = 1 To LinAi.count - 1
nRes = objQuery.LinCrossRect(count, rc)
MsgBox "线" & count & "与矩形相交！"
Next count

For count = 1 To LinAi.count - 1
'先取线
If LinAi.Get(count, xy, inf, dimen) Then
    nRes = objQuery.LinInterRect(xy, rc)
End If
If nRes Then
    MsgBox "线" & count & "与矩形相交！"
End If
Next count

'如果把线的范围考虑在内，则可如下：
'Set lrc = LinAi.rect
'nRes = objQuery.LinInterRect(xy, rc,lrc)

Set xy = Nothing
Set rc = Nothing
Set inf = Nothing
'Set lrc = Nothing
Set LinAi = Nothing
End Sub

Private Sub LinNearPnt_Click()
'不妨以线工作区为例
Dim LinAi As New LinArea
Dim dot As D_Dot
Dim xy As D_DotSet
Dim LinInfo As Lin_Info
Dim dimem As Integer

If LinAi.Load Then
'使用Query对象之前一定要先设置源工作区属性
objQuery.sourceArea = LinAi
Else: Exit Sub
End If

Set dot = New D_Dot
dot.x = 110
dot.y = 110


nRes = LinAi.Get(1, xy, LinInfo, dimem)
If nRes Then
'查找线xy上离dot最近的点，成功返回点序号(>=0)
lRes = objQuery.SelDotOfLin(xy, dot)
End If

Set xy = Nothing
Set dot = Nothing
Set LinAi = Nothing
Set LinInfo = Nothing

End Sub

Private Sub NetAndRectPos_Click()
Dim ndat As LONGList
Dim frc As D_Rect
Dim nrc As D_Rect
Dim NetAi As New NetArea
Dim NetInfo As Net_Info

If NetAi.Load Then