DOC

CreateObject(mapinfoapplication)

By Bill Martinez,2014-12-19 03:48
8 views 0
CreateObject(mapinfoapplication)

Modumain

    Public mapapp As Object

    Public msgcallback As Object

Sub main()

     Set mapapp = CreateObject("mapinfo.application")

     Set msgcallback = New msgcallback

     mapapp.SetCallback msgcallback

     frmmain.Show

    End Sub

Sub unmain()

    On Error GoTo ErrorHandler

     mapapp.SetCallback Nothing

     Set msgcallback = Nothing

     mapapp.RunMenuCommand M_FILE_EXIT

     Set mapapp = Nothing

     End

    Exit Sub

ErrorHandler:

     MsgBox "退出错误"

End Sub

Public Sub browseselection()

     On Error GoTo ErrorHandler

     mapapp.Do "Set Next Document Parent " & frmbrowse.hWnd & " Style 1"

     mapapp.Do "browse * from selection"

     frmbrowse.Show

     Exit Sub

    ErrorHandler:

    End Sub

    frmselect_sql_help Private Sub Combo2_Click()

     On Error GoTo ErrorHandler

     Text1.Text = Text1.Text & Combo2.Text

     Exit Sub

ErrorHandler:

     MsgBox "错误 "

    End Sub

    Private Sub Combo3_Click()

     On Error GoTo ErrorHandler

     Text1.Text = Text1.Text & Combo3.Text

     Exit Sub

ErrorHandler:

     MsgBox "错误 "

    End Sub

    Private Sub Combo4_Click()

     On Error GoTo ErrorHandler

     Text1.Text = Text1.Text & Combo4.Text

     Exit Sub

    ErrorHandler:

     MsgBox "错误 "

    End Sub

    Private Sub Command1_Click()

     On Error GoTo ErrorHandler

     frmselect_sql.Text1.Text = frmselect_sql_help.Text1.Text

     frmselect_sql_help.Hide

     frmselect_sql.Show

     Exit Sub

    ErrorHandler:

     MsgBox "错误 "

    End Sub

    Private Sub Command2_Click()

     On Error GoTo ErrorHandler

     frmselect_sql_help.Hide

     frmselect_sql.Show

     Exit Sub

    ErrorHandler:

     MsgBox "错误 "

    End Sub

Private Sub Form_Load()

     On Error GoTo ErrorHandler

     Text1.Text = ""

     Combo3.AddItem ">", 0

     Combo3.AddItem "<", 1

     Combo3.AddItem "=", 2

     Combo3.AddItem ">=", 3

     Combo3.AddItem "<=", 4

     Combo3.AddItem "<>", 5

     Combo3.AddItem "+", 6

     Combo3.AddItem "-", 7

     Combo3.AddItem "*", 8

     Combo3.AddItem "/", 9

     Combo3.AddItem "()", 10

     Combo3.AddItem " like ", 11

     Combo3.AddItem " or ", 12

     Combo3.AddItem " not ", 13

     Combo3.AddItem " and ", 14

     Combo4.AddItem " and ", 0

     Combo4.AddItem " or ", 1

     Combo4.AddItem " not ", 2

     Exit Sub

ErrorHandler:

     MsgBox "错误 "

