formmain.frm

一个vb+oracle的例子

VERSION 5.00
Object = "{9D6ED199-5910-11D2-98A6-00A0C9742CCA}#4.0#0"; "MapX40.ocx"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Formmain 
   ClientHeight    =   5880
   ClientLeft      =   165
   ClientTop       =   165
   ClientWidth     =   7290
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   5880
   ScaleWidth      =   7290
   Begin VB.TextBox zoom 
      Height          =   375
      Left            =   960
      TabIndex        =   1
      Top             =   7920
      Width           =   1215
   End
   Begin MapXLib.Map Map1 
      Height          =   5655
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   7095
      _Version        =   400011
      _ExtentX        =   12515
      _ExtentY        =   9975
      _StockProps     =   1
      GeoDictionary   =   "GeoDictionary"
      GeoSet          =   "Empty"
      GeoSetUserName  =   ""
      CurrentTool     =   1000
      Zoom            =   0
      MaxSearchTime   =   30
      CenterX         =   0
      CenteryY        =   0
      Rotation        =   0
      TitleText       =   ""
      DataSetGeoField =   ""
      DataSetTheme    =   -4040
      AutoRedraw      =   -1  'True
      PreferCompactLegends=   0   'False
      TitleVisible    =   0   'False
      MousePointer    =   0
      MouseIcon       =   ""
      MatchThreshold  =   80
      WaitCursorEnabled=   -1  'True
      MousewheelSupport=   1
      MatchNumericFields=   0   'False
      RedrawInterval  =   10
      PanAnimationLayer=   0   'False
      InfotipSupport  =   0   'False
      InfotipPopupDelay=   500
      DefaultConversionResolution=   12
      ExportSelection =   0   'False
      NumLayers       =   0
      TitleStyle.TextFontBackColor=   16777215
      TitleStyle.TextFontOpaque=   -1  'True
      TitleStyle.SymbolChar=   0
      BeginProperty TitleStyle.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   32.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty TitleStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DefaultStyle.TextFontBackColor=   16777215
      DefaultStyle.SupportsBitmapSymbols=   -1  'True
      DefaultStyle.SymbolChar=   55
      DefaultStyle.SymbolFontBackColor=   16777215
      BeginProperty DefaultStyle.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty DefaultStyle.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Wingdings"
         Size            =   14.25
         Charset         =   2
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      DefaultStyle.LineStyle=   1
      DefaultStyle.LineWidth=   1
      DefaultStyle.RegionColor=   16777215
      DefaultStyle.LinePattern=   2
      DefaultStyle.RegionBackColor=   16777215
      DefaultStyle.RegionBorderStyle=   1
      DefaultStyle.RegionBorderWidth=   1
      HasProjectionInfo=   -1  'True
      NumericCoordsys =   "Formmain.frx":0000
      DisplayCoordsys =   "Formmain.frx":0130
      NumDatasets     =   0
      TitleX          =   5000
      TitleY          =   1000
      TitleVisible    =   0   'False
      TitleEditable   =   -1  'True
      TitlePostiion   =   0
      TitleBorder     =   -1  'True
   End
   Begin MSComDlg.CommonDialog CM1 
      Left            =   5760
      Top             =   7800
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   5160
      Top             =   7800
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   5
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Formmain.frx":0260
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Formmain.frx":057C
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Formmain.frx":0898
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Formmain.frx":0BB4
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "Formmain.frx":0ED0
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Label Label3 
      Caption         =   "Label3"
      Height          =   255
      Left            =   3960
      TabIndex        =   4
      Top             =   7920
      Width           =   975
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   255
      Left            =   2640
      TabIndex        =   3
      Top             =   7920
      Width           =   1095
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Zoom "
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   120
      TabIndex        =   2
      Top             =   7920
      Width           =   600
   End
End
Attribute VB_Name = "Formmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim BROWSELAYER As String
Dim FirstX As Single
Dim FirstY As Single
Dim SecondX As Single
Dim SecondY As Single
Dim ThirdX As Single
Dim ThirdY As Single
Dim Point_Counts As Integer

Private Sub adordo_Click()
End Sub

Private Sub allothers_Click()
    Dim ds As Dataset
    Dim lyr As layer
    Dim thm As MapXLib.Theme
    Dim allothers As MapXLib.RangeCategory
    Dim styl As New MapXLib.Style
    
    Set lyr = Map1.Layers.Add("C:\Program Files\MapInfo\Professional\Data\USA\states.tab", 1)
    Set ds = Map1.Datasets.Add(miDataSetLayer, Map1.Layers("STATES"))
    ds.Themes.Add miThemeRanged, "POP_1990", "My Theme", False
    Set thm = ds.Themes("My Theme")
    
    thm.DataMin = 10000000
    thm.DataMax = 30000000
    thm.Visible = True
    
    Set styl = Map1.DefaultStyle
    styl.PickRegion
        
    Set allothers = thm.ThemeProperties.RangeCategories.AllOthersCategory
    Set allothers.Style = styl
    
