www.pudn.com > MapX5Demo.rar > frmMain.frm, change:2003-12-13,size:47981b


VERSION 5.00 
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX" 
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx" 
Object = "{E760686B-BC9E-4802-9ECF-175FDF4062CE}#5.0#0"; "MAPX50.DLL" 
Begin VB.Form frmMain  
   Caption         =   "MapX5高级编辑功能演示" 
   ClientHeight    =   7725 
   ClientLeft      =   2340 
   ClientTop       =   2070 
   ClientWidth     =   9885 
   LinkTopic       =   "Form1" 
   ScaleHeight     =   7725 
   ScaleWidth      =   9885 
   Begin MapXLib.Map Map  
      Height          =   5295 
      Left            =   120 
      TabIndex        =   3 
      Top             =   1320 
      Width           =   8535 
      _Version        =   500012 
      _ExtentX        =   15055 
      _ExtentY        =   9340 
      _StockProps     =   1 
      MapCatalog.GeoDictionary=   "GeoDictionary" 
      GeoSet          =   "Empty GeosetName {9A9AC2F4-8375-44d1-BCEB-476AE986F190}" 
      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            =   "Map Symbols" 
         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 
      Title.Visible   =   0   'False 
      Title.Text      =   "Empty Title {01A9504B-CE13-4415-A5A0-51D8C2F15204}" 
      Title.Style.TextFontBackColor=   16777215 
      Title.Style.TextFontOpaque=   -1  'True 
      Title.Style.SymbolChar=   0 
      BeginProperty Title.Style.TextFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
         Name            =   "Arial" 
         Size            =   23.25 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      BeginProperty Title.Style.SymbolFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}  
         Name            =   "Arial" 
         Size            =   23.25 
         Charset         =   0 
         Weight          =   400 
         Underline       =   0   'False 
         Italic          =   0   'False 
         Strikethrough   =   0   'False 
      EndProperty 
      Title.X         =   2845 
      Title.Y         =   353 
      Map.NumericCoordSys.ProjectionInfo=   "frmMain.frx":0000 
      Map.DisplayCoordSys.ProjectionInfo=   "frmMain.frx":0130 
   End 
   Begin MSComctlLib.ImageList imagelist  
      Left            =   6600 
      Top             =   600 
      _ExtentX        =   1005 
      _ExtentY        =   1005 
      BackColor       =   -2147483643 
      ImageWidth      =   16 
      ImageHeight     =   16 
      MaskColor       =   8421376 
      _Version        =   393216 
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}  
         NumListImages   =   13 
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":0260 
            Key             =   "a" 
         EndProperty 
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":07A2 
            Key             =   "" 
         EndProperty 
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":0AF4 
            Key             =   "c" 
         EndProperty 
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":1036 
            Key             =   "d" 
         EndProperty 
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":1588 
            Key             =   "e" 
         EndProperty 
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":1ADC 
            Key             =   "f" 
         EndProperty 
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":2030 
            Key             =   "g" 
         EndProperty 
         BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":2142 
            Key             =   "h" 
         EndProperty 
         BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":2696 
            Key             =   "j" 
         EndProperty 
         BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":2BEA 
            Key             =   "" 
         EndProperty 
         BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":2CFC 
            Key             =   "" 
         EndProperty 
         BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":3250 
            Key             =   "" 
         EndProperty 
         BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}  
            Picture         =   "frmMain.frx":3362 
            Key             =   "" 
         EndProperty 
      EndProperty 
   End 
   Begin VB.ComboBox cbLayers  
      Height          =   315 
      Left            =   4680 
      TabIndex        =   2 
      Top             =   120 
      Width           =   2655 
   End 
   Begin MSComctlLib.Toolbar Toolbar  
      Align           =   1  'Align Top 
      Height          =   360 
      Left            =   0 
      TabIndex        =   1 
      Top             =   0 
      Width           =   9885 
      _ExtentX        =   17436 
      _ExtentY        =   635 
      ButtonWidth     =   609 
      ButtonHeight    =   582 
      Appearance      =   1 
      Style           =   1 
      ImageList       =   "imagelist" 
      _Version        =   393216 
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628}  
         NumButtons      =   16 
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "打开文件" 
            Object.ToolTipText     =   "打开TAB文件" 
            ImageIndex      =   1 
         EndProperty 
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "打开GST文件" 
            Object.ToolTipText     =   "打开GST文件" 
            ImageIndex      =   2 
         EndProperty 
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "保存" 
            Object.ToolTipText     =   "另存为" 
            ImageIndex      =   3 
         EndProperty 
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Style           =   3 
         EndProperty 
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "漫游" 
            Object.ToolTipText     =   "漫游" 
            ImageIndex      =   4 
            Style           =   2 
         EndProperty 
         BeginProperty Button6 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "放大" 
            Object.ToolTipText     =   "放大" 
            ImageIndex      =   5 
            Style           =   2 
         EndProperty 
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "缩小" 
            Object.ToolTipText     =   "缩小" 
            ImageIndex      =   6 
            Style           =   2 
         EndProperty 
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "缩放到图层" 
            Object.ToolTipText     =   "缩放到图层" 
            ImageIndex      =   7 
            Style           =   2 
         EndProperty 
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "图层控制" 
            Object.ToolTipText     =   "图层控制" 
            ImageIndex      =   8 
         EndProperty 
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Style           =   3 
         EndProperty 
         BeginProperty Button11 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "点查询" 
            Object.ToolTipText     =   "I查询" 
            ImageIndex      =   9 
            Style           =   2 
         EndProperty 
         BeginProperty Button12 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "点选" 
            Object.ToolTipText     =   "点选" 
            ImageIndex      =   13 
            Style           =   2 
         EndProperty 
         BeginProperty Button13 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "框选" 
            Object.ToolTipText     =   "框选" 
            ImageIndex      =   10 
            Style           =   2 
         EndProperty 
         BeginProperty Button14 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "圆选" 
            Object.ToolTipText     =   "圆选" 
            ImageIndex      =   11 
            Style           =   2 
         EndProperty 
         BeginProperty Button15 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Description     =   "多边形选择" 
            Object.ToolTipText     =   "多边形选择" 
            ImageIndex      =   12 
            Style           =   2 
         EndProperty 
         BeginProperty Button16 {66833FEA-8583-11D1-B16A-00C0F0283628}  
            Style           =   3 
         EndProperty 
      EndProperty 
   End 
   Begin MSComDlg.CommonDialog CommonDialog  
      Left            =   5640 
      Top             =   360 
      _ExtentX        =   847 
      _ExtentY        =   847 
      _Version        =   393216 
   End 
   Begin MSComctlLib.StatusBar StatusBar  
      Align           =   2  'Align Bottom 
      Height          =   405 
      Left            =   0 
      TabIndex        =   0 
      Top             =   7320 
      Width           =   9885 
      _ExtentX        =   17436 
      _ExtentY        =   714 
      _Version        =   393216 
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}  
         NumPanels       =   1 
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}  
            Object.Width           =   7056 
            MinWidth        =   7056 
         EndProperty 
      EndProperty 
   End 
   Begin VB.Menu mnuFile  
      Caption         =   "文件(&F)" 
      Begin VB.Menu mnuFileNewTAB  
         Caption         =   "新建TAB" 
      End 
      Begin VB.Menu mnuFileOpenGST  
         Caption         =   "打开GST文件" 
      End 
      Begin VB.Menu mnuFileAddTAB  
         Caption         =   "打开TAB文件" 
      End 
      Begin VB.Menu mnuFileAddOracleTAB  
         Caption         =   "打开空间数据图层" 
      End 
      Begin VB.Menu mnuFileSep1  
         Caption         =   "—————————" 
      End 
      Begin VB.Menu mnuFileSaveGST  
         Caption         =   "保存GST" 
      End 
      Begin VB.Menu mnuFileSaveas  
         Caption         =   "另存为(&S)" 
         Shortcut        =   ^S 
      End 
      Begin VB.Menu mnuFileSep2  
         Caption         =   "—————————" 
      End 
      Begin VB.Menu mnuFileCloseLayer  
         Caption         =   "关闭图层" 
      End 
      Begin VB.Menu mnuFileExit  
         Caption         =   "退出" 
      End 
   End 
   Begin VB.Menu mnuView  
      Caption         =   "视图(&V)" 
      Begin VB.Menu mnuViewPan  
         Caption         =   "漫游" 
      End 
      Begin VB.Menu mnuViewZoomIn  
         Caption         =   "放大" 
      End 
      Begin VB.Menu mnuViewZoomOut  
         Caption         =   "缩小" 
      End 
      Begin VB.Menu mnuZoomtoLayer  
         Caption         =   "缩放到图层" 
      End 
      Begin VB.Menu mnuViewLayerCtrl  
         Caption         =   "图层控制" 
      End 
      Begin VB.Menu mnuViewSep1  
         Caption         =   "—————————" 
      End 
      Begin VB.Menu mnuViewCoord  
         Caption         =   "坐标系/投影" 
      End 
      Begin VB.Menu mnuViewSep2  
         Caption         =   "—————————" 
      End 
      Begin VB.Menu mnuViewCursorCoord  
         Caption         =   "光标位置" 
      End 
      Begin VB.Menu mnuViewNodeSnap  
         Caption         =   "节点捕捉" 
      End 
      Begin VB.Menu mnuViewShowNodes  
         Caption         =   "节点显示" 
      End 
      Begin VB.Menu mnuViewOption  
         Caption         =   "选项" 
      End 
   End 
   Begin VB.Menu mnuSelect  
      Caption         =   "选择(&S)" 
      Begin VB.Menu mnuSelectbyPoint  
         Caption         =   "点选" 
      End 
      Begin VB.Menu mnuSelectbyMaquee  
         Caption         =   "框选" 
      End 
      Begin VB.Menu mnuSelectbyCircle  
         Caption         =   "圆选" 
      End 
      Begin VB.Menu mnuSelectbyPolygon  
         Caption         =   "多边形选择" 
      End 
      Begin VB.Menu mnuSelectSep1  
         Caption         =   "—————————" 
      End 
      Begin VB.Menu mnuSelectI  
         Caption         =   "I查询" 
      End 
      Begin VB.Menu mnuSelectShowFeatures  
         Caption         =   "显示选择集" 
      End 
      Begin VB.Menu mnuSelectLocateFeatures  
         Caption         =   "缩放到选择集" 
      End 
   End 
   Begin VB.Menu mnuEdit  
      Caption         =   "对象编辑(&E)" 
      Begin VB.Menu mnuEditCopy  
         Caption         =   "复制(&C)" 
         Shortcut        =   ^C 
      End 
      Begin VB.Menu mnuEditCut  
         Caption         =   "剪切(&X)" 
         Shortcut        =   ^T 
      End 
      Begin VB.Menu mnuEditPaste  
         Caption         =   "拷贝(&P)" 
         Shortcut        =   ^V 
      End 
      Begin VB.Menu mnuEditSep1  
         Caption         =   "—————————" 
      End 
      Begin VB.Menu mnuEditConsociate  
         Caption         =   "合并图元" 
      End 
      Begin VB.Menu mnuEditSplit  
         Caption         =   "拆分" 
         Visible         =   0   'False 
      End 
      Begin VB.Menu mnuEditSep2  
         Caption         =   "—————————" 
      End 
      Begin VB.Menu mnuEditMove  
         Caption         =   "平移" 
      End 
      Begin VB.Menu mnuEditRotate  
         Caption         =   "旋转" 
         Begin VB.Menu mnuEditRotate90  
            Caption         =   "旋转90度" 
         End 
         Begin VB.Menu mnuEditRotate180  
            Caption         =   "旋转180度" 
         End 
         Begin VB.Menu mnuEditRotate270  
            Caption         =   "旋转270度" 
         End 
         Begin VB.Menu mnuEditRotateAny  
            Caption         =   "任意旋转" 
         End 
      End 
   End 
   Begin VB.Menu mnuParts  
      Caption         =   "节点编辑(&P)" 
      Begin VB.Menu mnuPartsAdd  
         Caption         =   "添加" 
      End 
      Begin VB.Menu mnuPartsEdit  
         Caption         =   "编辑" 
      End 
   End 
   Begin VB.Menu mnuTable  
      Caption         =   "表维护(&M)" 
      Begin VB.Menu mnuTablePacking  
         Caption         =   "表紧缩" 
      End 
   End 
   Begin VB.Menu mnuTheme  
      Caption         =   "专题图(&T)" 
      Visible         =   0   'False 
      Begin VB.Menu mnuThemeLabel  
         Caption         =   "标注专题" 
      End 
   End 
   Begin VB.Menu mnuAbout  
      Caption         =   "关于(&A)" 
      Begin VB.Menu mnuAboutMapXNew  
         Caption         =   "MapX5新功能" 
      End 
      Begin VB.Menu mnuAboutReadme  
         Caption         =   "关于Demo" 
      End 
   End 
