frmstyle.frm

MapX示例程序：编辑特征示例

VERSION 5.00
Begin VB.Form FrmStyle 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "图层样式"
   ClientHeight    =   2955
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6780
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2955
   ScaleWidth      =   6780
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton CmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消"
      Height          =   375
      Left            =   3360
      TabIndex        =   7
      Top             =   2520
      Width           =   1455
   End
   Begin VB.CommandButton PointCmd 
      Caption         =   "修改点样式"
      Height          =   375
      Left            =   0
      TabIndex        =   6
      Top             =   1920
      Width           =   2175
   End
   Begin VB.PictureBox SymbolPict 
      Height          =   1815
      Left            =   0
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   141
      TabIndex        =   5
      Top             =   0
      Width           =   2175
   End
   Begin VB.CommandButton RegionCmd 
      Caption         =   "修改面样式"
      Height          =   375
      Left            =   4560
      TabIndex        =   4
      Top             =   1920
      Width           =   2175
   End
   Begin VB.PictureBox RegionPict 
      Height          =   1815
      Left            =   4560
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   141
      TabIndex        =   3
      Top             =   0
      Width           =   2175
   End
   Begin VB.PictureBox LinePict 
      Height          =   1815
      Left            =   2280
      ScaleHeight     =   117
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   141
      TabIndex        =   2
      Top             =   0
      Width           =   2175
   End
   Begin VB.CommandButton LineCmd 
      Caption         =   "修改线样式"
      Height          =   375
      Left            =   2280
      TabIndex        =   1
      Top             =   1920
      Width           =   2175
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   375
      Left            =   1920
      TabIndex        =   0
      Top             =   2520
      Width           =   1335
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      X1              =   0
      X2              =   6840
      Y1              =   2420
      Y2              =   2420
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000003&
      X1              =   0
      X2              =   6840
      Y1              =   2400
      Y2              =   2400
   End
End
Attribute VB_Name = "FrmStyle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim myStyle As Style

Private Sub CmdCancel_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    If IsEmpty(FrmMain.Map1.Layers.InsertionLayer) Then
        Unload Me
    End If
    
    ' 自动重绘
    FrmMain.Map1.AutoRedraw = False
    
    Set myStyle = FrmMain.Map1.Layers.InsertionLayer.Style.Clone
End Sub

Private Sub Form_Paint()
    Dim rect As New Rectangle
    
    ' 清除已有的图形
    SymbolPict.Cls
    LinePict.Cls
    RegionPict.Cls
    
    ' 在PictureBox中绘制样本符号
    rect.Set 0, 0, SymbolPict.ScaleWidth, SymbolPict.ScaleHeight
    myStyle.DrawSymbolSample SymbolPict.hDC, rect
    
    rect.Set 0, 0, LinePict.ScaleWidth, LinePict.ScaleHeight
    myStyle.DrawLineSample LinePict.hDC, rect
    
    rect.Set 0, 0, RegionPict.ScaleWidth, RegionPict.ScaleHeight
    myStyle.DrawRegionSample RegionPict.hDC, rect
End Sub

Private Sub Form_Unload(Cancel As Integer)
    FrmMain.Map1.AutoRedraw = True
End Sub

Private Sub LineCmd_Click()
    ' 弹出MapX的符号对话框
    myStyle.PickLine
End Sub

Private Sub OKButton_Click()
    FrmMain.Map1.Layers.InsertionLayer.OverrideStyle = True
    Set FrmMain.Map1.Layers.InsertionLayer.Style = myStyle
    Unload Me
End Sub

Private Sub PointCmd_Click()
    ' 弹出MapX的符号对话框
    myStyle.PickSymbol
End Sub

Private Sub RegionCmd_Click()
    ' 弹出MapX的符号对话框
    myStyle.PickRegion
End Sub