labelprops.frm

GIS地理信息系统开发。大名鼎鼎的MAPX＋VisualBasic6.0软件开发

VERSION 5.00
Begin VB.Form LabelProps 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Label Properties"
   ClientHeight    =   5370
   ClientLeft      =   2385
   ClientTop       =   2055
   ClientWidth     =   6045
   Icon            =   "LabelProps.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5370
   ScaleWidth      =   6045
   ShowInTaskbar   =   0   'False
   Begin VB.Frame frmLabelLines 
      Caption         =   "Label lines"
      Height          =   1275
      Left            =   3360
      TabIndex        =   32
      Top             =   3300
      Width           =   2475
      Begin VB.OptionButton rbSimple 
         Caption         =   "&Simple"
         Height          =   255
         Left            =   240
         TabIndex        =   34
         Top             =   600
         Width           =   1035
      End
      Begin VB.OptionButton rbArrow 
         Caption         =   "&Arrow"
         Height          =   255
         Left            =   240
         TabIndex        =   35
         Top             =   900
         Width           =   1035
      End
      Begin VB.OptionButton rbNone 
         Caption         =   "&None"
         Height          =   255
         Left            =   240
         TabIndex        =   33
         Top             =   300
         Width           =   1035
      End
   End
   Begin VB.CheckBox ckZoomRange 
      Caption         =   "Display within &Zoom Range:"
      Height          =   255
      Left            =   240
      TabIndex        =   9
      Top             =   3480
      Width           =   2355
   End
   Begin VB.TextBox txtMinZoom 
      Height          =   315
      Left            =   1320
      TabIndex        =   11
      Top             =   3840
      Width           =   1035
   End
   Begin VB.TextBox txtMaxZoom 
      Height          =   315
      Left            =   1320
      TabIndex        =   14
      Top             =   4260
      Width           =   1035
   End
   Begin VB.TextBox txtMaxLabels 
      Height          =   315
      Left            =   4680
      TabIndex        =   31
      Top             =   2820
      Width           =   1155
   End
   Begin VB.TextBox txtOffset 
      Height          =   315
      Left            =   4320
      TabIndex        =   28
      Top             =   2400
      Width           =   975
   End
   Begin VB.CheckBox ckOverlapping 
      Caption         =   "Allow o&verlapping text"
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   2880
      Width           =   1995
   End
   Begin VB.CheckBox ckVisible 
      Caption         =   "&Visible"
      Height          =   255
      Left            =   240
      TabIndex        =   6
      Top             =   2040
      Width           =   855
   End
   Begin VB.CheckBox ckDuplicate 
      Caption         =   "Allow &duplicate text"
      Height          =   255
      Left            =   240
      TabIndex        =   7
      Top             =   2520
      Width           =   1935
   End
   Begin VB.ComboBox cmbDataSet 
      Height          =   315
      Left            =   1200
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   240
      Width           =   1995
   End
   Begin VB.Frame frmPosition 
      Caption         =   "Label Anchor point"
      Height          =   1635
      Left            =   3360
      TabIndex        =   16
      Top             =   120
      Width           =   2475
      Begin VB.OptionButton rPosition 
         Caption         =   "CL"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   20
         Top             =   780
         Width           =   615
      End
      Begin VB.OptionButton rPosition 
         Caption         =   "BL"
         Height          =   255
         Index           =   6
         Left            =   240
         TabIndex        =   23
         Top             =   1200
         Width           =   615
      End
      Begin VB.OptionButton rPosition 
         Caption         =   "CC"
         Height          =   255
         Index           =   0
         Left            =   960
         TabIndex        =   21
         Top             =   780
         Width           =   615
      End
      Begin VB.OptionButton rPosition 
         Caption         =   "BC"
         Height          =   255
         Index           =   7
         Left            =   960
         TabIndex        =   24
         Top             =   1200
         Width           =   615
      End
      Begin VB.OptionButton rPosition 
         Caption         =   "TC"
         Height          =   255
         Index           =   2
         Left            =   960
         TabIndex        =   18
         Top             =   360
         Width           =   615
      End
      Begin VB.OptionButton rPosition 
         Caption         =   "CR"
         Height          =   255
         Index           =   5
         Left            =   1680
         TabIndex        =   22
         Top             =   780
         Width           =   615
      End
      Begin VB.OptionButton rPosition 
         Caption         =   "BR"
         Height          =   255
         Index           =   8
         Left            =   1680
         TabIndex        =   25
         Top             =   1200
         Width           =   615
      End
      Begin VB.OptionButton rPosition 
         Caption         =   "TR"
         Height          =   255
         Index           =   3
         Left            =   1680
         TabIndex        =   19
         Top             =   360
         Width           =   615
      End
      Begin VB.OptionButton rPosition 
         Caption         =   "TL"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   17
         Top             =   360
         Width           =   615
      End
   End
   Begin VB.CheckBox ckParallel 
      Caption         =   "&Rotate label with line"
      Height          =   255
      Left            =   3360
      TabIndex        =   26
      Top             =   1980
      Width           =   1935
   End
   Begin VB.ComboBox cmbField 
      Height          =   315
      Left            =   1200
      Style           =   2  'Dropdown List
      TabIndex        =   3
      Top             =   840
      Width           =   1995
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   1740
      TabIndex        =   37
      Top             =   4860
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "&Cancel"
      Height          =   375
      Left            =   3180
      TabIndex        =   36
      Top             =   4860
      Width           =   1215
   End
   Begin VB.CommandButton cmdFontStyle 
      Caption         =   "Aa"
      Height          =   495
      Left            =   1200
      TabIndex        =   5
      Top             =   1380
      Width           =   555
   End
   Begin VB.Label lblUnit1 
      Height          =   255
      Left            =   2400
      TabIndex        =   12
      Top             =   3900
      Width           =   915
   End
   Begin VB.Label lblUnit2 
      Height          =   255
      Left            =   2400
      TabIndex        =   15
      Top             =   4260
      Width           =   915
   End
   Begin VB.Label lblMinZoom 
      Caption         =   "&Mim Zoom:"
      Height          =   255
      Left            =   420
      TabIndex        =   10
      Top             =   3900
      Width           =   915
   End
   Begin VB.Label lblMaxZoom 
      Caption         =   "Ma&x Zoom:"
      Height          =   255
      Left            =   420
      TabIndex        =   13
      Top             =   4320
      Width           =   855
   End
   Begin VB.Label lblMaxLabels 
      Caption         =   "Max&imum labels:"
      Height          =   255
      Left            =   3360
      TabIndex        =   30
      Top             =   2880
      Width           =   1275
   End
   Begin VB.Label lblPoints 
      Caption         =   "points"
      Height          =   255
      Left            =   5400
      TabIndex        =   29
      Top             =   2460
      Width           =   495
   End
   Begin VB.Label lblOffset 
      Caption         =   "La&bel Offset"
      Height          =   255
      Left            =   3360
      TabIndex        =   27
      Top             =   2460
      Width           =   975
   End
   Begin VB.Label lblDataSet 
      Caption         =   "&Data Set:"
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   300
      Width           =   855
   End
   Begin VB.Label lblDataField 
      Caption         =   "Data &Field:"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   900
      Width           =   855
   End
   Begin VB.Label lblFontStyle 
      Caption         =   "Font St&yle:"
      Height          =   255
      Left            =   240
      TabIndex        =   4
      Top             =   1500
      Width           =   855
   End