End 
Attribute VB_Name = "frmMain" 
Attribute VB_GlobalNameSpace = False 
Attribute VB_Creatable = False 
Attribute VB_PredeclaredId = True 
Attribute VB_Exposed = False 
'******************************************************************************** 
'File Name   :frmMain.frm 
'Description :MapX5 Demo main form 
'Author      :James Liu 
'Copyright   :MapInfo China 
'Create Date :2002年9月11日 
'******************************************************************************** 
 
Private clsPublic As New clsPublic 
Private m_sEditLayerName As String 
Private m_bShowLayerNodes As Boolean 
Private m_bIQuery As Boolean 
Private m_oExchangeFtrs As MapXLib.Features 
Private m_sCutLayerName As String 
Private m_iPrevX As Single 
Private m_iPrevY As Single 
Private m_iCurTool As Integer 
Private m_iPrevToolnum As Integer 
 
Public m_sLayerName As String 
Public m_sServerName As String 
Public m_sUserName As String 
Public m_sPwd As String 
Public m_sSQL As String 
Public m_sFilePath As String 
Public m_iAddTempLayer As Integer 
Public m_iSnapTolerance As Integer 
 
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long 
 
 
Private Sub cbLayers_Click() 
On Error Resume Next 
    m_sEditLayerName = cbLayers.List(cbLayers.ListIndex) 
     
    If m_bShowLayerNodes Then 
        Map.Layers(m_sEditLayerName).ShowNodes = True 
    End If 
     