End Sub

Private Sub broswer_Click()
    FrmBrowseLayer.Show 1
    
End Sub

Private Sub DAOSource_Click()
    Dim ds As MapXLib.Dataset
    Dim db As Database
    Dim rs As Recordset
    Dim lyr As MapXLib.layer
    Dim bindlayer As New MapXLib.bindlayer
    Dim i As Integer, j As Integer

   
    On Error Resume Next
   
    Set db = OpenDatabase(App.Path + "\mapstats.mdb")
    Set rs = db.OpenRecordset("usa")
      
    bindlayer.LayerName = "US"
    bindlayer.LayerType = miBindLayerTypePointRef
    bindlayer.RefColumn1 = "GEONAME"
    bindlayer.RefColumn2 = "GEOABBR"
    bindlayer.ReferenceLayer = "USA"
   
    'DAO Object
    Set ds = Map1.Datasets.Add(miDataSetDAO, rs, "US", "GEONAME", , bindlayer)
    Dim ftrs As New MapXLib.Features
    Set ftrs = ds.layer.Search("GeoAbbr=""al""")
    MsgBox ftrs.Count
   
    'DATA Control
    'Set ds = Map1.Datasets.Add(miDataSetDAO, Data1.Recordset, "US", "GEONAME", , bindlayer)
    'Set ds = Map1.Datasets.Add(12, Adodc1.Recordset, "US", "GEONAME", , bindlayer)
 
    
    'DATA Control(mapx352 can't support)
    'Set ds = Map1.Datasets.Add(miDataSetDAO, Data1.Recordset)
  
    'ADO Control --failed
    'Set ds = Map1.Datasets.Add(12, Adodc1.Recordset)
  
    'RDO Control
    'Set ds = Map1.Datasets.Add(13, MSRDC1.Resultset)
  
 
End Sub

Private Sub datasetodbc_Click()
  Dim bindlayer As New MapXLib.bindlayer
  'Dim queryinfo As New mapxlib
  
  
  
End Sub

Private Sub Entirelayer_Click()
   FrmEntireLayer.Show 1
   
End Sub

Private Sub Exit_Click()
  End
End Sub

Private Sub featurefind_Click()
   Dim lyr As MapXLib.layer
   Dim ftrs As New MapXLib.Features
   Dim ftr As New MapXLib.Feature
   Dim XYArray As Variant
   Dim XYLBound As Integer
   Dim XYUBound As Integer
   Dim PolyLBound As Integer
   Dim PolyUBound As Integer
   Dim icount As Integer
   Dim i As Integer, j As Integer
   
   Set lyr = Map1.Layers("usa")
   Set ftrs = lyr.AllFeatures
   Set ftr = ftrs.Item(1)
   XYArray = ftr.Nodes
   XYLBound = LBound(XYArray, 1)
   XYUBound = UBound(XYArray, 1)
   PolyLBound = LBound(XYArray, 2)
   PolyUBound = UBound(XYArray, 2)
   
   For i = PolyLBound To PolyUBound
     icount = XYArray(XYLBound, i) * 2
     For j = XYLBound + 1 To icount Step 2
        MsgBox Str(XYArray(j, i)) + "," + Str(XYArray(j + 1, i))
     Next j
  Next i
     
End Sub

Private Sub find_Click()
  Dim findresult As MapXLib.findresult
  Dim lyr As MapXLib.layer
  Dim ftr As New MapXLib.Feature
  
  Set lyr = Map1.Layers("usa")
  Set findresult = lyr.Find.SearchEx("al", "state") 'there should be "new Jersy" and "new york" matched.
  
  'problem: why "findresult.MultipleMatches=false"
  If findresult.MultipleMatches = True Then
     For Each ftr In findresult.Matches
        MsgBox findresult.MatchedFeature.name
     Next
  Else
     MsgBox Str(findresult.FindRC)
     If findresult.FindRC <> -3 Then MsgBox findresult.MatchedFeature.name
  End If
  
End Sub

Private Sub Form_Load()
  'pop up info tips
  
  Me.Top = MDIForm1.Top + ToolBars.Height
  Me.Left = MDIForm1.Left
  
  '初始化选项
  
  Option_AddToDataset = True
'  Option_AddToGeoDict = True
  Option_InfoTip = True
    

  '信息提示
  If Option_InfoTip = True Then
    Map1.InfotipPopupDelay = 500 'millisecond
    Map1.InfotipSupport = True
  End If
  
  Map1.CreateCustomTool CreateSymbolTool, miToolTypePoint, miSymbolCursor
  Map1.CreateCustomTool CreateTextTool, miToolTypePoint, miTextCursor
  Map1.CreateCustomTool CreateLineTool, miToolTypeLine, miCrossCursor
  Map1.CreateCustomTool CreateArcTool, miToolTypeLine, miCrossCursor
  Map1.CreateCustomTool CreatePolyLineTool, miToolTypePoly, miCrossCursor
  Map1.CreateCustomTool CreatePolygonTool, miToolTypePolygon, miCrossCursor
  Map1.CreateCustomTool CreateRectTool, miToolTypePoly, miCrossCursor
  Map1.CreateCustomTool CreateRectRegionTool, miToolTypePolygon, miCrossCursor
  Map1.CreateCustomTool CreateCircleRegionTool, miToolTypeCircle, miCrossCursor
  Map1.CreateCustomTool CreateEllipseRegionTool, miToolTypeCircle, miCrossCursor
  Map1.CreateCustomTool MoveFeatures, miToolTypeLine, miCrossCursor
  
  '设置默认工具
  Map1.CurrentTool = miSelectTool
  
  
End Sub


Private Sub grid_Click()
Map1.Layers.Add "C:\Program Files\MapInfo\Professional\Data\States_Pop_19803.tab"
End Sub

Private Sub labelobject_Click()
  
  'Problem: Vertical arranged label for horizontal line;and vice versa.
  
  Dim lyr As MapXLib.layer
    
    Set lyr = Map1.Layers.Item(1)
    
    lyr.LabelProperties.PartialSegments = True 'label the line(only use in Autolabel),can't do in MapX352
    
    lyr.LabelProperties.Position = 3
    lyr.AutoLabel = True
  
End Sub

Private Sub layercontrol_Click()
  Map1.Layers.LayersDlg
End Sub

Private Sub linestyle_Click()
   Map1.DefaultStyle.PickLine
End Sub

Private Sub LinkODBC_Click()
    
    Dim LayerInfo As New MapXLib.LayerInfo
    Dim lyr As MapXLib.layer
    Dim ds As MapXLib.Dataset
    
    ODBCLayer.Show 1
    
    If ODBCFlag = True Then
       LayerInfo.Type = miLayerInfoTypeServer
       LayerInfo.AddParameter "name", ODBCLayer.Text1
       LayerInfo.AddParameter "connectstring", ODBCLayer.Text2
       LayerInfo.AddParameter "query", ODBCLayer.Text3
       If Trim(ODBCLayer.Text4) <> "" Then LayerInfo.AddParameter "layeroptions", Int(ODBCLayer.Text4)
       LayerInfo.AddParameter "toolkit", "ORAINET"   'ODBCLayer.Text5
    End If
    
    'Problem -- Why can't I link Spatialware data
    If addtodatasetlayer = 1 Then
       LayerInfo.AddParameter "AutoCreateDataset", 1
       LayerInfo.AddParameter "datasetname", ODBCLayer.Text1
    End If
 
    Set lyr = Map1.Layers.Add(LayerInfo)
    Unload ODBCLayer

End Sub

Private Sub LinkOracle_Click()
    
    Dim LayerInfo As New MapXLib.LayerInfo
    Dim lyr As MapXLib.layer
    Dim ds As MapXLib.Dataset
    
    ODBCLayer.Show 1
    
    If ODBCFlag = True Then
       LayerInfo.Type = miLayerInfoTypeServer
       LayerInfo.AddParameter "name", ODBCLayer.Text1
       LayerInfo.AddParameter "connectstring", ODBCLayer.Text2
       LayerInfo.AddParameter "query", ODBCLayer.Text3
       If Trim(ODBCLayer.Text4) <> "" Then LayerInfo.AddParameter "layeroptions", Int(ODBCLayer.Text4)
       LayerInfo.AddParameter "toolkit", "ODBC"   'ODBCLayer.Text5
    End If
    
    'Problem -- Why can't I link Spatialware data
    If addtodatasetlayer = 1 Then
       LayerInfo.AddParameter "AutoCreateDataset", 1
       LayerInfo.AddParameter "datasetname", ODBCLayer.Text1
    End If
 
    Set lyr = Map1.Layers.Add(LayerInfo)