www.pudn.com > 12136.rar > Form08a.frm

VERSION 5.00 
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx" 
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx" 
Begin VB.Form Form08a  
   Caption         =   "Form" 
   ClientHeight    =   6225 
   ClientLeft      =   60 
   ClientTop       =   345 
   ClientWidth     =   6975 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   6225 
   ScaleWidth      =   6975 
   StartUpPosition =   3  '窗口缺省 
   Begin VB.TextBox Text1  
      Height          =   375 
      Left            =   4200 
      TabIndex        =   2 
      Text            =   "Text1" 
      Top             =   5640 
      Width           =   1215 
   End 
   Begin MSComDlg.CommonDialog CommonDialog1  
      Left            =   240 
      Top             =   5520 
      _ExtentX        =   847 
      _ExtentY        =   847 
      _Version        =   393216 
   End 
   Begin VB.CommandButton Command1  
      Caption         =   "Command1" 
      Height          =   495 
      Left            =   2400 
      TabIndex        =   1 
      Top             =   5640 
      Width           =   1335 
   End 
   Begin MapObjects2.Map Map1  
      Height          =   4815 
      Left            =   0 
      TabIndex        =   0 
      Top             =   0 
      Width           =   6975 
      _Version        =   131072 
      _ExtentX        =   12303 
      _ExtentY        =   8493 
      _StockProps     =   225 
      BackColor       =   16777215 
      BorderStyle     =   1 
      Contents        =   "Form08a.frx":0000 
   End 
   Begin VB.Label Label1  
      Caption         =   "Label1" 
      Height          =   495 
      Left            =   960 
      TabIndex        =   3 
      Top             =   4920 
      Width           =   5295 
   End 
End 
Attribute VB_Name = "Form08a" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
'Xuewei,2003/6/14 
'用Export方法产生shape和prj文件； 
 
Option Explicit 
Dim dc As New DataConnection 
Private Sub Command1_Click() 
  Dim PCS As New MapObjects2.ProjCoordSys 
  Dim Layer1 As MapObjects2.MapLayer 
  Dim Layer2 As New MapObjects2.MapLayer 
  Dim Str1 As String 
   
  Set Layer1 = Map1.Layers(0) 
  PCS.Type = Text1.Text 
  
  Str1 = dc.Database + "\" + "states2" 
  Set Layer2.GeoDataset = Layer1.Records.Export(Str1, PCS) 
   
  If Layer2.Valid Then 
    Layer2.Symbol.Color = moLimeGreen 
    Map1.Layers.Add Layer2 
    Map1.Extent = Map1.FullExtent 
    Label1.Caption = "新图层已经产生," & DisplayCoords(Layer2) 
  Else 
    MsgBox "新图层不能产生", vbExclamation, "无效图层" 
  End If 
End Sub 
 
Private Function DisplayCoords1() As String 
  Dim coordSys 
  Dim myLayer As MapObjects2.MapLayer 
   
  Set myLayer = Map1.Layers(0) 
  Set coordSys = myLayer.CoordinateSystem 
  If coordSys.IsProjected Then 
    DisplayCoords = "图层为投影坐标系,坐标系＝" & myLayer.CoordinateSystem.Type 
  ElseIf Not coordSys.IsProjected Then 
    DisplayCoords = "图层为地理坐标系,坐标系＝" & myLayer.CoordinateSystem.Type 
  End If 
End Function 
 
Private Function DisplayCoords(myLayer As MapObjects2.MapLayer) As String 
  Dim coordSys 
  Dim PCS As New MapObjects2.ProjCoordSys 
  Dim GCS As New MapObjects2.GeoCoordSys 
   
  Set coordSys = myLayer.CoordinateSystem 
  If coordSys.IsProjected Then 
    Set PCS = myLayer.CoordinateSystem 
    DisplayCoords = "图层为投影坐标系，Type＝" & PCS.Type & "，Unit＝" & PCS.Unit.name & _ 
    "，Projection＝" & PCS.Projection.name & "，GeoCoordSys＝" & PCS.GeoCoordSys.Type 
  ElseIf Not coordSys.IsProjected Then 
    Set GCS = myLayer.CoordinateSystem 
    DisplayCoords = "图层为地理坐标系，Type＝" & GCS.Type & "，Unit＝" & GCS.Unit.name & _ 
    "，Datum＝" & GCS.Datum.name & "，PrimeMeridian＝" & GCS.PrimeMeridian.name 
  End If 
End Function 
 
Private Sub Form_Load() 
  Text1 = "32630" 
  DrawLayer 
  Me.Caption = "坐标系文件产生" 
  Command1.Caption = "开始" 
End Sub 
 
Private Sub DrawLayer() 
  Dim Layer As MapLayer 
  dc.Database = App.Path + "\..\" + "Mexico" 
  Set Layer = New MapLayer 
  Set Layer.GeoDataset = dc.FindGeoDataset("states") 
  Layer.Symbol.Color = moRed 
  Map1.Layers.Add Layer 
  Label1.Caption = DisplayCoords(Layer) 
End Sub