'    RefreshcbLayers cbLayers, Map, m_sEditLayerName 
    Set Map.Layers.InsertionLayer = Map.Layers(m_sEditLayerName) 
End Sub 
 
Private Sub Form_Load() 
 
    m_iSnapTolerance = 5 
    m_bIQuery = False 
     
    StatusBar.Panels(1).Width = StatusBar.Width 
    StatusBar.Panels(1).Text = "没有装载地图" 
    Map.Left = 0 
    Map.Width = frmMain.Width 
    Map.Height = frmMain.Height - StatusBar.Height - Toolbar.Height 
    Map.Top = Toolbar.Top + Toolbar.Height 
    cbLayers.Left = Toolbar.Buttons(Toolbar.Buttons.Count - 1).Left + Toolbar.Buttons(Toolbar.Buttons.Count - 1).Width + Toolbar.ButtonWidth 
    cbLayers.Top = Toolbar.Top + (Toolbar.Height - cbLayers.Height) / 2 + 15 
     
    Map.CreateCustomTool 199, miToolTypePoint, 2 
     
End Sub 
 
Private Sub Form_Resize() 
On Error Resume Next 
    Map.Left = 0 
    Map.Width = frmMain.Width 
    Map.Height = frmMain.Height - StatusBar.Height - Toolbar.Height 
    Map.Top = Toolbar.Top + Toolbar.Height 
    cbLayers.Left = Toolbar.Buttons(Toolbar.Buttons.Count - 1).Left + Toolbar.Buttons(Toolbar.Buttons.Count - 1).Width + Toolbar.ButtonWidth 
    cbLayers.Top = Toolbar.Top + (Toolbar.Height - cbLayers.Height) / 2 + 15 
End Sub 
 
Private Sub Map_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 
On Error Resume Next 
Dim oLayer As MapXLib.Layer 
Dim oFtr As MapXLib.Feature 
Dim oFtrs As MapXLib.Features 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim i As Integer 
Dim dblMapX As Double, dblMapY As Double 
Dim dblCenterX As Double, dblCenterY As Double 
 
 
    If m_iCurTool = 200 Then 
        m_iCurTool = 0 
         
        '左键保存旋转对象,右键放弃编辑 
        If Button = vbLeftButton Then 
         
            Set oLayer = Map.Layers("RotateTempLayer") 
            Set oFtr = oLayer.AllFeatures(1) 
            Set oPnt = oFtr.Point 
            dblCenterX = oPnt.X 
            dblCenterY = oPnt.Y 
            Map.ConvertCoord X, Y, dblMapX, dblMapY, miScreenToMap 
             
            Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
            Set oFtrs = oLayer.Selection 
             
            For Each oFtr In oFtrs 
                RotateFeaturebyLine oFtr, dblCenterX, dblCenterY, dblMapX, dblMapY 
                oLayer.UpdateFeature oFtr 
            Next oFtr 
         
        End If 
         
        Map.Layers.Remove "RotateTempLayer" 
        Map.Layers.Remove "RotateFeaturesLayer" 
    End If 
 
End Sub 
 
Private Sub Map_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 
'On Error Resume Next 
Dim sTemp As String 
Dim oLayer As MapXLib.Layer 
Dim oTempLayer As MapXLib.Layer 
Dim oFtr As MapXLib.Feature 
Dim oFtrs As MapXLib.Features 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim i As Integer, j As Integer 
Dim dblMapX As Double, dblMapY As Double 
Dim dblCenterX As Double, dblCenterY As Double 
 
    If clsPublic.g_bShowCursorCoord Then 
        Map.ConvertCoord X, Y, dblMapX, dblMapY, miScreenToMap 
        sTemp = "X坐标:" & dblMapX & "    Y坐标:" & dblMapY 
        StatusBar.Panels(2).Text = sTemp 
    End If 
     
    If m_iCurTool = 200 Then 
        Set oLayer = Map.Layers("RotateTempLayer") 
        Set oFtr = oLayer.AllFeatures(1) 
        Set oPnt = oFtr.Point 
        dblCenterX = oPnt.X 
        dblCenterY = oPnt.Y 
        Set oPnts = New MapXLib.Points 
        oPnts.Add oPnt 
        Map.ConvertCoord X, Y, dblMapX, dblMapY, miScreenToMap 
        oPnts.AddXY dblMapX, dblMapY 
        Set oFtr = Map.FeatureFactory.CreateLine(oPnts, Map.DefaultStyle) 
        oFtr.Style.LineColor = vbRed 
        oFtr.Style.LineStyle = 9 
        oFtr.Style.LineWidth = 2 
        If oLayer.AllFeatures.Count > 2 Then 
            For i = 3 To oLayer.AllFeatures.Count 
                oLayer.DeleteFeature oLayer.AllFeatures(i) 
            Next i 
        End If 
        oLayer.AddFeature oFtr 
         
        Set oTempLayer = Map.Layers("RotateFeaturesLayer") 
        For j = 1 To oTempLayer.AllFeatures.Count 
            oTempLayer.DeleteFeature oTempLayer.AllFeatures(j) 
        Next j 
         
        Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
        Set oFtrs = oLayer.Selection 
         
        For Each oFtr In oFtrs 
            RotateFeaturebyLine oFtr, dblCenterX, dblCenterY, dblMapX, dblMapY 