End
Attribute VB_Name = "LabelProps"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' This sample application and corresponding sample code is provided
' for example purposes only.  It has not undergone rigorous testing
' and as such should not be shipped as part of a final application
' without extensive testing on the part of the organization releasing
' the end-user product.

Dim Label As MapXLib.LabelProperties, gMap As Map, iInd As Integer, iCurDS As Integer

Public Sub Activate(mMap As Map, ind As Integer)
  Dim i As Integer

  Set Label = ld(ind).LabelProp
  
  rPosition(Label.Position).Value = 1
  If Label.Parallel Then
    ckParallel.Value = 1
  Else
    ckParallel.Value = 0
  End If
  If Label.Visible Then
    ckVisible.Value = 1
  Else
    ckVisible.Value = 0
  End If
  If Label.Duplicate Then
    ckDuplicate.Value = 1
  Else
    ckDuplicate.Value = 0
  End If
  If Label.Overlap Then
    ckOverlapping.Value = 1
  Else
    ckOverlapping.Value = 0
  End If
  If Label.LabelZoom Then
    ckZoomRange.Value = 1
  Else
    ckZoomRange.Value = 0
  End If
  If Label.LabelZoomMin <> 0 Then
    txtMinZoom.Text = Label.LabelZoomMin
  Else
    txtMinZoom.Text = ""
  End If
  If Label.LabelZoomMax <> 0 Then
    txtMaxZoom.Text = Label.LabelZoomMax
  Else
    txtMaxZoom.Text = ""
  End If
  ckZoomRange_Click

  Select Case Label.LineType
    Case miLineTypeNone
      rbNone.Value = 1
    Case miLineTypeSimple
      rbSimple.Value = 1
    Case miLineTypeArrow
      rbArrow.Value = 1
  End Select
  
  txtOffset.Text = Label.Offset
  If Label.LabelMax <> 0 Then
    txtMaxLabels.Text = Label.LabelMax
  Else
    txtMaxLabels.Text = ""
  End If

  Set gMap = mMap
  iInd = ind
  InitUnits
  
  FillDatasets
  cmbDataset.ListIndex = 0
  iCurDS = GetDatasetNum(Label.Dataset, gMap)
  For i = 1 To cmbDataset.ListCount - 1
    If cmbDataset.ItemData(i) = iCurDS Then
      cmbDataset.ListIndex = i
      Exit For
    End If
  Next
  If cmbDataset.ListIndex = 0 Then
    iCurDS = 0
  End If

  FillFields iCurDS
  If iCurDS <> 0 Then
    cmbField.ListIndex = GetFieldNum(Label.Dataset, Label.DataField) - 1
  End If

  FormToCenter hWnd
  Show 1
End Sub

Private Sub FillDatasets()
  Dim i As Integer

  cmbDataset.Clear
  cmbDataset.AddItem "<None>"
  cmbDataset.ItemData(0) = 0
  For i = 1 To gMap.Datasets.Count
    If gMap.Datasets(i).Layer.Name = ld(iInd).Name Then
      cmbDataset.AddItem gMap.Datasets(i).Name
      cmbDataset.ItemData(cmbDataset.ListCount - 1) = i
    End If
  Next
End Sub

Private Sub FillFields(ByVal iDataSet As Integer)
  Dim i As Integer

  cmbField.Clear
  If iDataSet = 0 Then
    cmbField.AddItem "<None>"
    cmbField.ListIndex = 0
    Exit Sub
  End If
  For i = 1 To gMap.Datasets(iDataSet).Fields.Count
    cmbField.AddItem gMap.Datasets(iDataSet).Fields(i).Name
  Next
  cmbField.ListIndex = 0
End Sub

Private Sub ckZoomRange_Click()
  If ckZoomRange.Value = 1 Then
    lblMinZoom.Enabled = True
    lblMaxZoom.Enabled = True
    lblUnit1.Enabled = True
    lblUnit2.Enabled = True
    txtMinZoom.Enabled = True
    txtMaxZoom.Enabled = True
  Else
    lblMinZoom.Enabled = False
    lblMaxZoom.Enabled = False
    lblUnit1.Enabled = False
    lblUnit2.Enabled = False
    txtMinZoom.Enabled = False
    txtMaxZoom.Enabled = False
  End If
End Sub

Private Sub cmbDataset_Click()
  Dim iDS As Integer
  
  iDS = cmbDataset.ItemData(cmbDataset.ListIndex)
  If iDS = iCurDS Then
    Exit Sub
  End If
  iCurDS = iDS
  FillFields iCurDS
End Sub

Private Sub cmdCancel_Click()
  Hide
End Sub

Private Sub cmdFontStyle_Click()
  Label.Style.PickText
End Sub

Private Sub cmdOk_Click()
  Dim sField As String, i As Integer

  For i = 0 To 8
    If rPosition(i).Value Then
      Label.Position = i
      Exit For
    End If
  Next

  If iCurDS <> 0 Then
    Set Label.Dataset = gMap.Datasets(cmbDataset.ItemData(iCurDS))
    Set Label.DataField = Label.Dataset.Fields(cmbField.ListIndex + 1)
  Else
    Set Label.Dataset = Nothing
    Set Label.DataField = Nothing
  End If

  Label.Parallel = (ckParallel.Value = 1)
  Label.Duplicate = (ckDuplicate.Value = 1)
  Label.Overlap = (ckOverlapping.Value = 1)
  Label.Visible = (ckVisible.Value = 1)
  Label.LabelZoom = (ckZoomRange.Value = 1)
  Label.LabelZoomMin = Val(txtMinZoom)
  Label.LabelZoomMax = Val(txtMaxZoom)
  Label.LabelMax = Val(txtMaxLabels.Text)
  If rbNone.Value Then
    Label.LineType = miLineTypeNone
  ElseIf rbSimple.Value Then
    Label.LineType = miLineTypeSimple
  Else
    Label.LineType = miLineTypeArrow
  End If
  Label.Offset = Val(txtOffset.Text)
  
  Hide
End Sub

Private Sub InitUnits()
  Select Case gMap.MapUnit
    Case miUnitFoot
      lblUnit1.Caption = "ft."
      lblUnit2.Caption = "ft."
    Case miUnitKilometer
      lblUnit1.Caption = "km."
      lblUnit2.Caption = "km."
    Case miUnitMeter
      lblUnit1.Caption = "m."
      lblUnit2.Caption = "m."
    Case miUnitMile
      lblUnit1.Caption = "mi."
      lblUnit2.Caption = "mi."
    Case miUnitYard
      lblUnit1.Caption = "yd."
      lblUnit2.Caption = "yd."
  End Select
End Sub