filldemo.frm

一个符号编辑器

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "Mo20.ocx"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   9105
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10035
   LinkTopic       =   "Form1"
   ScaleHeight     =   9105
   ScaleWidth      =   10035
   StartUpPosition =   3  'Windows Default
   Begin MapObjects2.Map Map1 
      Height          =   7335
      Left            =   600
      TabIndex        =   1
      Top             =   600
      Width           =   8775
      _Version        =   131072
      _ExtentX        =   15478
      _ExtentY        =   12938
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "filldemo.frx":0000
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Start"
      Height          =   615
      Left            =   3720
      TabIndex        =   0
      Top             =   8400
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Command1_Click()
Dim layer As MapObjects2.MapLayer

Dim fillset As MOSYMBOLLib.MoFillset
Dim filllayer As MOSYMBOLLib.MoFillLayer
Dim fill As MOSYMBOLLib.MoFill

'generate fill symbols
'and save to file
'this file may be used in other place
'with a simple load request

Set fillset = New MOSYMBOLLib.MoFillset

'symbol 0
Set fill = New MOSYMBOLLib.MoFill
Set filllayer = New MOSYMBOLLib.MoFillLayer
filllayer.LoadBitMap ("seaside.bmp")
fill.LayerAdd filllayer
Set filllayer = Nothing
Set filllayer = New MOSYMBOLLib.MoFillLayer
filllayer.Type = 3
filllayer.Angle = 300
filllayer.Color = vbRed
filllayer.Gap = 0.2
filllayer.InterLace = 0.05
filllayer.Offset = 0.1
filllayer.Width = 0.02
filllayer.Height = 0.1
filllayer.Mask = &H12
filllayer.MaskUnit = 0.1
fill.LayerAdd filllayer
Set filllayer = Nothing
fillset.Add fill
Set fill = Nothing

'symbol 1
Set fill = New MOSYMBOLLib.MoFill
Set filllayer = New MOSYMBOLLib.MoFillLayer
filllayer.Type = 4
filllayer.Angle = 300
filllayer.Color = vbRed
filllayer.Gap = 0.2
filllayer.InterLace = 0.05
filllayer.Offset = 0.1
filllayer.Width = 0.1
filllayer.Height = 0.1
filllayer.Mask = &H11
filllayer.MaskUnit = 0.1
filllayer.CharFace = "Arial"
filllayer.CharIndex = 40
fill.LayerAdd filllayer
Set filllayer = Nothing
fillset.Add fill
Set fill = Nothing

fillset.Save ("sample.fil")
Set fillset = Nothing



'if the symbolset file already exist
'the above code is not necessary

Set fillset = New MOSYMBOLLib.MoFillset
fillset.Load "sample.fil"

Set layer = Map1.Layers(Map1.Layers.Count - 1)
For i = 0 To fillset.Count - 1
    layer.Symbol.Custom = fillset.Item(i)
    Map1.Refresh
    MsgBox ("continue...")
Next

Set fillset = Nothing
layer.Symbol.Custom = Nothing
Map1.Refresh
End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Dim r As MapObjects2.Rectangle
Set r = Map1.TrackRectangle
Set Map1.Extent = r
End If
If Button = 2 Then
Set Map1.Extent = Map1.FullExtent
End If

End Sub