'            oLayer.UpdateFeature oFtr 
            oTempLayer.AddFeature oFtr 
        Next oFtr 
         
        Map.Refresh 
         
    End If 
     
     
End Sub 
 
Private Sub Map_SelectionChanged() 
    If m_bIQuery And Toolbar.Buttons(11).value = tbrPressed Then 
'        MsgBox Map.Layers(cbLayers.Text).Selection(1).Name 
        Load frmProperty 
        frmProperty.InitData m_sEditLayerName 
    End If 
 
End Sub 
 
Private Sub Map_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) 
On Error Resume Next 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
Dim oFtr As MapXLib.Feature 
Dim oFtrs As MapXLib.Features 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim iCenterX As Double 
Dim iCenterY As Double 
Dim oTempLayer As MapXLib.Layer 
     
    If ToolNum = 199 Then 
        m_iCurTool = 200 
        Set oFtrs = oLayer.Selection 
         
        Set oTempLayer = Map.Layers.CreateLayer("RotateFeaturesLayer", , 1) 
         
        iCenterX = X1 
        iCenterY = Y1 
        Set oTempLayer = Map.Layers.CreateLayer("RotateTempLayer", , 1) 
        Set oPnt = New MapXLib.Point 
        oPnt.Set iCenterX, iCenterY 
        Set oFtr = Map.FeatureFactory.CreateSymbol(oPnt, Map.DefaultStyle) 
        oTempLayer.AddFeature oFtr 
         
        Set oPnts = New MapXLib.Points 
        oPnts.Add oPnt 
        oPnts.AddXY oPnt.X, Map.Bounds.YMax 
        Set oFtr = Map.FeatureFactory.CreateLine(oPnts, Map.DefaultStyle) 
        oFtr.Style.LineColor = vbBlue 
        oFtr.Style.LineStyle = 2 
        oFtr.Style.LineWidth = 2 
        oTempLayer.AddFeature oFtr 
         
        Map.CurrentTool = miSelectTool 
     
    End If 
End Sub 
 
Private Sub mnuAboutMapXNew_Click() 
'    frmTest.Show 1 
    OpenTxtFile "MapX5NewFeature.txt" 
 
End Sub 
 
Private Sub mnuAboutReadme_Click() 
    OpenTxtFile "Readme.txt" 
 
End Sub 
 
Private Sub mnuabouttest_Click() 
'    MsgBox m_sEditLayerName 
'    map.FeatureEditMode = 
    frmNewLayer.Show vbModal, Me 
End Sub 
 
Private Sub mnuEditConsociate_Click() 
On Error Resume Next 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
Dim oFtr As MapXLib.Feature 
Dim oFtrs As MapXLib.Features 
     
    If Trim(cbLayers.Text) = "" Then Exit Sub 
    Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
     
    If oLayer.Selection.Count = 0 Then Exit Sub 
    Set oFtrs = oLayer.Selection 
     
    Set oFtr = Map.FeatureFactory.CombineFeatures(oFtrs) 
    oLayer.AddFeature oFtr 
    For Each oFtr In oFtrs 
        oLayer.DeleteFeature oFtr 
    Next oFtr 
     
End Sub 
 
Private Sub mnuEditCopy_Click() 
On Error Resume Next 
 
Dim oLayer As MapXLib.Layer 
Dim oFtr As MapXLib.Feature 
    If Trim(cbLayers.Text) = "" Then Exit Sub 
    Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
     
    If oLayer.Selection.Count = 0 Then Exit Sub 
     
    Set m_oExchangeFtrs = oLayer.Selection 
'    For Each oFtr In oLayer.Selection 
'        m_oExchangeFtrs.Add oFtr 
'    Next oFtr 
     
    m_sCutLayerName = "" 
    If oLayer.Selection.Count = 1 Then 
        StatusBar.Panels(1).Text = "one feature is copying..." 
    Else 
        StatusBar.Panels(1).Text = oLayer.Selection.Count & " features are copying..." 
    End If 
    StatusBar.Refresh 
     
End Sub 
 
Private Sub mnuEditCut_Click() 
On Error Resume Next 
 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
Dim oFtr As MapXLib.Feature 
 
    If Trim(cbLayers.Text) = "" Then Exit Sub 
    Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
     
    If oLayer.Selection.Count = 0 Then Exit Sub 
     
    Set m_oExchangeFtrs = oLayer.Selection 
    m_sCutLayerName = oLayer.Name 
     
    If oLayer.Selection.Count = 1 Then 
        StatusBar.Panels(1).Text = "one feature is cut..." 
    Else 
        StatusBar.Panels(1).Text = oLayer.Selection.Count & " features are cut..." 
    End If 
    StatusBar.Refresh 
     
    Map.Refresh 
     
     
End Sub 
 
Private Sub mnuEditMove_Click() 
    Map.CurrentTool = miSelectTool 
    Map.FeatureEditMode = miEditModeFeature 
     
End Sub 
 
Private Sub mnuEditPaste_Click() 
On Error Resume Next 
 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
Dim oFtr As MapXLib.Feature 
Dim oTempLayer  As MapXLib.Layer 
Dim iFtrCount As Integer 
 
    If Trim(cbLayers.Text) = "" Then Exit Sub 
    Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
     
'    If m_oExchangeFtrs.Count = 0 Then Exit Sub 
    iFtrCount = 0 
    For Each oFtr In m_oExchangeFtrs 
        iFtrCount = iFtrCount + 1 
    Next oFtr 
     
    If iFtrCount = 0 Then Exit Sub 
     
    For Each oFtr In m_oExchangeFtrs 
        oLayer.AddFeature oFtr 
    Next oFtr 
    oLayer.Selection.Replace m_oExchangeFtrs 
     
    '删除剪切要素 
    If m_sCutLayerName <> "" Then 
        Set oTempLayer = Map.Layers(m_sCutLayerName) 
        For Each oFtr In m_oExchangeFtrs 
            oTempLayer.DeleteFeature oFtr 
        Next oFtr 
     
    End If 
     
    If iFtrCount = 1 Then 
        StatusBar.Panels(1).Text = "one feature is copyed..." 
    Else 
        StatusBar.Panels(1).Text = iFtrCount & " features are copyed..." 
    End If 
    StatusBar.Refresh 
     
    Set m_oExchangeFtrs = oLayer.Selection 
     
    Map.Refresh 
 
 
