clsblink.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsBlink"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public ctrTimer As Timer                  '闪烁要用的Timer控件
Public objStyle As soStyle                '闪烁风格的对象变量
Public ctrSuperMap As SuperMap            '闪烁对象所在的SuperMap控件
Public dBlinkTimes  As Double             '闪烁的总时间，默认为4秒。每两次闪烁的间隔，用Timer控件的InterVal属性来设定
Public dStartTime As Double               '开始闪烁时的时间
Public objRecordset As soRecordset        '要闪烁的对象的Recordset
Private objGeometry As soGeometry
Public strDtName As String                  '闪烁的对象所在的数据集名称

Public Sub Initialize()
    If dBlinkTimes = 0 Then dBlinkTimes = 4
    If ctrTimer.Interval = 0 Then ctrTimer.Interval = 250
End Sub

Private Sub Class_Terminate()
    Set objStyle = Nothing
    Set ctrSuperMap = Nothing
    Set objRecordset = Nothing
    Set ctrTimer = Nothing
End Sub

Public Sub OnStartBlink()
    Static bTemp As Boolean
    
    ctrSuperMap.TrackingLayer.ClearEvents
    If Timer() > dStartTime + dBlinkTimes Then
        ctrSuperMap.TrackingLayer.Refresh
        ctrSuperMap.Refresh
        ctrTimer.Enabled = False
        Set objGeometry = Nothing
        dStartTime = 0#
        Exit Sub
    End If
    
    If bTemp = True Then
        objRecordset.MoveFirst
        Do Until objRecordset.IsEOF
            Set objGeometry = objRecordset.GetGeometry()
            ctrSuperMap.TrackingLayer.AddEvent objGeometry, objStyle, ""
            objRecordset.MoveNext
        Loop
    End If
    bTemp = Not bTemp
    ctrSuperMap.TrackingLayer.Refresh
End Sub