mdiform.frm

一个vb+oracle的例子

    'Open the data file
    Open App.Path & "\us_cust.txt" For Input Access Read As #1
    
    'Loop through the file
    Do While Not EOF(1)
        'Read the current line of tab-delimited dat
        Line Input #1, lineData
        'Add it to the string and add a carriage return line feed
        'vbCrLf = Chr(13) & Chr(10)
        fileData = fileData & lineData & vbCrLf
    Loop
    
    'Allocate the memory for our data (length + 1 for NULL char)
    MemoryBlockId = GlobalAlloc(GMEM_MOVEABLE, Len(fileData) + 1)
    'Lock the memory
    MemoryBlockAddress = GlobalLock(MemoryBlockId)
    
    'Copy the string into memory
    lstrcpy MemoryBlockAddress, fileData
    'Unlock the memory
    GlobalUnlock MemoryBlockId

    'Build a fields collection to use with the tab-delimited data
    'This is the only way to give the data field-names
    flds.Add 1, "LNAME", , miTypeString
    flds.Add 2, "FNAME", , miTypeString
    flds.Add 3, "TERR", , miTypeString
    flds.Add 4, "COMPANY", , miTypeString
    flds.Add 5, "CITY", , miTypeString
    flds.Add 6, "STATE", , miTypeString
    flds.Add 7, "ZIP", , miTypeString
    flds.Add 8, "ORDER_AMT", , miTypeNumeric
    flds.Add 9, "X", , miTypeNumeric
    flds.Add 10, "Y", , miTypeNumeric
    flds.Add 11, "ID", , miTypeNumeric
         
    bindlayer.LayerName = "us_cust5"
    bindlayer.LayerType = miBindLayerTypeXY
    bindlayer.RefColumn1 = "x"
    bindlayer.RefColumn2 = "y"
    
       'Add the data set using the fields collection
    Formmain.Map1.Datasets.Add miDataSetGlobalHandle, MemoryBlockId, "US_cust5", "company", , bindlayer, flds

    'Close the input file
    Close 1
    
    ChangeCombo
    Set flds = Nothing
    Set bindlayer = Nothing

End Sub

Private Sub infotip_Click()
Dim ds As New MapXLib.Dataset
Formmain.Map1.InfotipSupport = False
Set ds = Formmain.Map1.Datasets.Item(1)
Set Formmain.Map1.Layers.Item(1).LabelProperties.Dataset = ds
Set Formmain.Map1.Layers.Item(1).LabelProperties.DataField = ds.Fields.Item(2)
Formmain.Map1.InfotipSupport = True
End Sub

Private Sub IrregularSelect_Click()
Formmain.Map1.CurrentTool = miPolygonSelectTool
End Sub

Private Sub LabelAtpoint_Click()
    Dim ftrs As New MapXLib.Features
    Dim X As Double
    Dim Y As Double
    Dim i As Integer
    
       
    Set ftrs = Formmain.Map1.Layers.Item(1).AllFeatures
    MsgBox Str(ftrs.Count)
    
    For i = 1 To ftrs.Count
      
      X = ftrs.Item(i).CenterX
      Y = ftrs.Item(i).CenterY
      MsgBox Str(X) + "," + Str(Y)
      Formmain.Map1.Layers.Item(1).LabelAtPoint X, Y
   
    Next
    
End Sub

Private Sub LayerType_Click()
    FrmAddDsLayer.Show 1
    ChangeCombo
End Sub

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

Private Sub LinkODBC_Click()
    
    Dim LayerInfo As New MapXLib.LayerInfo
    Dim lyrinfo As New MapXLib.LayerInfo
    Dim lyr As MapXLib.layer
    Dim ds As MapXLib.Dataset
    
    IsOracle = False
    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
       LayerInfo.AddParameter "cache", ODBCLayer.Text4
       LayerInfo.AddParameter "MBRSearch", ODBCLayer.Text6
       LayerInfo.AddParameter "toolkit", "ODBC"   'ODBCLayer.Text5
        
       If Option_AddToDataset = True Then
          LayerInfo.AddParameter "AutoCreateDataset", 1
          LayerInfo.AddParameter "datasetname", ODBCLayer.Text1
       End If
 
       Set lyr = Formmain.Map1.Layers.Add(LayerInfo, 1)
       
      
       Unload ODBCLayer
    
       ChangeCombo
    
    End If

End Sub