End Sub 
 
Private Sub mnuEditRotate180_Click() 
On Error Resume Next 
 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
Dim oFtr As MapXLib.Feature 
Dim oFtrs As MapXLib.Features 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim iCenterX As Double 
Dim iCenterY As Double 
     
    If Trim(cbLayers.Text) = "" Then Exit Sub 
    Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
     
    If oLayer.Selection.Count = 0 Then Exit Sub 
    Set oFtrs = oLayer.Selection 
    iCenterX = (oLayer.Selection.Bounds.XMin + oLayer.Selection.Bounds.XMax) / 2 
    iCenterY = (oLayer.Selection.Bounds.YMin + oLayer.Selection.Bounds.YMax) / 2 
    For Each oFtr In oFtrs 
        RotateFeaturebyAngle oFtr, iCenterX, iCenterY, 180 
        oLayer.UpdateFeature oFtr 
    Next oFtr 
     
    Map.Refresh 
 
End Sub 
 
Private Sub mnuEditRotate270_Click() 
On Error Resume Next 
 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
Dim oFtr As MapXLib.Feature 
Dim oFtrs As MapXLib.Features 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim iCenterX As Double 
Dim iCenterY As Double 
     
    If Trim(cbLayers.Text) = "" Then Exit Sub 
    Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
     
    If oLayer.Selection.Count = 0 Then Exit Sub 
    Set oFtrs = oLayer.Selection 
    iCenterX = (oLayer.Selection.Bounds.XMin + oLayer.Selection.Bounds.XMax) / 2 
    iCenterY = (oLayer.Selection.Bounds.YMin + oLayer.Selection.Bounds.YMax) / 2 
     
    For Each oFtr In oFtrs 
        RotateFeaturebyAngle oFtr, iCenterX, iCenterY, 270 
        oLayer.UpdateFeature oFtr 
    Next oFtr 
     
    Map.Refresh 
 
End Sub 
 
Private Sub mnuEditRotate90_Click() 
On Error Resume Next 
 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
Dim oFtr As MapXLib.Feature 
Dim oFtrs As MapXLib.Features 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim iCenterX As Double 
Dim iCenterY As Double 
     
    If Trim(cbLayers.Text) = "" Then Exit Sub 
    Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
     
    If oLayer.Selection.Count = 0 Then Exit Sub 
    Set oFtrs = oLayer.Selection 
    iCenterX = (oLayer.Selection.Bounds.XMin + oLayer.Selection.Bounds.XMax) / 2 
    iCenterY = (oLayer.Selection.Bounds.YMin + oLayer.Selection.Bounds.YMax) / 2 
    For Each oFtr In oFtrs 
        RotateFeaturebyAngle oFtr, iCenterX, iCenterY, 90 
        oLayer.UpdateFeature oFtr 
    Next oFtr 
     
    Map.Refresh 
     
End Sub 
 
Private Sub mnuEditRotateAny_Click() 
On Error Resume Next 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
Dim oFtr As MapXLib.Feature 
Dim oFtrs As MapXLib.Features 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim iCenterX As Double 
Dim iCenterY As Double 
Dim oTempLayer As MapXLib.Layer 
     
    If Trim(cbLayers.Text) = "" Then Exit Sub 
    Set oLayer = Map.Layers(Trim(cbLayers.Text)) 
     
    If oLayer.Selection.Count = 0 Then Exit Sub 
    m_iPrevTool = Map.CurrentTool 
     
    If MsgBox("自己指定旋转锚点?否则默认将选中要素的质心作为锚点", vbYesNo, "选择锚点") = vbYes Then 
        Map.CurrentTool = 199 
    Else 
        m_iCurTool = 200 
        Set oFtrs = oLayer.Selection 
         
        Set oTempLayer = Map.Layers.CreateLayer("RotateFeaturesLayer", , 1) 
         
        iCenterX = (oLayer.Selection.Bounds.XMin + oLayer.Selection.Bounds.XMax) / 2 
        iCenterY = (oLayer.Selection.Bounds.YMin + oLayer.Selection.Bounds.YMax) / 2 
        Set oTempLayer = Map.Layers.CreateLayer("RotateTempLayer", , 1) 
        Set oPnt = New MapXLib.Point 
        oPnt.Set iCenterX, iCenterY 
        Set oFtr = Map.FeatureFactory.CreateSymbol(oPnt, Map.DefaultStyle) 
        oTempLayer.AddFeature oFtr 
         
        Set oPnts = New MapXLib.Points 
        oPnts.Add oPnt 
        oPnts.AddXY oPnt.X, Map.Bounds.YMax 
        Set oFtr = Map.FeatureFactory.CreateLine(oPnts, Map.DefaultStyle) 
        oFtr.Style.LineColor = vbBlue 
        oFtr.Style.LineStyle = 2 
        oFtr.Style.LineWidth = 2 
        oTempLayer.AddFeature oFtr 
    End If 
         
 
End Sub 
 
Private Sub mnuFileAddOracleTAB_Click() 
On Error Resume Next 
 
Dim oLayerInfo As MapXLib.LayerInfo 
Dim sLayerName As String 
     
    frmOpenOracleLayer.Show vbModal, Me 
    If m_sServerName <> "" Then 
        Set oLayerInfo = New MapXLib.LayerInfo 
        sLayerName = clsPublic.GetUniqueLayerNamebySQL(Map, m_sSQL) 
        oLayerInfo.Type = miLayerInfoTypeServer 
        oLayerInfo.AddParameter "Name", sLayerName 
        oLayerInfo.AddParameter "ConnectString", "SRVR=" & m_sServerName & ";UID=" & m_sUserName & ";PWD=" & m_sPwd 
        oLayerInfo.AddParameter "Query", m_sSQL 
'        oLayerInfo.AddParameter "Query", "" 
        oLayerInfo.AddParameter "toolkit", "ORAINET" 
        oLayerInfo.AddParameter "Cache", "OFF" 
        oLayerInfo.AddParameter "MBRSearch", "OFF" 
        oLayerInfo.AddParameter "AutoCreateDataset", 1 
        oLayerInfo.AddParameter "DatasetName", sLayerName 
         
        Map.Layers.Add oLayerInfo 
