frmlayout.frm

都是基于VB所做的程序集合,值得大家作为实践的参考资料.

'         例程序中用到了该控件的大部分属性方法和事件，为初学者提供了很好的教程。
'
'===================================SuperMap Objects示范工程说明结束=========================================
Option Explicit
Dim iLayouts As Integer                      '定义指向工作空间布局对象的变量
Dim bOpen As Boolean

Public Sub OnToolBar(i As Integer)
    Select Case i
        Case 1
            SuperLayout.Elements.RemoveAll      '新建布局
            SuperLayout.Refresh
        Case 2
            mnuFileOpen_Click                   '打开工作空间
        Case 3
            mnuFileSave_Click                   '保存工作空间
        Case 5
            mnuEditCut_Click                    '剪切
        Case 6
            mnuEditCopy_Click                   '复制
        Case 7
            mnuEditPaste_Click                  '粘贴
        Case 9
            mnuFilePrint_Click                  '打印
        Case 11
            mnuDrawSelect_Click                 '选择
        Case 12
            mnuDrawLine_Click                   '画直线
        Case 13
            mnuDrawArc_Click                    '画弧线
        Case 14
            mnuDrawPolyline_Click               '画折线
        Case 15
            mnuDrawRect_Click                   '画矩形
        Case 16
            mnuDrawRoundRect_Click              '画圆角矩形
        Case 17
            mnuDrawEllipse_Click                '画椭圆形
        Case 18
            mnuDrawPolygon_Click                '画多边形
        Case 19
            mnuDrawText_Click                   '画文字注释
        Case 20
            mnuDrawMap_Click                    '画地图
        Case 21
            mnuDrawGrid_Click                   '画格网
        Case 22
            mnuDrawTpl_Click                    '画模板
        Case 23
            mnuDrawArtText_Click                '画艺术字
        Case 24
            mnuDrawLengend_Click                '画图例
        Case 25
            mnuDrawDirection_Click              '画指北针
        Case 26
            mnuDrawScale_Click                  '画比例尺
        Case 27
            mnuOperZoomIn_Click                 '放大布局
        Case 28
            mnuOperZoomOut_Click                '缩小布局
        Case 29
            mnuOperPalm_Click                   '漫游布局
        Case 32
            mnuAboutCmd_Click                   '关于
    End Select
End Sub
Public Sub OnToolBarLytMap(i As Integer)
    Select Case i
        Case 1                                      '地图锁定
            mnuMapHold_Click
        Case 3                                      '放大地图
            mnuMapZoomIn_Click
        Case 4                                      '缩小地图
            mnuMapZoomOut_Click
        Case 5                                      '自由缩放
            mnuMapZoomFree_Click
        Case 6                                      '漫游
            mnuMapPalm_Click
        Case 8                                      '全图显示
            mnuMapViewEntire_Click
    End Select
End Sub
Public Sub OnToolBarLytFormat(i As Integer)
    Select Case i
        Case 1                                      '属性
            mnuObjProperty_Click
        Case 3                                      'alignleft左对齐
            mnuAlignLeft_Click
        Case 4                                      'alignright
            mnuAlignRight_Click
        Case 5                                      'aligntop
            mnuAlignTop_Click
        Case 6                                      'alignbottom
            mnuAlignBottom_Click
        Case 8                                      'aligngrid
            mnuObjGrid_Click
        Case 10                                     '水平等距
            mnuSpaceAcross_Click
        Case 11                                     '垂直等距
            mnuSpaceDown_Click
        Case 13                                     '等高
            mnuSameHeight_Click
        Case 14                                     '等宽
            mnuSameWidth_Click
        Case 15                                     '等大小
            mnuSameSize_Click
        Case 17                                     '水平居中
            mnuCenterHorizon_Click
        Case 18                                     '垂直居中
            mnuCenterVert_Click
        Case 19                                     '居中
            mnuCenterBoth_Click
        Case 21                                     '后移一位
            mnuObjMoveBackward_Click
        Case 22                                     '前移一位
            mnuObjMoveForward_Click
        Case 24                                     '组合
            mnuObjGroup_Click
        Case 25                                     '拆分
            mnuObjUnGroup_Click
    End Select

End Sub

'删除工作空间中的所有布局，但要保存工作空间才有效
Private Sub CmdDelectAll_Click()
    If iLayouts = 0 Then Exit Sub
    SuperLayout.Elements.RemoveAll
    SuperWorkspace.Layouts.RemoveAll
    LstLayouts.Clear
    LstLayouts.Refresh
    SuperLayout.Refresh
    iLayouts = LstLayouts.ListCount
End Sub

'删除选中的布局，必须在布局框中有选中的布局对象，但是只有保存了工作空间后才有效
Private Sub CmdDelet_Click()
    If iLayouts = 0 Then Exit Sub
    If LstLayouts.ListIndex < 0 Or LstLayouts.ListIndex >= LstLayouts.ListCount Then Exit Sub
    SuperWorkspace.Layouts.Remove LstLayouts.ListIndex + 1
    LstLayouts.RemoveItem LstLayouts.ListIndex
    LstLayouts.Refresh
    SuperLayout.Refresh
    iLayouts = LstLayouts.ListCount
End Sub

'打开选中的布局，必须在布局框中选中一个对象
Private Sub CmdOpenLayout_Click()
    SuperLayout.Elements.RemoveAll
    SuperLayout.OpenLayout LstLayouts.Text
    SuperLayout.Refresh
End Sub

'保存排版好的布局，别忘了保存工作空间
Private Sub CmdSaveLayout_Click()
    Dim LayoutName As String
    
    LayoutName = Trim(InputBox("请输入保存布局的名称：     ", "保存布局"))
    If LayoutName = "" Then Exit Sub
    If SuperLayout.SaveLayoutAs(LayoutName) = False Then
        MsgBox " 保存布局失败 ！    ", vbInformation, "消息"
    Else
        LstLayouts.AddItem LayoutName
        iLayouts = LstLayouts.ListCount
    End If
End Sub

Private Sub Form_Load()
    bOpen = False
    mnuDrawSelect_Click
End Sub


'布局视图随着显示窗口的尺寸变化而变化，自动调整到适当大小
Private Sub Form_Resize()
    On Error Resume Next
    SuperLayout.Width = Me.ScaleWidth - SuperLayout.Left
    If Me.ScaleHeight - SuperLayout.Top > 0 Then
        SuperLayout.Height = Me.ScaleHeight - SuperLayout.Top
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim objErr As New soError
    On Error GoTo eh
    SuperLayout.Disconnect
eh:
    SuperWorkspace.Close
    Set objErr = Nothing
 End Sub

'“关于”命令是用来显示一对话框来告诉你正在使用SuperMap的版本、版权等各种软件信息。
Private Sub mnuAboutCmd_Click()
    SuperWorkspace.AboutBox
End Sub

'使用“下对齐”命令可以让布局窗口中的选中对象的下边界对齐。
Private Sub mnuAlignBottom_Click()
    SuperLayout.Selection.AlignBottom
End Sub

'使用"左对齐"命令可以让布局窗口中的选中对象的左边界对齐。
Private Sub mnuAlignLeft_Click()
    SuperLayout.Selection.AlignLeft
End Sub

'使用"右对齐"命令可以让布局窗口中的选中对象的右边界对齐。
Private Sub mnuAlignRight_Click()
    SuperLayout.Selection.AlignRight
End Sub

'使用“上对齐”命令可以让布局窗口中的选中对象的上边界对齐。
Private Sub mnuAlignTop_Click()
    SuperLayout.Selection.AlignTop
End Sub


'使用"居中"菜单命令可以让布局窗口中的选中对象位于布局窗口的中央。
Private Sub mnuCenterBoth_Click()
    SuperLayout.Selection.CenterHorizontal
    SuperLayout.Selection.CenterVertical
    SuperLayout.Refresh
End Sub

'使用"水平居中"命令可以让布局窗口中的选中对象水平居中。
Private Sub mnuCenterHorizon_Click()
    SuperLayout.Selection.CenterHorizontal
End Sub

'使用"竖直居中"命令可以让布局窗口中的选中的对象竖直居中。
Private Sub mnuCenterVert_Click()
    SuperLayout.Selection.CenterVertical
End Sub

'使用"圆弧"命令可以访问圆弧工具。使用圆弧工具可以绘制大小和形状为四分之一个椭圆的圆弧。创建圆弧后，
'可以对其整形得到需要的大小。
Private Sub mnuDrawArc_Click()

    SuperLayout.LytAction = sclytActArc
    
    mnuDrawSelect.Checked = False
    mnuOperZoomIn.Checked = False
    mnuOperZoomOut.Checked = False
    mnuOperPalm.Checked = False
    mnuDrawLine.Checked = False
    mnuDrawRect.Checked = False
    mnuDrawRoundRect.Checked = False
    mnuDrawEllipse.Checked = False
    mnuDrawArc.Checked = True
    mnuDrawArtText.Checked = False
    mnuDrawPolygon.Checked = False
    mnuDrawPolyline.Checked = False
    mnuDrawText.Checked = False
    mnuDrawMap.Checked = False
    mnuDrawGrid.Checked = False
    mnuDrawTpl.Checked = False
    mnuDrawLengend.Checked = False
    mnuDrawScale.Checked = False
    mnuDrawDirection.Checked = False
    
    tlbLayout.Buttons.Item(13).Value = tbrPressed
End Sub

'使用“艺术汉字”菜单命令可以在布局窗口加入艺术汉字，增加地图输出的美观性。
Private Sub mnuDrawArtText_Click()
    
    SuperLayout.LytAction = sclytActArtText
    
    mnuDrawSelect.Checked = False
    mnuOperZoomIn.Checked = False
    mnuOperZoomOut.Checked = False
    mnuOperPalm.Checked = False
    mnuDrawLine.Checked = False
    mnuDrawRect.Checked = False
    mnuDrawRoundRect.Checked = False
    mnuDrawEllipse.Checked = False
    mnuDrawArc.Checked = False
    mnuDrawArtText.Checked = True
    mnuDrawPolygon.Checked = False
    mnuDrawPolyline.Checked = False
    mnuDrawText.Checked = False
    mnuDrawMap.Checked = False
    mnuDrawGrid.Checked = False
    mnuDrawTpl.Checked = False
    mnuDrawLengend.Checked = False
    mnuDrawScale.Checked = False
    mnuDrawDirection.Checked = False
    
    tlbLayout.Buttons.Item(23).Value = tbrPressed
End Sub

'使用"方向标"命令是在当前布局窗口中绘制表示方向标志。
Private Sub mnuDrawDirection_Click()
    
    SuperLayout.LytAction = sclytActDirection
    
    mnuDrawSelect.Checked = False
    mnuOperZoomIn.Checked = False
    mnuOperZoomOut.Checked = False
    mnuOperPalm.Checked = False
    mnuDrawLine.Checked = False
    mnuDrawRect.Checked = False
    mnuDrawRoundRect.Checked = False
    mnuDrawEllipse.Checked = False
    mnuDrawArc.Checked = False
    mnuDrawArtText.Checked = False
    mnuDrawPolygon.Checked = False
    mnuDrawPolyline.Checked = False
    mnuDrawText.Checked = False
    mnuDrawMap.Checked = False
    mnuDrawGrid.Checked = False
    mnuDrawTpl.Checked = False
    mnuDrawDirection.Checked = True
    mnuDrawLengend.Checked = False
    mnuDrawScale.Checked = False
    
    
    tlbLayout.Buttons.Item(25).Value = tbrPressed
End Sub

'使用"椭圆"命令