Private Sub LinkOracle_Click()
    Dim LayerInfo As New MapXLib.LayerInfo
    Dim lyr As MapXLib.layer
    Dim ds As MapXLib.Dataset
    
    IsOracle = True
    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
       LayerInfo.AddParameter "cache", ODBCLayer.Text4
       LayerInfo.AddParameter "MBRSearch", ODBCLayer.Text6
       LayerInfo.AddParameter "toolkit", "ORAINET"   'ODBCLayer.Text5
        
    'Problem -- Why can't I link Spatialware data
       If Option_AddToDataset = True Then
          LayerInfo.AddParameter "AutoCreateDataset", 1
          LayerInfo.AddParameter "datasetname", ODBCLayer.Text1
       End If
 
       Set lyr = Formmain.Map1.Layers.Add(LayerInfo, 1)
       Unload ODBCLayer
    
       ChangeCombo
       
    End If
    
End Sub

Private Sub MapOpt_Click()
    MapOptions.Show 1
End Sub

Private Sub MDIForm_Load()
    
    Me.Top = 0
    Me.Left = 0
    Me.Width = Screen.Width
    Me.Height = Screen.Height
    Me.WindowState = 2
    
    ToolBars.Show
'    Formmain.Show
FormIndex = 1
End Sub

Private Sub ModifyAnnotation_Click()
     If Formmain.Map1.Annotations.ActiveAnnotation.Type = miSymbolAnnotation Then
        FrmAnnoSymbol.Show
     ElseIf Formmain.Map1.Annotations.ActiveAnnotation.Type = miTextAnnotation Then
        FrmAnnoText.Show
     End If
End Sub

Private Sub ModifyLegend_Click()
    Dim ds As MapXLib.Dataset
    
    If Trim(ToolBars.Combo2.Text) <> "" Then
       Set ds = Formmain.Map1.Datasets.Item(ToolBars.Combo2.Text)
       ds.Themes.Item(1).Legend.LegendDlg
    Else
       MsgBox "请先选择数据集.", , "错误提示"
    End If

End Sub

Private Sub ModifyTheme_Click()
    Dim ds As MapXLib.Dataset
    
    If Trim(ToolBars.Combo2.Text) <> "" Then
       Set ds = Formmain.Map1.Datasets.Item(ToolBars.Combo2.Text)
       ds.Themes.Item(1).ThemeDlg
    Else
       MsgBox "请先选择数据集.", , "错误提示"
    End If
    
End Sub

Private Sub MoveFeature_Click()
 'MoveFtr.Show 1
 Dim ftr As New MapXLib.Feature
 
 Formmain.Map1.AutoRedraw = False
 For Each ftr In Formmain.Map1.Layers.Item(ToolBars.Combo1.Text).AllFeatures
   Formmain.Map1.Layers.Item(ToolBars.Combo1.Text).Selection.Add ftr
 Next
 Formmain.Map1.AutoRedraw = True
 Formmain.Map1.Refresh
 
 Formmain.Map1.CurrentTool = MoveFeatures
End Sub

Private Sub NewTable_Click()
  '注意：新建的图层若投影为“非地球坐标系”，仍存在坐标系范围问题。
  '要求在新建图层前要先设numericcoordsys的坐标范围。这样才不会出现问题。
      
   FormNewTable.Show 1
   
End Sub

Private Sub Nonearth_Click()

Dim csys As New MapXLib.CoordSys

Formmain.Map1.NumericCoordSys.PickCoordSys
Set csys = Formmain.Map1.NumericCoordSys
'Formmain.Map1.NumericCoordSys.Bounds = Formmain.Map1.Layers.Bounds
csys.Set 0, , 5, , , , , , , , , , Formmain.Map1.Layers.Bounds
Set Formmain.Map1.NumericCoordSys = csys

End Sub

Private Sub Normalbinding_Click()

    '创建新层newlayer，与MApstats.mdb的soil表进行绑定
    '要求：新层中画三个图元，值分别为a1,a2,a3
    
    Dim OdbcQueryInfo As New OdbcQueryInfo
    Dim lyr As New MapXLib.layer
    Dim ds As New MapXLib.Dataset
    
    OdbcQueryInfo.connectstring = "odbc;"
    OdbcQueryInfo.DataSource = "mapstats"
    OdbcQueryInfo.SqlQuery = "select * from soil"

    Set lyr = Formmain.Map1.Layers("newlayer")
    Set ds = Formmain.Map1.Datasets.Add(miDataSetODBC, OdbcQueryInfo, "soil", "name", , lyr)
    ds.Themes.Add 5
    
End Sub

Private Sub NumPRJ_Click()
Formmain.Map1.NumericCoordSys.PickCoordSys
End Sub

Private Sub ODBCType_Click()
    Dim bindlayer As New bindlayer
    Dim OdbcQueryInfo As New OdbcQueryInfo
    
    OdbcQueryInfo.connectstring = "odbc;"
    OdbcQueryInfo.DataSource = "mapstats"
    OdbcQueryInfo.SqlQuery = "select * from us_cust"

    
    bindlayer.LayerName = "us_cust4"
   ' bindlayer.CoordSys.PickCoordSys
    'bindlayer.FileSpec = "C:\TEMP\US_CUST4.TAB"
    bindlayer.LayerType = miBindLayerTypeXY
    bindlayer.RefColumn1 = "x"
    bindlayer.RefColumn2 = "y"
    
    Formmain.Map1.Datasets.Add miDataSetODBC, OdbcQueryInfo, "us_cust4", "company", , bindlayer
    
    ChangeCombo
    Set bindlayer = Nothing
    Set OdbcQueryInfo = Nothing

End Sub

Private Sub OpenBroswer_Click()
    FrmBrowser.Show
End Sub

Private Sub OpenGeoset_Click()
    Dim filepath As String
    Dim filename As String
    
   
    On Error Resume Next
    CM1.DialogTitle = "打开文件"
    CM1.DefaultExt = "gst"
    CM1.Filter = "GeoSet(*.gst)|*.gst"
    CM1.CancelError = True
    CM1.Action = 1
  
  If Err.Number = 32755 Then Exit Sub
    
  Formmain.Map1.Geoset = CM1.filename
  Dim csys As New MapXLib.CoordSys
  csys.Set 0, , 5, , , , , , , , , , Formmain.Map1.Layers.Bounds
  Set Formmain.Map1.NumericCoordSys = csys
  ChangeCombo
  
  Dim i As Integer
  For i = 1 To Formmain.Map1.Layers.Count
    MsgBox Formmain.Map1.Layers.Item(i).name
  Next i
  
   
End Sub

Private Sub OpenTable_Click()

'LayerInfo 的Type 属性
'0 - .tab
'1 - User Draw
'2 - self-registering Raster
'3 - Shape
'4 - Server (remote database)
'5 - Geodictionary username
  
' Type 0:
'"FileSpec", Yes, String
'"Name", No, String
'ex: AddParameter("FileSpec", "c:\data\states.tab")
'AddParameter("Name", "MyStatesLayer")
'
'Type 1:
'"Name", Yes, String
'ex: AddParameter("Name", "MyUserDraw")
'
'Type 2:
'"FileSpec", Yes, String
'"Name", No, String
'ex: AddParameter("FileSpec", "c:\raster\rainfall.tif")
'
'Type 3:
'"FileSpec", Yes, String
'"Name", No, String
'"CoordSys", Yes, Object (mapxlib.coordsys; mapx.coordsys.4)
'"Style", No, Object (mapxlib.style; mapx.style.4)
'
'Type 4:
'"Name", Yes, String
'"ConnectString", Yes, String
'"Query", Yes, String
'LayerOptions , No, Numeric
'(Probably in the next Beta refresh, "ToolKit", Yes, String will be recognized to differentiate between ODBC and ORAINET i.e. OCI for Oracle 8i connectivity)
'ex: AddParameter("Name", "RDBMSStates")
'AddParameter("ConnectString", "DSN=MyODBCDataSource")
'AddParameter("Query", "SELECT * FROM STATES")
'AddParameter("ToolKit", "ODBC")
'
'Type 5:
'"Name", Yes, String
'ex: AddParameter("Name", "US Places")

  Dim filename As String
  Dim filepath As String
  Dim LayerName As String
  Dim lyr As MapXLib.layer
  Dim LayerInfo As New MapXLib.LayerInfo
  Dim FilterIndex As Integer
  Dim ftrs As New MapXLib.Features
  Dim csys As New MapXLib.CoordSys
  
  On Error Resume Next
  
  CM1.DialogTitle = "打开文件"
  CM1.DefaultExt = "Tab|*.tab"
  CM1.Filter = "表(*.tab)|*.tab|GeoTiff file(*.tif)|*.tif|shapefile(*.tab)|*.tab|ServerLayer(spatialware)"
  CM1.CancelError = True
  CM1.Action = 1
  
  If Err.Number = 32755 Then Exit Sub
    
  filename = CM1.FileTitle
  filepath = CM1.filename
  filepath = Left(filepath, InStr(filepath, filename) - 1)
  LayerName = Left(filename, InStr(filename, ".") - 1)