End Sub

    frmselect_sql

    Dim conlayout As Integer

    Dim strlay() As String

    Private Sub Combo1_Click()

     Dim strtable() As String

     Dim i As Integer

     Dim cuntt As Integer

     Dim str22 As String

     On Error GoTo ErrorHandler

     cuntt = mapapp.eval("tableinfo(""" & Combo1.Text & """," & TAB_INFO_NCOLS & ")")

     ReDim strtable(cuntt)

     frmselect_sql_help.Combo2.Clear

     For i = 1 To cuntt

     strtable(i - 1) = mapapp.eval("ColumnInfo(""" & Combo1.Text & """,col" & i

    & "," & COL_INFO_NAME & ")")

     frmselect_sql_help.Combo2.AddItem strtable(i - 1), i - 1

     Next i

     Exit Sub

    ErrorHandler:

     MsgBox "错误 "

    End Sub

Private Sub Command1_Click()

     On Error GoTo ErrorHandler

     Dim strtable() As String

     Dim i As Integer

     Dim cuntt As Integer

     Dim str22 As String

     cuntt = mapapp.eval("tableinfo(""" & Combo1.Text & """," & TAB_INFO_NCOLS & ")")

     ReDim strtable(cuntt)

     frmselect_sql_help.Combo2.Clear

     For i = 1 To cuntt

     strtable(i - 1) = mapapp.eval("ColumnInfo(""" & Combo1.Text & """,col" & i & "," &

    COL_INFO_NAME & ")")

     frmselect_sql_help.Combo2.AddItem strtable(i - 1), i - 1

     Next i

     frmselect_sql_help.Show

     Exit Sub

ErrorHandler:

     MsgBox "错误 "

    End Sub

Private Sub Command2_Click()

     Dim str1 As String

     Dim i As Integer

     On Error GoTo ErrorHandler

     str1 = Text1.Text

     mapapp.Do ("select * from " & Combo1.Text & " where " & str1)

     Exit Sub

ErrorHandler:

     MsgBox "查询错误"

    End Sub

Private Sub Command3_Click()

     On Error GoTo ErrorHandler

     Call browseselection

     Exit Sub

ErrorHandler:

     MsgBox "错误 "

    End Sub

Private Sub Form_Load()

     Dim i, j As Integer

     On Error GoTo ErrorHandler

     conlayout = mapapp.eval("mapperinfo(" & frmmain.windowmax_no & "," &

    MAPPER_INFO_LAYERS & ")") '获得图层数

     ReDim strlay(conlayout)

     For i = 1 To conlayout '将各图层名存入数组

     strlay(i - 1) = mapapp.eval("layerinfo(" & frmmain.windowmax_no & ", " & i & ", " &

    LAYER_INFO_NAME & ")") 'layer_info_name=1

     Combo1.AddItem strlay(i - 1), i - 1

     Next i

     Exit Sub

ErrorHandler:

     MsgBox "错误 "

End Sub

    Frmsearch Dim gjline(22, 43) As String Dim strxlinfo(3) As String Dim strzzzinfo(2) As String

    Private Sub Cmdsearch_Click() strxlinfo(0) = ""

    strxlinfo(1) = ""

    strxlinfo(2) = ""

    strxlinfo(3) = ""

    strzzzinfo(0) = ""

    strzzzinfo(1) = ""

    strzzzinfo(2) = ""

Dim strstartid As String

    Dim strendid As String

Dim inti As Integer

    Dim intj As Integer

    Dim intk As Integer

    Dim mycon As ADODB.Connection Dim mycmd As ADODB.Command Dim myrst As ADODB.Recordset

    Set mycon = New ADODB.Connection Set mycmd = New ADODB.Command Set myrst = New ADODB.Recordset

    On Error GoTo ErrorHandler mycon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path &

    "\DATA\db.mdb;Mode=ReadWrite|Share Deny None;Persist Security Info=False"

    mycon.Open

    myrst.ActiveConnection = mycon '设定数据集的游标类型和锁定类型;可更新类型;

     myrst.CursorLocation = adUseClient

     myrst.LockType = adLockOptimistic

     myrst.Open "SELECT * FROM 公交线路"

     myrst.MoveFirst

     For inti = 0 To 22

     For intj = 0 To 43

     If IsNull(myrst.Fields.Item(intj).Value) Then

     Else

     gjline(inti, intj) = myrst.Fields.Item(intj).Value

     End If

     Next intj

     myrst.MoveNext

     Next inti

    myrst.Close

    myrst.Open "select * from 站点 where stop=""" & Txtstart.Text & """" myrst.MoveFirst

    strstartid = myrst.Fields.Item(0).Value myrst.Close

    myrst.Open "select * from 站点 where stop=""" & Txtend.Text & """" myrst.MoveFirst

    strendid = myrst.Fields.Item(0).Value

    myrst.Close

    Call zhandianchaxun(strstartid, strendid, 0) Exit Sub

ErrorHandler:

    MsgBox "错误 "

End Sub

Public Function zhandianchaxun(strstartid As String, strendid As String, intcount As Integer) As

    Boolean

     Dim blnisok As Boolean

     On Error GoTo ErrorHandler

     intcount = intcount + 1

     For inti = 0 To 22

     For intj = 3 To 33

     If strstartid = gjline(inti, intj) Then

     strxlinfo(intcount - 1) = inti

     For intk = intj + 1 To 33

     If strendid = gjline(inti, intk) Then

     If intcount = 2 Then

     Txtrst.Text = "" & Txtstart.Text & " 乘坐 " & strxlinfo(0) & "到站点" & strzzzinfo(0) & "转乘" & strxlinfo(1) & "" & Txtend.Text

     zhandianchaxun = True

     Else

     Txtrst.Text = "" & Txtstart.Text & " 乘坐 " & strxlinfo(0) & "" & Txtend.Text

     zhandianchaxun = True

     End If

     Else

     End If

     Next intk

     For intk = intj + 1 To 33

     If intcount < 2 Then

     strzzzinfo(intcount - 1) = gjline(inti, intk)

     blnisok = zhandianchaxun(gjline(inti, intk), strendid, intcount)

     If blnisok Then ''''''''''''''''''''''''判断返回值,跳出

     Else

     intcount = intcount - 1

     End If

     Else

     End If

     Next intk

     Else

     End If

     Next intj

     Next inti

     Exit Function

ErrorHandler:

     MsgBox "错误 "

    End Function

    Frmphfx

    Dim gjline(22, 43) As String

Private Sub Command1_Click()

     Dim strphzz As String

     Dim strphdlx(1) As String

     Dim inti As Integer

     Dim intj As Integer

     Dim intk As Integer

     Dim mycon As ADODB.Connection

     Dim mycmd As ADODB.Command

     Dim myrst As ADODB.Recordset

     On Error GoTo ErrorHandler

     Set mycon = New ADODB.Connection

     Set mycmd = New ADODB.Command

     Set myrst = New ADODB.Recordset

     Txtrst.Text = ""

     mycon.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path

    & "\DATA\db.mdb;Mode=ReadWrite|Share Deny None;Persist Security Info=False"

     mycon.Open

     myrst.ActiveConnection = mycon

     '设定数据集的游标类型和锁定类型;可更新类型;

     myrst.CursorLocation = adUseClient

     myrst.LockType = adLockOptimistic

     myrst.Open "SELECT * FROM 公交线路"

     myrst.MoveFirst

     For inti = 0 To 22

     For intj = 0 To 43

     If IsNull(myrst.Fields.Item(intj).Value) Then

     Else

     gjline(inti, intj) = myrst.Fields.Item(intj).Value

     End If

     Next intj

     myrst.MoveNext

     Next inti

     myrst.Close

     myrst.Open "select * from 站点 where stop=""" & Combo1.Text & """"

     If myrst.RecordCount > 0 Then

     myrst.MoveFirst

     strphzz = myrst.Fields.Item(0).Value

     myrst.Close

     Else

     myrst.Close

     End If

     myrst.Open "select * from 道路线 where id=""" & Combo2.Text & """"

     If myrst.RecordCount > 0 Then

     myrst.MoveFirst

     strphdlx(0) = myrst.Fields.Item(1).Value

     strphdlx(1) = myrst.Fields.Item(2).Value

     myrst.Close

     Else

     myrst.Close

     End If

     For inti = 0 To 22

     For intj = 3 To 33

     If strphzz <> "" And gjline(inti, intj) = strphzz Then

     Txtrst.Text = Txtrst.Text & "公交线路" & gjline(inti, 1) & "不能使用" & vbCrLf

     Else

     End If

     Next intj

     Next inti

     For inti = 0 To 22

     For intj = 3 To 32

     If strphdlx(0) <> "" And strphdlx(0) <> "" And gjline(inti, intj) = strphdlx(0) And

    gjline(inti, intj + 1) = strphdlx(1) Then

     Txtrst.Text = Txtrst.Text & "公交线路" & gjline(inti, 1) & "不能使用" & vbCrLf

     Else

     End If

     Next intj

     Next inti

Report this document

For any questions or suggestions please email
cust-service@docsford.com