'        m_sEditLayerName = sLayerName 
        RefreshcbLayers cbLayers, Map, m_sEditLayerName 
        StatusBar.Panels(1).Text = m_sSQL 
        StatusBar.Refresh 
         
        Set oLayerInfo = Nothing 
    End If 
     
End Sub 
 
Private Sub mnuFileAddTAB_Click() 
On Error Resume Next 
 
Dim sFilePath As String 
Dim sLayerName As String 
Dim oLayerInfo As MapXLib.LayerInfo 
     
    CommonDialog.CancelError = True 
    CommonDialog.Filter = "*.tab|*.tab" 
    CommonDialog.ShowOpen 
    sFilePath = CommonDialog.FileName 
     
    If Trim(sFilePath) <> "" Then 
        sLayerName = clsPublic.GetUniqueLayerName(Map, sFilePath) 
        Set oLayerInfo = New MapXLib.LayerInfo 
        oLayerInfo.Type = miLayerInfoTypeTab 
        oLayerInfo.AddParameter "name", sLayerName 
        oLayerInfo.AddParameter "FileSpec", sFilePath 
        Map.Layers.Add oLayerInfo 
'        m_sEditLayerName = sLayerName 
        StatusBar.Panels(1).Text = sFilePath 
        StatusBar.Refresh 
        RefreshcbLayers cbLayers, Map, m_sEditLayerName 
    End If 
     
 
End Sub 
 
Private Sub mnuFileCloseLayer_Click() 
    If Map.Layers.Count > 0 Then 
        frmSelectLayer.Show vbModal, frmMain 
        If m_sLayerName <> "" Then 
            If m_sLayerName = "所有图层" Then 
                Map.Layers.RemoveAll 
                StatusBar.Panels(1).Text = "没有装载地图" 
                m_sEditLayerName = "" 
                RefreshcbLayers cbLayers, Map, m_sEditLayerName 
            Else 
                Map.Layers.Remove m_sLayerName 
                StatusBar.Panels(1).Text = "已关闭" & m_sLayerName 
                If StrComp(m_sLayerName, m_sEditLayerName, vbTextCompare) = 0 Then 
                    m_sEditLayerName = "" 
                    RefreshcbLayers cbLayers, Map, m_sEditLayerName 
                Else 
                    RefreshcbLayers cbLayers, Map, m_sEditLayerName 
                End If 
            End If 
        End If 
    End If 
End Sub 
 
Private Sub mnuFileExit_Click() 
    Unload Me 
End Sub 
 
Private Sub mnuFileNewTAB_Click() 
On Error Resume Next 
 
