MapInfo Mapx 产品开发代码集锦

楼主^#

更多发布于：2004-05-31 21:09

1 ．如何在MapX下读取属性值
2 ．自定义范围专题图
3 ．在mapx中查找对象的方法
4 ．在mapx中如何紧缩表
5 ．在mapx中使用如何使用自定义栅格符号
6 ．在mapx中如何使用自定义鼠标
7 ．mapx 打印地图时的参数如何设置
8 ．mapx中创建测距工具示例
9 ．在mapx中如何实现自动滚屏？
10．在mapx中如何实现图元的拖拽？


如何在MapX下读取属性值
有三种方法：
1．由Layer对象的KeyField属性来设立要读取属性值的字段名。
接着，由Feature对象的keyValue读取此行的属性值。
2．将图层加入到Datasets, 由Dataset对象的Value（x,y）属性，通过设置行号，列号来获得属性值。
3．将图层加入到Datasets,之后由RowValues(ftr)获取整行的值。
 Dim ds As MapXLib.Dataset, lyr As MapXLib.layer
 Dim ftrs As Features
Dim ftr As Feature
Dim rv As RowValue
Dim rvs As RowValues
Dim DsName As String ‘数据集名
Dim DsRows As Long, DsCols As Long
Dim i As Long, j As Long
 Set ds = Formmain.Map1.Datasets.Item(DsName)
 Set lyr = ds.layer

 Set ftrs = lyr.AllFeatures

 DsCols = ds.Fields.Count
 DsCols = DsCols + 1
 DsRows = ftrs.Count
 Grid1.Rows = DsRows + 1
 Grid1.Cols = DsCols

 Grid1.Row = 0
 For i = 0 To DsCols - 1
 Grid1.Col = i
 Grid1.Text = ds.Fields.Item(i + 1).Name
 Next i
 Grid1.Col = DsCols - 1
 Grid1.Text = "Fkey"
 lyr.BeginAccess miAccessRead

 i = 1
 For Each ftr In ftrs
 Set rvs = ds.RowValues(ftr)
 j = 0
 For Each rv In rvs
 If Not IsNull(rv.Value) Then Grid1.TextArray(i * DsCols + j) = Trim(rv.Value)
 j = j + 1
 Next
 Grid1.TextArray(i * DsCols + j) = ftr.FeatureKey
 i = i + 1
 Next

 lyr.EndAccess miAccessEnd

 Set ftr = Nothing
 Set ftrs = Nothing
 Set ds = Nothing
 Set rv = Nothing
 Set rvs = Nothing
 Set lyr = Nothing
注意：BeginAccess，以及EndAccess可以明显的提高属性读取的速度。

自定义范围专题图
mapx 的专题图用户可以进行完全的定制，下面是自定义范围专题图的例子。
Dim ds As New MapXLib.Dataset
Dim thm As New MapXLib.Theme
Set ds = Formmain.Map1.Datasets(ToolBars.Combo2.Text)
Set thm = ds.Themes.add(0, "aa", "aa", False)
thm.Legend.Compact = False
thm.AutoRecompute = False
'thm.ComputeTheme = False
thm.DataMax = 700
thm.DataMin = 100
thm.ThemeProperties.AllowEmptyRanges = True
thm.ThemeProperties.NumRanges = 7
thm.ThemeProperties.DistMethod = miCustomRanges
thm.ThemeProperties.RangeCategories(1).Max = 150
thm.ThemeProperties.RangeCategories(1).Min = 50
thm.ThemeProperties.RangeCategories(2).Max = 250
thm.ThemeProperties.RangeCategories(2).Min = 150
thm.ThemeProperties.RangeCategories(3).Max = 350
thm.ThemeProperties.RangeCategories(3).Min = 250
thm.ThemeProperties.RangeCategories(4).Max = 450
thm.ThemeProperties.RangeCategories(4).Min = 350
thm.ThemeProperties.RangeCategories(5).Max = 550
thm.ThemeProperties.RangeCategories(5).Min = 450
thm.ThemeProperties.RangeCategories(6).Max = 650
thm.ThemeProperties.RangeCategories(6).Min = 550
thm.ThemeProperties.RangeCategories(7).Max = 750
thm.ThemeProperties.RangeCategories(7).Min = 650
'thm.ComputeTheme = True
thm.AutoRecompute = True
thm.Visible = True

在mapx中查找对象的方法
两种方式：
1．使用Find对象的Search方法。在mapx3.5中只能作到完全匹配查找，在MapX4.0中SearchEx方法则可以找到多个匹配的记录，其结果由 FindResult.Matches获取。详细请参看有关Find.SearchEx 方法的文档以及示例。
2．使用Layer 对象的OBJECT.Search (strWhere)方法。其参数为SQL查询的WHERE子句。例如：
 Set ftrs = lyr.Search("Character_Name = ""北京市""") ；
 Set ftrs = lyrUSA.Search("TOTPOP > 1000000")
 注意：1。字符串外加两个双引号。2。首先将图层加入数据集Datasets 才能使用查询。
模糊查询最方便的方法是使用第二种方法例如
 Set ftrs = lyr.Search("Character_Name like ""%市""") ；模糊查询
在mapx中如何紧缩表
在Mapx4.51下可以使用LayerInfo 的创建带结构的临时表和新表的功能来完成紧缩：
Set lyr = Formmain.Map1.Layers(ToolBars.combo1.Text)
Set ds = Formmain.Map1.Datasets.add(6, lyr)
'获取被紧缩表的路径及表名
filespec = Formmain.Map1.Layers.Item(ToolBars.combo1.Text).filespec
layername = lyr.Name '将表临时存放于内存 
LayerInfo.Type = 6 'miLayerInfoTypeTemp
LayerInfo.AddParameter "TableStorageType", "MemTable" '临时文件保存在磁盘上还是内存。
LayerInfo.AddParameter "Name", "lyrpack"
LayerInfo.AddParameter "Fields", ds.Fields
LayerInfo.AddParameter "Features", lyr.AllFeatures
Formmain.Map1.Layers.add LayerInfo, LayerPos
Set LayerInfo = Nothing
'从地图窗口删除原表
Formmain.Map1.Datasets.Remove (ds.Name)
Formmain.Map1.Layers.Remove (lyr.Name)
Formmain.Map1.Refresh
Set lyr = Nothing
Set ds = Nothing
Set lyr = Formmain.Map1.Layers("lyrpack")
Set ds = Formmain.Map1.Datasets.add(6, lyr)
'从磁盘删除原表
Kill filespec

在mapx中使用如何使用自定义栅格符号
使用自定义符号首先需要设定style.SymbolType 为miSymbolTypeBitmap，然后指定SymbolBitmapName 为栅格图像名即可。
下面的代码演示了如何在delphi中使用自定义的栅格符号

首先调用自定义工具画点
procedure TForm1.new1Click(Sender: TObject);
begin
map1.ControlInterface.CurrentTool :=111;
end;
在tooluses事件中如下：
procedure TForm1.Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1,
 X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
 var EnableDefault: WordBool);
var
ssymbol :cmapxstyle;
p: CMapXPoint;
f: cmapxfeature;
begin
ssymbol:=costyle.create;
ssymbol.SymbolType :=1;
ssymbol.SymbolBitmapSize:=25;
{请注意将test.bmp文件考到mapx “共有文件路径”+“\CUSTSYMB”路径下,例如C:\Program Files\Common Files\MapInfo Shared\MapX Common 是 MapX 共有文件的缺省安装路径}
ssymbol.SymbolBitmapName:='test.BMP';
p := CoPoint.Create;
f :=cofeature.Create ;
p.Set_(x1,y1);
if toolnum=111 then begin
 f:=map1.ControlInterface.FeatureFactory.CreateSymbol(p,ssymbol);
 map1.ControlInterface.Layers.Item(1).AddFeature(f,EmptyParam);
end;
end;

在mapx中如何使用自定义鼠标

在mapx4.0，及以上版本中允许用户自定义鼠标。程序如下：
Map1.MousePointer = miCustomCursor
Map1.MouseIcon = "c:\windows\cursors\globe.ani" 
mapx 中还对鼠标滚动轮提供支持，属性如下
Map.MouseWheelSupport=miMousewheelNoAutoScroll

mapx 打印地图时的参数如何设置
在mapx 的 printmap方法：PrintMap (hDC x, y, w, h)之中，w,h,x,y的单位为himetric，1 himetric=0.01毫米。所以，打印地图时需要将w，h 乘100换算为毫米。
在vb 中例子：
 
Private Sub Command4_Click()
 On Error GoTo ErrorHandler ` Set up error handler.
 ' coords must be in himetric
 ' print same size as on screen, in upper left of page
 ScaleMode = 6 `set mode to mm
 ' there is no Printer.StartDoc method, it seems it is done
 ' implicitly when you use one of the printer.print methods
 ' so we need to print something before we print our map
 ' to start the page
 Printer.CurrentX = 0
 Printer.CurrentY = 0
 Printer.Print " "
 Map1.PrintMap Printer.hDC, 0, 0, Map1.Width * 100, _

 Map1.Height * 100
 Printer.NewPage ` Send new page.

 Printer.EndDoc ` Printing is finished.
Exit Sub

在vc中例子
// Map.PaperUnit Property
// Map.PrintMap Method
void CSampleProjectView::OnPrintMap(CDC* pDC,CPrintInfo* pInfo) {
 try {
 // get paper width in mm and convert to HIMETRIC (100th of a mm)
 m_Map.SetPaperUnit(miUnitMillimeter);

 double pw = m_Map.GetMapPaperWidth() * 100;
 double ph = m_Map.GetMapPaperHeight()* 100;

 m_Map.PrintMap((long)pDC->m_hDC,
pInfo->m_rectDraw.left,pInfo->m_rectDraw.
top,(long)pw,(long)ph);
 } catch (COleDispatchException *e) {

 e->ReportError();
 e->Delete();
 } catch (COleException *e) {
 e->ReportError();
 e->Delete();
 }
}

mapx中创建测距工具示例
首先创建测距工具
 global const calculatedistance=1
 Private Sub Form_Load()
 map1.CreateCustomTool(calcilatedistance,miToolTypepoly ,microsscursor)
 End Sub
 Private Sub Distances_Click()
 map1.currenttool=calculatetool
 End Sub

然后在mapx的PolyToolUsed事件中，用Distance( x1,y1,x2,y2 )计算距离，由状态条中或label显示。
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 DisSum As Double
 Dim Dis As Double
 Dim n As Integer
 Dim pts As New MapXLib.points
 Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double

 Set pts = points

 DisSum = 0
 MDIForm1.StatusBar1.Panels.Item(3).Text= Format(Str(DisSum), "#,##0.000000")
 Select Case Flags
 Case miPolyToolBegin
 Case miPolyToolInProgress
 If ToolNum = CalculateDistance Then
 For i = 1 To pts.Count - 1
 x1 = pts.Item(i).X
 y1 = pts.Item(i).Y
 x2 = pts.Item(i + 1).X
 y3 = pts.Item(i + 1).Y
 Dis = Map1.Distance(x1, y1, x2, y2)
 DisSum = DisSum + Dis
 MDIForm1.StatusBar1.Panels.Item(3).Text = Format(Str(DisSum), "#,##0.000000")
 Next i
 End If
 Case miPolyToolEnd
End Select

在mapx中如何实现自动滚屏
mapx 支持 MouseMove 事件，可以在此事件中实现自动滚屏，示例如下：
Private Sub Map1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If map_move = True Then
If X > Map1.MapScreenWidth - 10 Then
Map1.CenterX = Map1.CenterX + 0.05
Map1.Refresh
Else
 If X < 10 Then
 Map1.CenterX = Map1.CenterX - 0.05
 Map1.Refresh
 Else
 If Y > Map1.MapScreenHeight - 10 Then
 Map1.CenterY = Map1.CenterY - 0.05
 Map1.Refresh
 Else
 If Y < 10 Then
 Map1.CenterY = Map1.CenterY + 0.05
 Map1.Refresh
 End If
 End If
 End If
End If
End If
End Sub

在mapx中如何实现图元的拖拽
以下方法实现将选中图元移到点击处。
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ftr As Feature
Dim lyr As Layer
Dim MapX As Double
Dim MapY As Double
'convert where the mouse is clicked to the map's current coordinate system
Map1.ConvertCoord X, Y, MapX, MapY, miScreenToMap
'iterate through each selected feature in each layer
For Each lyr In Map1.Layers
For Each ftr In lyr.Selection

'change the offset of the feature
 ftr.Offset MapX - ftr.CenterX, MapY - ftr.CenterY
'update the feature to make the change permanent
 ftr.Update
Next
Next
End SUb

喜欢0 评分0

GIS麦田守望者，期待与您交流。

举报回复

jackma 路人甲注册日期2004-06-03 发帖数70 QQ 铜币303枚威望0点贡献值0点银元0个加关注写私信	1楼^# 发布于：2004-06-09 15:11 <img src="images/post/smile/dvbbs/em08.gif" /><img src="images/post/smile/dvbbs/em01.gif" />
	举报回复(0) 喜欢(0) 评分

606xixi

路人甲

注册日期2003-09-26
发帖数207
QQ
铜币17枚
威望0点
贡献值0点
银元0个

加关注写私信

2楼^#

发布于：2004-06-09 08:43

天天在努力!

举报回复喜欢评分

您需要登录后才可以回帖，登录或者注册

MapInfo Mapx 产品开发代码 集锦

最新喜欢：

MapInfo Mapx 产品开发代码集锦