N
nomad_heart
Unregistered / Unconfirmed
GUEST, unregistred user!
我想创建一个多边形图层，并对数据进行存储。但它只要VB的帮助文件，我用的是delphi，
有谁能将它翻译为delphi代码，并有效，200分奉送！
下面是VB里的原文：
(This example uses the AddGeoDataset method and the TableDesc properties to
reate a new shapefile that represents a GeoDataset with polygon features in
a DataConnection. In addition, the code associates the GeoDataset with a
MapLayer, adding it to the Map. The TableDesc properties define three
additional fields in the Recordset. For each feature added, the code invokes
the AddNew and Update methods to populate the fields of the Recordset.
To try this example, paste the code into the Declarations section of a form
containing a CommonDialog control named CommonDialog1, a CommandButton named
Command1 and Map named Map1 that contains a MapLayer or an ImageLayer.
This layer will serve as a background layer, providing the coordinates and
map units of the new MapLayer. Click F5, and track polygons by clicking on
the map, ado
uble-click signals the end of a polygon. When you've added the
polygons you want, click the Save button to specify the name of the shapefile.)
Option Explicit
Dim moSymbol As New MapObjects2.Symbol
Dim moPolygons As New Collection
Private Sub Command1_Click()
Dim gds As MapObjects2.GeoDataset
Dim sName As String
Dim Desc As New TableDesc
Dim dc As New DataConnection
Dim lyr As New MapObjects2.MapLayer
Dim lPoly As Long
With CommonDialog1
.Filter = "ESRI Shapefiles (*.shp)|*.shp"
.DefaultExt = ".shp"
.ShowSave
If Len(.FileName) = 0 then
Exit Sub ' cancel
dc.Database = CurDir
If Not dc.Connect then
Exit Sub ' bad dataConnection
' remove the extension
sName = Left(.FileTitle, Len(.FileTitle) - 4)
End With
With Desc
' define three additional fields
.FieldCount = 3
'set the field names
.FieldName(0) = "Name"
.FieldName(1) = "Area"
.FieldName(2) = "Perimeter"
' set the type of field
.FieldType(0) = moString
.FieldType(1) = moDouble
.FieldType(2) = moDouble
' set the length of a character field
.FieldLength(0) = 16
' set the number of digits used in the field
.FieldPrecision(1) = 15
.FieldPrecision(2) = 15
' set the number of digits to the right of the decimal point
.FieldScale(1) = 3
.FieldScale(2) = 3
End With
Set gds = dc.AddGeoDataset(sName, moPolygon, Desc)
If gds Is Nothing then
Exit Sub ' invalid file
Set lyr.GeoDataset = gds
Map1.Layers.Add lyr
Map1.Refresh
For lPoly = 1 To moPolygons.Count
With lyr.Records
.AddNew
.Fields("Shape").Value = moPolygons(lPoly)
.Fields("Name").Value = "Name " &
lPoly
.Fields("Area").Value = moPolygons(lPoly).Area
.Fields("Perimeter").Value = moPolygons(lPoly).Perimeter
.Update
End With
Next
End Sub
Private Sub Form_Load()
With moSymbol
.SymbolType = moFillSymbol
.Style = moSolidFill
.Color = moPaleYellow
End With
Command1.Caption = "Save"
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As Stdole.OLE_HANDLE)
Dim oPoly As MapObjects2.Polygon
If moPolygons.Count <> 0 then
For Each oPoly In moPolygons
Map1.DrawShape oPoly, moSymbol
Next
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim oRect As MapObjects2.Rectangle
Dim oPoly As New MapObjects2.Polygon
If Button = 1 then
Set oPoly = Map1.TrackPolygon
moPolygons.Add oPoly
Map1.TrackingLayer.Refresh True
else
Set oRect = Map1.Extent
oRect.ScaleRectangle 0.5
Map1.Extent = oRect
End If
End Sub
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&
天下英雄出我辈 一入江湖岁月催 &
&
宏图霸业谈笑中 不胜人生一场醉 &
&
提剑跨骑挥尾雨 白骨如山鸟惊飞 &
&
尘世如朝人如水 只叹江湖几人回 &
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
有谁能将它翻译为delphi代码，并有效，200分奉送！
下面是VB里的原文：
(This example uses the AddGeoDataset method and the TableDesc properties to
reate a new shapefile that represents a GeoDataset with polygon features in
a DataConnection. In addition, the code associates the GeoDataset with a
MapLayer, adding it to the Map. The TableDesc properties define three
additional fields in the Recordset. For each feature added, the code invokes
the AddNew and Update methods to populate the fields of the Recordset.
To try this example, paste the code into the Declarations section of a form
containing a CommonDialog control named CommonDialog1, a CommandButton named
Command1 and Map named Map1 that contains a MapLayer or an ImageLayer.
This layer will serve as a background layer, providing the coordinates and
map units of the new MapLayer. Click F5, and track polygons by clicking on
the map, ado
uble-click signals the end of a polygon. When you've added the
polygons you want, click the Save button to specify the name of the shapefile.)
Option Explicit
Dim moSymbol As New MapObjects2.Symbol
Dim moPolygons As New Collection
Private Sub Command1_Click()
Dim gds As MapObjects2.GeoDataset
Dim sName As String
Dim Desc As New TableDesc
Dim dc As New DataConnection
Dim lyr As New MapObjects2.MapLayer
Dim lPoly As Long
With CommonDialog1
.Filter = "ESRI Shapefiles (*.shp)|*.shp"
.DefaultExt = ".shp"
.ShowSave
If Len(.FileName) = 0 then
Exit Sub ' cancel
dc.Database = CurDir
If Not dc.Connect then
Exit Sub ' bad dataConnection
' remove the extension
sName = Left(.FileTitle, Len(.FileTitle) - 4)
End With
With Desc
' define three additional fields
.FieldCount = 3
'set the field names
.FieldName(0) = "Name"
.FieldName(1) = "Area"
.FieldName(2) = "Perimeter"
' set the type of field
.FieldType(0) = moString
.FieldType(1) = moDouble
.FieldType(2) = moDouble
' set the length of a character field
.FieldLength(0) = 16
' set the number of digits used in the field
.FieldPrecision(1) = 15
.FieldPrecision(2) = 15
' set the number of digits to the right of the decimal point
.FieldScale(1) = 3
.FieldScale(2) = 3
End With
Set gds = dc.AddGeoDataset(sName, moPolygon, Desc)
If gds Is Nothing then
Exit Sub ' invalid file
Set lyr.GeoDataset = gds
Map1.Layers.Add lyr
Map1.Refresh
For lPoly = 1 To moPolygons.Count
With lyr.Records
.AddNew
.Fields("Shape").Value = moPolygons(lPoly)
.Fields("Name").Value = "Name " &
lPoly
.Fields("Area").Value = moPolygons(lPoly).Area
.Fields("Perimeter").Value = moPolygons(lPoly).Perimeter
.Update
End With
Next
End Sub
Private Sub Form_Load()
With moSymbol
.SymbolType = moFillSymbol
.Style = moSolidFill
.Color = moPaleYellow
End With
Command1.Caption = "Save"
End Sub
Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As Stdole.OLE_HANDLE)
Dim oPoly As MapObjects2.Polygon
If moPolygons.Count <> 0 then
For Each oPoly In moPolygons
Map1.DrawShape oPoly, moSymbol
Next
End If
End Sub
Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim oRect As MapObjects2.Rectangle
Dim oPoly As New MapObjects2.Polygon
If Button = 1 then
Set oPoly = Map1.TrackPolygon
moPolygons.Add oPoly
Map1.TrackingLayer.Refresh True
else
Set oRect = Map1.Extent
oRect.ScaleRectangle 0.5
Map1.Extent = oRect
End If
End Sub
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
&
天下英雄出我辈 一入江湖岁月催 &
&
宏图霸业谈笑中 不胜人生一场醉 &
&
提剑跨骑挥尾雨 白骨如山鸟惊飞 &
&
尘世如朝人如水 只叹江湖几人回 &
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