Dim sFilePath As String 
Dim sLayerName As String 
Dim oLayer As MapXLib.Layer 
Dim oLayerInfo As MapXLib.LayerInfo 
 
    frmNewLayer.Show vbModal, Me 
 
    If m_sLayerName = "" Then Exit Sub 
     
    Set oLayerInfo = New MapXLib.LayerInfo 
     
    sLayerName = clsPublic.GetUniqueLayerNamebyStr(Map, m_sLayerName) 
     
    If m_sFilePath <> "" And m_iAddTempLayer = 0 Then 
        sFilePath = Trim(m_sFilePath & "\" & Trim(m_sLayerName) & ".tab") 
'        oLayerInfo.Type = miLayerInfoTypeNewTable 
'        oLayerInfo.AddParameter "FileSpec", sFilePath 
'        oLayerInfo.AddParameter "Name", sLayerName 
'        oLayerInfo.AddParameter "OverwriteFile", "1" 
'        Set oLayer = Map.Layers.Add(oLayerInfo, 1) 
        Set oLayer = Map.Layers.CreateLayer(sLayerName, sFilePath, 1) 
    Else 
        Set oLayer = Map.Layers.CreateLayer(sLayerName, , 1) 
    End If 
     
    m_sEditLayerName = sLayerName 
    RefreshcbLayers cbLayers, Map, m_sEditLayerName 
     
    Set oLayerInfo = Nothing 
 
End Sub 
 
Private Sub mnuFileOpenGST_Click() 
On Error GoTo ErrorReturn 
 
Dim sFilePath As String 
 
    CommonDialog.CancelError = True 
    CommonDialog.Filter = "*.gst|*.gst" 
    CommonDialog.ShowOpen 
    sFilePath = CommonDialog.FileName 
    If Trim(sFilePath) <> "" Then 
        Map.Layers.RemoveAll 
        Map.Layers.AddGeoSetLayers sFilePath 
        StatusBar.Panels(1).Text = sFilePath 
        RefreshcbLayers cbLayers, Map, "" 
        m_sEditLayerName = Map.Layers(1).Name 
        StatusBar.Panels(1).Text = sFilePath 
        StatusBar.Refresh 
    End If 
     
ErrorReturn: 
 
End Sub 
 
Private Sub mnuFileSaveas_Click() 
On Error Resume Next 
     
    If Map.Layers.Count <> 0 Then 
        frmSaveLayer.Show vbModal, Me 
    Else 
        MsgBox "没有加载任何图层!" 
    End If 
 
End Sub 
 
Private Sub mnuFileSaveGST_Click() 
On Error Resume Next 
 
Dim sFilePath As String 
Dim sFileName As String 
     
    If Map.Layers.Count = 0 Then 
        MsgBox "当前地图中没有加载任何图层!" 
        Exit Sub 
    End If 
    CommonDialog.CancelError = True 
    CommonDialog.Filter = "*.gst|*.gst" 
    CommonDialog.ShowSave 
    sFilePath = CommonDialog.FileName 
    If Trim(sFilePath) <> "" Then 
        sFileName = clsPublic.GetFileNamefromPath(sFilePath) 
        Map.SaveMapAsGeoset "", sFilePath 
        StatusBar.Panels(1).Text = sFilePath 
    End If 
     
End Sub 
 
Private Sub mnuPartsAdd_Click() 
    Map.CurrentTool = miSelectTool 
    Map.FeatureEditMode = miEditModeAddNode + miEditModeNode 
    If Not clsPublic.g_bSnaped Then 
        mnuViewNodeSnap_Click 
    End If 
     
    If Not m_bShowLayerNodes Then 
        mnuViewShowNodes_Click 
    End If 
    Map.SnapToNodeSupport = True 
     
End Sub 
 
Private Sub mnuPartsEdit_Click() 
    Map.CurrentTool = miSelectTool 
    Map.FeatureEditMode = miEditModeNode 
    If Not clsPublic.g_bSnaped Then 
        mnuViewNodeSnap_Click 
    End If 
     
    If Not m_bShowLayerNodes Then 
        mnuViewShowNodes_Click 
    End If 
    Map.SnapToNodeSupport = True 
     
End Sub 
 
Private Sub mnuSelectbyCircle_Click() 
    Map.CurrentTool = miRadiusSelectTool 
    Map.FeatureEditMode = miEditModeFeature 
    If clsPublic.g_bSnaped Then 
        Map.SnapToNodeSupport = True 
    Else 
        Map.SnapToNodeSupport = False 
    End If 
     
End Sub 
 
Private Sub mnuSelectbyMaquee_Click() 
    Map.CurrentTool = miRectSelectTool 
    Map.FeatureEditMode = miEditModeFeature 
    If clsPublic.g_bSnaped Then 
        Map.SnapToNodeSupport = True 
    Else 
        Map.SnapToNodeSupport = False 
    End If 
     
End Sub 
 
Private Sub mnuSelectbyPoint_Click() 
    Map.CurrentTool = miSelectTool 
'    If clsPublic.g_bSnaped Then 
'        Map.SnapToNodeSupport = True 
'    Else 
'        Map.SnapToNodeSupport = False 
'    End If 
End Sub 
 
Private Sub mnuSelectbyPolygon_Click() 
    Map.CurrentTool = miPolygonSelectTool 
    Map.FeatureEditMode = miEditModeFeature 
    If clsPublic.g_bSnaped Then 
        Map.SnapToNodeSupport = True 
    Else 
        Map.SnapToNodeSupport = False 
    End If 
     
End Sub 
 
Private Sub mnuSelectI_Click() 
    m_bIQuery = True 
    mnuSelectI.Checked = Not mnuSelectI.Checked 
    If mnuSelectI.Checked Then 
        Toolbar.Buttons(11).value = tbrPressed 
    Else 
        Toolbar.Buttons(11).value = tbrUnpressed 
    End If 
    Map.CurrentTool = miSelectTool 
    Map.FeatureEditMode = miEditModeFeature 
    If clsPublic.g_bSnaped Then 
        Map.SnapToNodeSupport = True 
    Else 
        Map.SnapToNodeSupport = False 
    End If 
End Sub 
 
Private Sub mnuSelectLocateFeatures_Click() 
    Set Map.Bounds = Map.Layers.Bounds 
End Sub 
 
Private Sub mnuSelectShowFeatures_Click() 
    frmShowFeatures.Show 1, Me 
End Sub 
 
Private Sub mnuTablePacking_Click() 
    If Map.Layers.Count > 0 Then 
        frmPackOption.Show vbModal, Me 
    Else 
        MsgBox "当前地图中没有加载图层,无法执行该操作!" 
    End If 
End Sub 
 
Private Sub mnuThemeLabel_Click() 
Dim oLayer As MapXLib.Layer 
Dim oDS As MapXLib.Dataset 
 
 
End Sub 
 
Private Sub mnuViewCoord_Click() 
    Map.DisplayCoordSys.PickCoordSys 
End Sub 
 
Private Sub mnuViewCursorCoord_Click() 
    clsPublic.g_bShowCursorCoord = Not clsPublic.g_bShowCursorCoord 
    If clsPublic.g_bShowCursorCoord Then 
        StatusBar.Panels.Add 2, "CoordPanel", "" 
        If StatusBar.Panels.Count = 2 Then 
            StatusBar.Panels(1).Width = StatusBar.Width * 0.6 
            StatusBar.Panels(2).Width = StatusBar.Width * 0.4 
        Else 
            StatusBar.Panels(1).Width = StatusBar.Width * 0.4 
            StatusBar.Panels(2).Width = StatusBar.Width * 0.4 
            StatusBar.Panels(3).Width = StatusBar.Width * 0.2 
        End If 
    Else 
        StatusBar.Panels.Remove 2 
        If StatusBar.Panels.Count = 1 Then 
            StatusBar.Panels(1).Width = StatusBar.Width 
        Else 
            StatusBar.Panels(1).Width = StatusBar.Width * 0.7 
            StatusBar.Panels(2).Width = StatusBar.Width * 0.3 
        End If 
         
    End If 
    mnuViewCursorCoord.Checked = clsPublic.g_bShowCursorCoord 
     
End Sub 
 
Private Sub mnuViewLayerCtrl_Click() 
    Map.PropertyPage 
End Sub 
 
Private Sub mnuViewNodeSnap_Click() 
    clsPublic.g_bSnaped = Not clsPublic.g_bSnaped 
    Map.SnapTolerance = m_iSnapTolerance 
    If clsPublic.g_bSnaped Then 
         
        If StatusBar.Panels.Count = 1 Then 
            StatusBar.Panels.Add 2, "InfoPanel", "" 
            StatusBar.Panels(2).Text = "捕捉节点" 
            StatusBar.Panels(1).Width = StatusBar.Width * 0.8 
            StatusBar.Panels(2).Width = StatusBar.Width * 0.2 
        Else 
            StatusBar.Panels.Add 3, "InfoPanel", "" 
            StatusBar.Panels(3).Text = "捕捉节点" 
            StatusBar.Panels(1).Width = StatusBar.Width * 0.4 
            StatusBar.Panels(2).Width = StatusBar.Width * 0.4 
            StatusBar.Panels(3).Width = StatusBar.Width * 0.2 
        End If 
    Else 
        If StatusBar.Panels.Count = 2 Then 
            StatusBar.Panels.Remove 2 
            StatusBar.Panels(1).Width = StatusBar.Width 
        Else 
            StatusBar.Panels.Remove 3 
            StatusBar.Panels(1).Width = StatusBar.Width * 0.7 
            StatusBar.Panels(2).Width = StatusBar.Width * 0.3 
        End If 
        
    End If 
     
    mnuViewNodeSnap.Checked = clsPublic.g_bSnaped 
End Sub 
 
Private Sub mnuViewOption_Click() 
    frmOptions.Show vbModal, Me 
End Sub 
 
Private Sub mnuViewPan_Click() 
    Map.CurrentTool = miPanTool 
End Sub 
 
Private Sub mnuViewShowNodes_Click() 
    m_bShowLayerNodes = Not m_bShowLayerNodes 
    If m_bShowLayerNodes Then 
        If Trim(m_sEditLayerName) <> "" Then 
            Map.Layers(Trim(m_sEditLayerName)).ShowNodes = True 
        End If 
    Else 
        If Trim(m_sEditLayerName) <> "" Then 
            Map.Layers(Trim(m_sEditLayerName)).ShowNodes = False 
        End If 
    End If 
    mnuViewShowNodes.Checked = m_bShowLayerNodes 
     
End Sub 
 
Private Sub mnuViewZoomIn_Click() 
    Map.CurrentTool = miZoomInTool 
End Sub 
 
Private Sub mnuViewZoomOut_Click() 
    Map.CurrentTool = miZoomOutTool 
End Sub 
 
Private Sub RefreshcbLayers(ByRef combobox As combobox, ByVal Map As MapXLib.Map, ByVal sLayerName As String) 
On Error Resume Next 
Dim i As Integer 
Dim iSelected As Integer 
    combobox.Clear 
     
    iSelected = 0 
    For i = 1 To Map.Layers.Count 
        combobox.AddItem Map.Layers(i) 
        If StrComp(sLayerName, Map.Layers(i).Name, vbTextCompare) = 0 Then 
            iSelected = i - 1 
             
        End If 
        Map.Layers(i).Editable = False 
    Next i 
    If combobox.ListCount <> 0 Then 
        combobox.ListIndex = iSelected 
        Set Map.Layers.InsertionLayer = Map.Layers(iSelected + 1) 
        Map.Layers(iSelected + 1).Editable = True 
    End If 
     
End Sub 
 
Private Sub mnuZoomtoLayer_Click() 
    If Map.Layers.Count > 0 Then 
        frmSelectLayer.Show vbModal, frmMain 
        If m_sLayerName <> "" Then 
            If m_sLayerName = "所有图层" Then 
                Set Map.Bounds = Map.Layers.Bounds 
            Else 
                Set Map.Bounds = Map.Layers(m_sLayerName).Bounds 
            End If 
        End If 
    End If 
 
End Sub 
 
Private Sub OpenTxtFile(ByVal sFileName As String) 
    Dim sWinDir As String 
    Dim sHelpFilePath As String 
    Const MAX_PATH = 260 
     
    On Error Resume Next 
     
    '构造帮助文件的全路径名 
    If Right(App.Path, 1) = "\" Then 
        sHelpFilePath = App.Path & sFileName 
    Else 
        sHelpFilePath = App.Path & "\" & sFileName 
    End If 
     
    '如果找到了帮助文件 
    If Dir(sHelpFilePath) <> "" Then 
        '获得Windows操作系统的安装路径 
        sWinDir = Space(MAX_PATH) 
        GetWindowsDirectory sWinDir, MAX_PATH 
        sWinDir = Trim(sWinDir) 
        '调用记事本显示帮助文件 
        Shell Left(sWinDir, Len(sWinDir) - 1) & "\notepad.exe '" & _ 
                sHelpFilePath & "'", vbNormalFocus 
    End If 
 
End Sub 
 
Private Sub RotateFeaturebyAngle(ByRef oFtr As MapXLib.Feature, ByVal dblCenterX As Double, ByVal dblCenterY As Double, ByVal dblRotate As Double) 
On Error Resume Next 
 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim iCenterX As Double 
Dim iCenterY As Double 
     
'    iCenterX = oFtr.CenterX 
'    iCenterY = oFtr.CenterY 
    iCenterX = dblCenterX 
    iCenterY = dblCenterY 
 
     
    For Each oPnts In oFtr.Parts 
        For Each oPnt In oPnts 
            Select Case dblRotate 
             
                Case 90 
                    oPnt.Set iCenterX + oPnt.Y - iCenterY, iCenterY + iCenterX - oPnt.X 
                Case 180 
                    oPnt.Set iCenterX - (oPnt.X - iCenterX), iCenterY - (oPnt.Y - iCenterY) 
                Case 270 
                    oPnt.Set iCenterX - (oPnt.Y - iCenterY), iCenterY + (oPnt.X - iCenterX) 
            End Select 
        Next oPnt 
    Next oPnts 
 
End Sub 
 
Private Sub RotateFeaturebyLine(ByRef oFtr As MapXLib.Feature, ByVal dblCenterX As Double, ByVal dblCenterY As Double, ByVal dblMapX As Double, ByVal dblMapY As Double) 
On Error Resume Next 
 
Dim oPnt As MapXLib.Point 
Dim oPnts As MapXLib.Points 
Dim dblX As Double 
Dim dblY As Double 
Dim l1 As Double 
Dim l2 As Double 
Dim l3 As Double 
     
    For Each oPnts In oFtr.Parts 
        For Each oPnt In oPnts 
            l1 = Abs(Sqr((oPnt.X - dblCenterX) * (oPnt.X - dblCenterX) + (oPnt.Y - dblCenterY) * (oPnt.Y - dblCenterY))) 
            l2 = Abs(Sqr((dblMapX - dblCenterX) * (dblMapX - dblCenterX) + (dblMapY - dblCenterY) * (dblMapY - dblCenterY))) 
            dblX = dblCenterX + (((oPnt.X - dblCenterX) * (dblMapY - dblCenterY) + (oPnt.Y - dblCenterY) * (dblMapX - dblCenterX)) / l2) 
            dblY = dblCenterY + (((oPnt.Y - dblCenterY) * (dblMapY - dblCenterY) - (oPnt.X - dblCenterX) * (dblMapX - dblCenterX)) / l2) 
            oPnt.Set dblX, dblY 
        Next oPnt 
    Next oPnts 
 
End Sub 
 
 
Private Sub Toolbar_ButtonClick(ByVal Button As MSComctlLib.Button) 
     
    mnuSelectI.Checked = False 
    Select Case Button.Index 
        Case 1 
            mnuFileAddTAB_Click 
        Case 2 
            mnuFileOpenGST_Click 
        Case 3 
            mnuFileSaveas_Click 
        Case 5 
            mnuViewPan_Click 
        Case 6 
            mnuViewZoomIn_Click 
        Case 7 
            mnuViewZoomOut_Click 
        Case 8 
            mnuZoomtoLayer_Click 
        Case 9 
            mnuViewLayerCtrl_Click 
        Case 11 
            mnuSelectI_Click 
        Case 12 
            mnuSelectbyPoint_Click 
        Case 13 
            mnuSelectbyMaquee_Click 
        Case 14 
            mnuSelectbyCircle_Click 
        Case 15 
            mnuSelectbyPolygon_Click 
    End Select 
     
End Sub