📄 labelproperties.frm
字号:
VERSION 4.00
Begin VB.Form LabelProperties
BorderStyle = 3 'Fixed Dialog
Caption = "Label Properties"
ClientHeight = 3105
ClientLeft = 2295
ClientTop = 2895
ClientWidth = 6060
Height = 3510
Icon = "LabelProperties.frx":0000
Left = 2235
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3105
ScaleWidth = 6060
ShowInTaskbar = 0 'False
Top = 2550
Width = 6180
Begin VB.ComboBox cmbDataSet
Height = 315
Left = 1200
Style = 2 'Dropdown List
TabIndex = 1
Top = 240
Width = 1995
End
Begin VB.OptionButton rPosition
Caption = "UR"
Height = 255
Index = 3
Left = 5040
TabIndex = 7
Top = 480
Width = 615
End
Begin VB.OptionButton rPosition
Caption = "LR"
Height = 255
Index = 9
Left = 5040
TabIndex = 13
Top = 1320
Width = 615
End
Begin VB.OptionButton rPosition
Caption = "CR"
Height = 255
Index = 6
Left = 5040
TabIndex = 10
Top = 900
Width = 615
End
Begin VB.OptionButton rPosition
Caption = "UC"
Height = 255
Index = 2
Left = 4320
TabIndex = 6
Top = 480
Width = 615
End
Begin VB.OptionButton rPosition
Caption = "LC"
Height = 255
Index = 8
Left = 4320
TabIndex = 12
Top = 1320
Width = 615
End
Begin VB.OptionButton rPosition
Caption = "CC"
Height = 255
Index = 5
Left = 4320
TabIndex = 9
Top = 900
Width = 615
End
Begin VB.OptionButton rPosition
Caption = "LL"
Height = 255
Index = 7
Left = 3600
TabIndex = 11
Top = 1320
Width = 615
End
Begin VB.OptionButton rPosition
Caption = "CL"
Height = 255
Index = 4
Left = 3600
TabIndex = 8
Top = 900
Width = 615
End
Begin VB.Frame frmPosition
Caption = "Label Position"
Height = 1635
Left = 3360
TabIndex = 4
Top = 120
Width = 2475
Begin VB.OptionButton rPosition
Caption = "UL"
Height = 255
Index = 1
Left = 240
TabIndex = 5
Top = 360
Width = 615
End
End
Begin VB.CheckBox ckParallel
Caption = "&Labels parallel to lines"
Height = 255
Left = 3360
TabIndex = 16
Top = 2040
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 = 18
Top = 2580
Width = 1215
End
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "&Cancel"
Height = 375
Left = 3180
TabIndex = 17
Top = 2580
Width = 1215
End
Begin VB.CommandButton cmdFontStyle
Caption = "Aa"
Height = 495
Left = 1200
TabIndex = 15
Top = 1620
Width = 555
End
Begin VB.Label lblDataSet
Caption = "&Data Set:"
Height = 255
Left = 240
TabIndex = 0
Top = 300
Width = 855
End
Begin MSComDlg.CommonDialog dlgFont
Left = 4500
Top = 2520
_Version = 65536
_ExtentX = 847
_ExtentY = 847
_StockProps = 0
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 Style:"
Height = 255
Left = 240
TabIndex = 14
Top = 1740
Width = 855
End
End
Attribute VB_Name = "LabelProperties"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
Dim lStyle As New StdFont, iInd As Integer, iCurDS As Integer
Dim gMap As Map
Public Sub Activate(Map As Map, ByVal ind As Integer)
'Public Sub Activate(ByVal LayerName As String, ByVal NewLayer As Boolean, Style As StdFont, ByVal Orientation As Integer, ByVal Field As Integer, ByVal Parallel As Boolean)
Set lStyle = ld(ind).LabelProp.Style
Set cmdFontStyle.Font = lStyle
If ld(ind).LabelProp.Orientation = 0 Then
rPosition(6).Value = 1
Else
rPosition(ld(ind).LabelProp.Orientation).Value = 1
End If
If ld(ind).LabelProp.Parallel Then
ckParallel.Value = 1
Else
ckParallel.Value = 0
End If
iInd = ind
Set gMap = Map
FillDatasets
' If cmbDataset.ListCount = 1 Then
' Exit Sub
' End If
iCurDS = cmbDataset.ListIndex
FillFields iCurDS
FormToCenter hWnd
Show 1
End Sub
Private Sub FillDatasets()
Dim i As Integer
cmbDataset.Clear
cmbDataset.AddItem "<None>"
For i = 1 To gMap.Datasets.Count
If gMap.Datasets(i).Layer.Name = ld(iInd).Name Then
cmbDataset.AddItem gMap.Datasets(i).Name
End If
Next
If cmbDataset.ListCount = 1 Then
' i = MsgBox("This layer has no datasets bound to it.", vbOKOnly, "Label Properties")
' Exit Sub
cmbDataset.ListIndex = 0
Else
cmbDataset.ListIndex = 1
End If
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 cmbDataset_Click()
If cmbDataset.ListIndex = iCurDS Then
Exit Sub
End If
iCurDS = cmbDataset.ListIndex
FillFields iCurDS
End Sub
Private Sub cmdCancel_Click()
Hide
End Sub
Private Sub cmdFontStyle_Click()
dlgFont.FontBold = lStyle.Bold
dlgFont.FontItalic = lStyle.Italic
dlgFont.FontName = lStyle.Name
dlgFont.FontSize = lStyle.Size
dlgFont.FontStrikethru = lStyle.Strikethrough
dlgFont.FontUnderline = lStyle.Underline
dlgFont.Flags = cdlCFBoth
dlgFont.ShowFont
If dlgFont.CancelError Then
Exit Sub
End If
lStyle.Bold = dlgFont.FontBold
lStyle.Italic = dlgFont.FontItalic
lStyle.Name = dlgFont.FontName
lStyle.Size = dlgFont.FontSize
lStyle.Strikethrough = dlgFont.FontStrikethru
lStyle.Underline = dlgFont.FontUnderline
Set cmdFontStyle.Font = lStyle
End Sub
Private Sub cmdOk_Click()
Dim sField As String, i As Integer
Set ld(iInd).LabelProp.Style = lStyle
For i = 1 To 9
If rPosition(i).Value <> 0 Then
ld(iInd).LabelProp.Orientation = i
Exit For
End If
Next
ld(iInd).LabelProp.DataSet = cmbDataset.ListIndex
ld(iInd).LabelProp.Field = cmbField.ListIndex
ld(iInd).LabelProp.Parallel = (ckParallel.Value = 1)
ld(iInd).LabelChanged = True
Hide
End Sub
Private Sub rPosition_Click(Index As Integer)
Dim i As Integer
For i = 1 To 9
If i <> Index Then
rPosition(i).Value = 0
End If
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -