📄 pageappearance.frm
字号:
VERSION 5.00
Begin VB.Form frmPageAppearance
Caption = "Set Page Appearance"
ClientHeight = 2670
ClientLeft = 60
ClientTop = 345
ClientWidth = 8010
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2670
ScaleWidth = 8010
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkShowPrintableArea
Caption = "Show Printable Area"
Height = 255
Left = 5880
TabIndex = 13
Top = 2280
Value = 1 'Checked
Width = 2175
End
Begin VB.Frame Frame1
Caption = "How to apply symbol"
Height = 1215
Left = 5880
TabIndex = 8
Top = 720
Width = 2055
Begin VB.OptionButton optIPropertySupport
Caption = "IPropertySupport"
Height = 255
Left = 0
TabIndex = 11
Top = 840
Width = 1935
End
Begin VB.OptionButton optIFrameProperties
Caption = "IFrameProperties"
Height = 255
Left = 0
TabIndex = 10
Top = 540
Width = 1935
End
Begin VB.OptionButton optIPage
Caption = "IPage "
Height = 255
Left = 0
TabIndex = 9
Top = 240
Value = -1 'True
Width = 1575
End
End
Begin VB.ListBox List1
Height = 1815
Index = 3
Left = 4320
TabIndex = 3
Top = 720
Width = 1455
End
Begin VB.ListBox List1
Height = 1815
Index = 2
Left = 2880
TabIndex = 2
Top = 720
Width = 1455
End
Begin VB.ListBox List1
Height = 1815
Index = 1
Left = 1440
TabIndex = 1
Top = 720
Width = 1455
End
Begin VB.ListBox List1
Height = 1815
Index = 0
Left = 0
TabIndex = 0
Top = 720
Width = 1455
End
Begin VB.Label Label5
Caption = "Symbols from Style Classes (double click a on a symbol to apply it to the page):"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Left = 0
TabIndex = 12
Top = 120
Width = 6855
End
Begin VB.Label Label4
Caption = "Shadow"
Height = 255
Left = 4320
TabIndex = 7
Top = 480
Width = 1455
End
Begin VB.Label Label3
Caption = "Colors"
Height = 255
Left = 2880
TabIndex = 6
Top = 480
Width = 1335
End
Begin VB.Label Label2
Caption = "Backgrounds"
Height = 255
Left = 1440
TabIndex = 5
Top = 480
Width = 1455
End
Begin VB.Label Label1
Caption = "Borders"
Height = 255
Left = 0
TabIndex = 4
Top = 480
Width = 1455
End
End
Attribute VB_Name = "frmPageAppearance"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim m_pStylesArray(0 To 3) As IArray
Dim m_pStyleGallery As IStyleGallery
Private Sub chkShowPrintableArea_Click()
'Toggle whether the printable area is visible
frmMDIPageLayout.esriCarto.Page.IsPrintableAreaVisible = (chkShowPrintableArea.Value = vbChecked)
End Sub
'--------------------------------------------------------------------------------------------------
'
'Private Sub cmdReset_Click()
'
' 'Replace the PageLayout object to reset all the changed values
' Set PageLayoutControl1.PageLayout = New PageLayout
' chkShowPrintableArea.Value = vbChecked
'
'End Sub
'--------------------------------------------------------------------------------------------------
Private Sub Form_Load()
UpdateArrayAndListBoxFromStyleGallery "Borders", m_pStylesArray(0), List1(0)
UpdateArrayAndListBoxFromStyleGallery "Backgrounds", m_pStylesArray(1), List1(1)
UpdateArrayAndListBoxFromStyleGallery "Colors", m_pStylesArray(2), List1(2)
UpdateArrayAndListBoxFromStyleGallery "Shadows", m_pStylesArray(3), List1(3)
End Sub
Private Sub List1_DblClick(Index As Integer)
'Get IUnknown interface of symbol from the array
Dim pSymbol As IUnknown
Set pSymbol = m_pStylesArray(Index).Element(List1(Index).ListIndex)
'Get IPage interface
Dim pPage As IPage
Set pPage = frmMDIPageLayout.esriCarto.Page
'Apply the symbol as a property to the page
If optIPropertySupport.Value Then
'Query interface for IPropertySupport
Dim pPropertySupport As IPropertySupport
Set pPropertySupport = pPage
'If the symbol can be applied
If pPropertySupport.CanApply(pSymbol) Then
'Apply the object
pPropertySupport.Apply pSymbol
Else
MsgBox "Unable to apply this symbol!"
End If
End If
'Apply the symbol as an IFrameProperties property
If optIFrameProperties.Value Then
'Query interface for IFrameProperties
Dim pFrameProperties As IFrameProperties
Set pFrameProperties = pPage
Select Case Index
Case 0 'Update border
pFrameProperties.Border = pSymbol
Case 1 'Update background
pFrameProperties.Background = pSymbol
Case 2 'Update background color
MsgBox "There is no colour property on IFrameProperties!"
Case 3 'Update shadow
pFrameProperties.Shadow = pSymbol
End Select
End If
'Apply the symbol as an IPage property
If optIPage.Value Then
Select Case Index
Case 0 'Update border
pPage.Border = pSymbol
Case 1 'Update background
pPage.Background = pSymbol
Case 2 'Update background color
pPage.backgroundColor = pSymbol
Case 3 'Update shadow
MsgBox "There is no shadow property on IPage!"
End Select
End If
'Refresh
frmMDIPageLayout.esriArcCatalogUI.refresh esriViewBackground
End Sub
Public Sub UpdateArrayAndListBoxFromStyleGallery(styleClass As String, ByRef pArray As IArray, ByRef pListBox As ListBox)
'Get IStyleGalleryClass interface
Dim pStyleClass As IStyleGalleryClass
'If the StyleGallery hasn't been used before
If m_pStyleGallery Is Nothing Then
'Set m_pStyleGallery = New StyleGallery
End If
'Get IEnumStyleGalleryItem interface and retrieve all stles within the class
Dim pEnumStyleGallery As IEnumStyleGalleryItem
Set pEnumStyleGallery = m_pStyleGallery.Items(styleClass, "ESRI.style", "")
pEnumStyleGallery.Reset
'Create a new array
Set pArray = New esriSystem.Array
'Clear out the list box
pListBox.Clear
'Get IStyleGalleryItem interface
Dim pStyleItem As IStyleGalleryItem
Set pStyleItem = pEnumStyleGallery.Next
'Loop through the style gallery items
Do While Not pStyleItem Is Nothing
'Add the style to the array
pArray.Add pStyleItem.Item
'Add the style name to the list box
pListBox.AddItem pStyleItem.name
Set pStyleItem = pEnumStyleGallery.Next
Loop
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -