frmmain.frm

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

VERSION 5.00
Object = "{02BEE3A6-4264-45B0-93C8-76FBBA329150}#5.2#0"; "SuperLegend.ocx"
Object = "{A61255F7-0A20-431C-86CE-78C14314BE9E}#5.2#0"; "SuperWkspManager.ocx"
Object = "{03ED3B1E-ED1B-4A2E-8FE3-D8D1A673F5D4}#5.2#0"; "SuperMap.ocx"
Begin VB.Form frmMain 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "绘制图例范例"
   ClientHeight    =   6405
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8985
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6405
   ScaleWidth      =   8985
   StartUpPosition =   2  'CenterScreen
   Begin SuperWkspManagerLib.SuperWkspManager SuperWkspManager1 
      Height          =   3015
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   2175
      _Version        =   327682
      _ExtentX        =   3836
      _ExtentY        =   5318
      _StockProps     =   0
   End
   Begin SuperLegendLib.SuperLegend SuperLegend1 
      Height          =   3255
      Left            =   0
      TabIndex        =   1
      Top             =   3120
      Width           =   2175
      _Version        =   327682
      _ExtentX        =   3836
      _ExtentY        =   5741
      _StockProps     =   132
   End
   Begin SuperMapLib.SuperWorkspace SuperWorkspace1 
      Left            =   960
      Top             =   3240
      _Version        =   327682
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
   End
   Begin SuperMapLib.SuperMap SuperMap1 
      Height          =   6255
      Left            =   2280
      TabIndex        =   0
      Top             =   120
      Width           =   6615
      _Version        =   327682
      _ExtentX        =   11668
      _ExtentY        =   11033
      _StockProps     =   160
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=====================================SuperMap Objects示范工程说明=======================================
'
'功能简介：示范自己来更换SuperLegend的节点图标，并把SuperLegend的节点绘制到SuperMap上
'所用控件：SueprMap控件、SuperWorkspace控件、SuperWkspManager和SuperLegend控件
'所用数据：..\Data\world\World.sdb和World.sdd两个文件
'操作说明：
'        1、运行后可以看到SuperLegend的第二个图标给修改成自己的图标了
'        2、运行后可以看到SuperMap控件的左上角绘制了一个图例，对SuperMap进行平移后这个图
'           会自动再绘制上去。
'
'===================================SuperMap Objects示范工程说明结束=====================================


Option Explicit
Dim nCols As Integer
Dim nDC As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Form_Load()
    SuperWkspManager1.Connect SuperWorkspace1.Handle
    SuperMap1.Connect SuperWorkspace1.Handle
    SuperLegend1.Connect SuperMap1.Handle
    SuperWorkspace1.Open App.Path & "\..\data\world\WorldMap.smw"
    SuperMap1.OpenMap SuperWorkspace1.Maps(1)
    SuperMap1.Refresh
    SuperWkspManager1.Refresh
    SuperLegend1.Refresh
    SuperMap1.Action = scaPan
    nDC = GetDC(SuperMap1.hwnd)
End Sub

Private Sub Form_Unload(Cancel As Integer)
    SuperLegend1.Disconnect
    SuperWkspManager1.Disconnect
    SuperMap1.Close
    SuperMap1.Disconnect
    SuperWorkspace1.Close
End Sub

Private Sub SuperLegend1_AfterRefresh()
    SuperLegend1.TreeView.ImageList.Replace 2, App.Path & "\Wzedit.bmp"
    nCols = 0
    DrawLegend SuperLegend1.TreeView.Nodes
End Sub

Private Sub SuperLegend1_Modified()
    SuperMap1.Refresh
End Sub

Private Sub SuperMap1_AfterMapDraw(ByVal hdc As stdole.OLE_HANDLE)
    nCols = 0
    DrawLegend SuperLegend1.TreeView.Nodes
End Sub

Private Sub SuperWkspManager1_AfterRefresh()
    SuperWkspManager1.TreeView(1).ImageList.Replace SuperWkspManager1.TreeView(1).Nodes.Item(1).Image, App.Path & "\temp.ico"
End Sub

Private Sub DrawLegend(objNodes As soTreeNodes)
    Dim i As Integer
    For i = 1 To objNodes.Count
        Dim objNode As soTreeNode
        Dim objImageList As soImageList
        Set objNode = objNodes.Item(i)
        Set objImageList = objNode.CreateDragImage
        If Not objImageList Is Nothing Then
            objImageList.Draw nDC, 1, 0, nCols * 16
        Else
            Debug.Print "nothing"
        End If
        nCols = nCols + 1
        Set objImageList = Nothing
        DrawLegend objNode.Nodes
    Next i
End Sub