www.pudn.com > mapxoracle.zip > Formmain.frm
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)
Unload ODBCLayer
End Sub
Private Sub Form_Resize()
Map1.Width = Me.ScaleWidth
Map1.Height = Me.ScaleHeight
End Sub
Private Sub Map1_DataMismatch(ByVal DataSetName As String, ByVal Row As Long, GeoFieldValue As String)
'MsgBox DataSetName + "," + Str(Row) + "," + GeoFieldValue
End Sub
Private Sub Map1_DragDrop(Source As Control, X As Single, Y As Single)
MsgBox "dragdrop"
End Sub
Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MX As Double, MY As Double
Formmain.Map1.ConvertCoord X, Y, MX, MY, 1
MDIForm1.StatusBar1.Panels.Item(1).Text = Format(Str(MX), "#,##0.000000") + " , " + Format(Str(MY), "#,##0.000000")
End Sub
Private Sub Map1_PolyToolUsed(ByVal ToolNum As Integer, ByVal Flags As Long, ByVal Points As Object, ByVal bShift As Boolean, ByVal bCtrl As Boolean, EnableDefault As Boolean)
Dim FtrFac As New MapXLib.FeatureFactory
Dim ftr As New MapXLib.Feature
Dim lyr As MapXLib.layer
Dim i As Integer
Set lyr = Map1.Layers(ToolBars.Combo1.Text)
Set FtrFac = Map1.FeatureFactory
ftr.Attach Map1
Select Case Flags
Case miPolyToolBegin
Case miPolyToolInProgress
Case miPolyToolEnd
Select Case ToolNum
Case CreatePolyLineTool
Set ftr = FtrFac.CreateLine(Points, Map1.DefaultStyle)
Case CreatePolygonTool
Set ftr = FtrFac.CreateRegion(Points, Map1.DefaultStyle)
End Select
lyr.AddFeature ftr
Set ftr = Nothing
Case miPolyToolEndEscaped
End Select
End Sub
Private Sub Map1_RequestData(ByVal DataSetName As String, ByVal Row As Long, ByVal Field As Integer, Value As Variant, Done As Boolean)
'***********************************************************
'This is where the unbound data add actaully goes out and gets the data from the array
'***********************************************************
'Make sure we have the correct dataset and that we are not trying to get too many records
If DataSetName <> "Zip Data" Or Row > (UBound(zipdata)) Then
Done = True
Else
Value = zipdata(Row, Field)
End If
End Sub
Private Sub Map1_ResolveDataBind(ByVal Flag As Integer, ByVal NumMatches As Integer, ByVal Matches As Variant, Choice As Integer, Cancel As Boolean)
MsgBox "flag" + Str(Flag)
MsgBox "nummatch" + Str(NumMatches)
For i = 1 To 2
MsgBox Matches(i)
Next
MsgBox Str(Choice)
End Sub
Private Sub odbc_Click()
End Sub
Private Sub NewTable_Click()
FormNewTable.Show 1
MsgBox Str(Map1.Datasets.Count)
End Sub
Private Sub OpenGeoset_Click()
Dim filepath As String
Dim filename As String
On Error Resume Next
CM1.DialogTitle = "打开文件"
CM1.DefaultExt = "GeoSet|*.gst"
CM1.Filter = "GeoSet(*.gst)|*.gst"
CM1.CancelError = True
CM1.Action = 1
If Err.Number = 32755 Then Exit Sub
Map1.Geoset = CM1.filename
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 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)
FilterIndex = CM1.FilterIndex
Select Case FilterIndex
Case 1: '*.tab
LayerInfo.Type = miLayerInfoTypeTab
LayerInfo.AddParameter "FileSpec", filepath + filename
LayerInfo.AddParameter "Name", LayerName
Case 2: 'You must use Geotiff file.
'GeoTiff and Tiff:GeoTiff is a raster TIFF file that has stored the geographical coordinates
'of where it belongs on the earth. A TIFF is a regular raster file that need to
'be registered in Mi Pro.
LayerInfo.Type = miLayerInfoTypeRaster
LayerInfo.AddParameter "FileSpec", filepath + filename
LayerInfo.AddParameter "Name", LayerName
Case 3: '*.shp --- Failed
csys.Set 3, 62, 7, -96, 23, 20, 60, , , 0, 0
LayerInfo.Type = miLayerInfoTypeShape
LayerInfo.AddParameter "FileSpec", filepath + filename
LayerInfo.AddParameter "CoordSys", csys
End Select
'将新建图层加入到数据集
If Option_AddToDataset = True Then
LayerInfo.AddParameter "AutoCreateDataset", 1
LayerInfo.AddParameter "datasetname", LayerName
End If
Map1.Layers.Add LayerInfo
'Map1.Layers.Add filepath + filename
MsgBox Str(Map1.Datasets.Count)
'将新建图层加入到数据字典
If Option_AddToGeoDict = True Then
LayerInfo.Type = miLayerInfoTypeGeodictUserName
LayerInfo.AddParameter "Name", LayerName
Map1.Layers.Add LayerInfo
End If
End Sub
Private Sub Option_Click()
FormOptionLayer.Show 1
End Sub
Private Sub project_Click()
Map1.DisplayCoordSys.PickCoordSys
End Sub
Private Sub regionstyle_Click()
Map1.DefaultStyle.PickRegion
End Sub
Private Sub removelabel_Click()
Dim lyr As MapXLib.layer
'Clear the label
For Each lyr In Map1.Layers
lyr.AutoLabel = False
Next
End Sub
Private Sub SaveTable_Click()
Dim filepath As String
Dim filename As String
On Error Resume Next
CM1.DialogTitle = "保存表文件"
CM1.DefaultExt = "表文件|*.tab"
CM1.Filter = "表文件(*.tab)|*.tab"
CM1.CancelError = True
CM1.Action = 2
If Err.Number = 32755 Then Exit Sub
Map1.Geoset = CM1.filename
End Sub
Private Sub ssa_Click()
Dim lyr As layer
Dim ds As MapXLib.Dataset
Dim ftr As New MapXLib.Feature
Dim bindlayer As New MapXLib.bindlayer
Map1.Layers.AddServerLayer "ssa", "DSN=Spatial;HOST=spw;UUID=mapzk;UPWD=mapzk;UID=mapzk;PWD=mapzk;OSID=map", "select * from ""World"""
Set lyr = Map1.Layers("ssa")
'lyr.Selection.SelectAll 0
'lyr.KeyField = "country"
' For Each ftr In lyr.Selection
' MsgBox ftr.KeyValue
' Next
bindlayer.LayerType = miBindLayerTypePointRef
bindlayer.RefColumn1 = country
bindlayer.RefColumn2 = continent
bindlayer.ReferenceLayer = "world"
bindlayer.LayerName = "ssa"
'Add the Sever layer to dataset -- failed.
Set ds = Map1.Datasets.Add(miDataSetLayer, lyr, "ssa", "country") ', , bindlayer)
MsgBox Str(ds.RowCount)
End Sub
Private Sub stylesample_Click()
Dim rect As New MapXLib.Rectangle
' picturebox's ScaleMode must be 'Pixel' for this code to work
rect.Set 0, 0, PictureBox.ScaleWidth, PictureBox.ScaleHeight
' To draw a line sample:
Map1.DefaultStyle.DrawLineSample PictureBox.hDC, rect
' To draw a region sample:
Map1.DefaultStyle.DrawRegionSample PictureBox.hDC, rect
' To draw a symbol sample:
Map1.DefaultStyle.DrawSymbolSample PictureBox.hDC, rect
' To draw a text sample:
Map1.DefaultStyle.DrawTextSample PictureBox.hDC, rect, "The Quick Brown Cow"
PictureBox.Refresh
End Sub
Private Sub symbolstyle_Click()
Map1.DefaultStyle.PickSymbol
'not Vector symbol support in MapX352
'MsgBox Map1.DefaultStyle.MinVectorSymbolCharacter 'mapinfo compatible 3.0 -- Minimum Character value
'MsgBox Map1.DefaultStyle.MaxVectorSymbolCharacter 'mapinfo compatible 3.0 -- Maximum Character value
'MsgBox Map1.DefaultStyle.SymbolCharacter
End Sub
Private Sub textstyle_Click()
Map1.DefaultStyle.PickText
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim i As Integer
Select Case Button.Index
Case 1 ' Arrow
Map1.CurrentTool = ToolConstants.miArrowTool
Case 2 ' Zoom In
Map1.CurrentTool = ToolConstants.miZoomInTool
Map1.MousePointer = miCustomCursor
'Map1.MouseIcon = "c:\windows\cursors\globe.ani"
' Map1.MouseIcon = "c:\windows\cursors\Help_1.cur"
Case 3 ' Zoom Out
Map1.CurrentTool = ToolConstants.miZoomOutTool
Case 4 ' Pan
Map1.CurrentTool = ToolConstants.miPanTool
End Select
For i = 1 To Toolbar1.Buttons.Count
Toolbar1.Buttons(i).Value = 0
Next
Button.Value = 1
End Sub
Private Sub Map1_SelectionChanged()
Dim lyr As MapXLib.layer
Dim ds As New MapXLib.Dataset
Dim ftr As New MapXLib.Feature
Dim ftrs As New MapXLib.Features
Dim TmpStr As String
Dim i As Integer
Dim findone As Boolean
'当前地图窗口与浏览窗口的互动查询
If BrowserFlag = True Then
findone = False
Set ds = Map1.Datasets(ToolBars.Combo1.Text)
Set lyr = ds.layer
For Each ftr In lyr.Selection
s = ftr.FeatureKey
For i = 1 To FrmBrowser.Grid1.Rows - 1
If Trim(FrmBrowser.Grid1.TextArray((i + 1) * FrmBrowser.Grid1.Cols - 1)) = Trim(s) Then
FrmBrowser.Grid1.TopRow = i
FrmBrowser.Grid1.Row = i
FrmBrowser.Grid1.Col = 0
FrmBrowser.Grid1.RowSel = i
FrmBrowser.Grid1.ColSel = FrmBrowser.Grid1.Cols - 1
findone = True
End If
Next i
Next
If findone = False Then
FrmBrowser.Grid1.Row = 0
FrmBrowser.Grid1.Col = 0
FrmBrowser.Grid1.RowSel = 0
FrmBrowser.Grid1.ColSel = 0
End If
End If
End Sub
Private Sub Map1_ToolUsed(ByVal ToolNum As Integer, ByVal X1 As Double, ByVal Y1 As Double, ByVal X2 As Double, ByVal Y2 As Double, ByVal Distance As Double, ByVal Shift As Boolean, ByVal Ctrl As Boolean, EnableDefault As Boolean)
Dim FtrFac As MapXLib.FeatureFactory
Dim ftr As New MapXLib.Feature
Dim Pnt As New Point
Dim pnts As New Points
Dim lyr As MapXLib.layer
'创建点对象
Pnt.Set X1, Y1
'设置编辑层
If Trim(ToolBars.Combo1.Text) <> "" Then
Set lyr = Map1.Layers(Trim(ToolBars.Combo1.Text))
Else
Exit Sub
End If
Set FtrFac = Map1.FeatureFactory
Select Case ToolNum
Case CreateSymbolTool
Set ftr = FtrFac.CreateSymbol(Pnt, Map1.DefaultStyle)
lyr.AddFeature ftr
Set lyr = Nothing
'
Case CreateTextTool
Set ftr = FtrFac.CreateText(Pnt, "text", miPositionTL, Map1.DefaultStyle)
lyr.AddFeature ftr
Set lyr = Nothing
Case CreateLineTool
pnts.Add Pnt, 1
Pnt.Set X2, Y2
pnts.Add Pnt, 2
Set ftr = FtrFac.CreateLine(pnts, Map1.DefaultStyle)
lyr.AddFeature ftr
Case CreateArcTool
Case CreateRectTool
Case CreateRectRegionTool
Case CreateCircleRegionTool
Case CreateEllipseRegionTool
Case MoveFeatures
Map1.AutoRedraw = False
xe = X2 - X1
ye = Y2 - Y1
For Each ftr In Map1.Layers(ToolBars.Combo1.Text).Selection
ftr.Offset xe, ye
ftr.Update
Next
Map1.AutoRedraw = True
Map1.Refresh
End Select
End Sub
Private Sub zoom_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Map1.zoom = zoom.Text
End If
End Sub