基于云计算的智能交通系统核心代码

1、基于云计算的智能交通系统核心代码1、顶层，数据图像，通信Attribute VB_Name = modDefinitionPublic Const NoneRenderer = -1Public Const ClassRenderer = 0Public Const ValueRenderer = 1Public Const LabelRenderer = 2Public Const DocMax = 20Public Const PicMax = 20Public Enum SearchTYPE byPoint = 0 byCircle = 1 byPolygon = 2 byRectang

2、le = 3 byExpression = 4End EnumPublic Enum ModifyTYPE Add = 0 Del = 1 Edit = 2 Move = 3End EnumPublic Type RGBColor Red As Integer Green As Integer Blue As IntegerEnd TypePrivate Type DocDef strName As String strPath As StringEnd Type最大图层数Public Const CusLayerMax = 100每层允许最大数据连接数Public Const CusRela

3、tionMax = 10每层允许最大隐藏字段数Public Const HideFieldMax = 10最大分组数Public Const LayerGroupMax = 10每组允许包含图层数Public Const LayerGroupContentMax = 20数据连接Public Type CusRelations 源表中的键，默认为sid FromField As String 数据库名（或xBase数据库目录） Database As String 表名 Table As String 目标表中的键，默认为sid ToField As StringEnd Type 图层信息结构

4、Public Type CusLayer 图层名 strName As String 图层文件的路径 strPath As String 标注所依据的字段 strLabelField As String 隐藏字段信息 HideField(0 To HideFieldMax) As String 隐藏字段数 HideFieldCount As Long 数据连接信息 Relation(0 To CusRelationMax) As CusRelations 数据连接数 RelationCount As Long 图片字段 PictureField As String 其它数据连接 MultiRe

5、late As CusRelations 是否显示标注 bVisibleOfLabel As Boolean 是否显示在图例中 bVisibleInTreeview As Boolean 图层是否可编辑 bEditable As Boolean 数据是否可视 bVisibleOfData As Boolean End Type图层分组信息结构Type cusLayerGroup 组名 strGroupName As String 组中所有层的索引 lLayerIndex(0 To LayerGroupContentMax) As Long 组中所有层的层名 llayerName(0 To La

6、yerGroupContentMax) As String 组中所有层数 lLayerCount As Long End TypePublic CustomLayers(0 To CusLayerMax) As CusLayerPublic CustomLayerCount As LongPublic LayerGroup(0 To LayerGroupMax) As cusLayerGroupPublic LayerGroupCount As LongPublic bIsDbaseDatabase As BooleanPublic bIsConfig As BooleanPublic str

7、FunName As String 现在正在进行的操作，(根据frmMain中activebar中的按钮状态确定)Public RecModify As MapObjects2.Recordset the Recordset which will be changedPublic RecQuery As MapObjects2.Recordset the Recordset which was the Result of a queryPublic g_searchSet As MapObjects2.RecordsetPublic g_searchShape As Object the Sh

8、ape which the recQuery will be generated byPublic g_searchExpression As String Search ExpressionPublic g_HighlightShape As ObjectPublic g_HighlightSymbol As New SymbolPublic Partition As SinglePublic ActiveLayer As LongPublic m_mapTip As New MapTipPublic bLocked As BooleanPublic LastExtent As New Ma

9、pObjects2.RectanglePublic NextExtent As New MapObjects2.Rectangle-Definitions Below is the Arguments which can be changed by UserThese Arguments set the Environment of ProMap-Public Search_PointTolerance As Long the tolerance of point used by SearchMethodPublic Search_MaxResult As Long the max searc

10、h results quantity,if exceed,then ask user whether to displayPublic Color_HighLight As LongPublic Color_RecQuery As Long2、图像处理：Attribute VB_Name = modIconPublic Function fnGenerateIcon(strKey As String, LayerX As MapLayer) As BooleanDim lpointer As LongDim ImageX As ListImage清除Picture控件中已有的图像frmMain

11、.Picture1.Cls清除ImageList空间中已有的图标For Each ImageX In frmLayer.LayerIcon.ListImages If ImageX.Key = strKey Then frmLayer.LayerIcon.ListImages.Remove ImageX.Index Exit For End IfNextSelect Case LayerX.shapeType Case moShapeTypeLine 线状地理对象 Call DrawLine(LayerX.Symbol.Color) Case moShapeTypePoint 点状地理对象 C

12、all DrawCircle(LayerX.Symbol.Color) Case moshapetypePoints 点状地理对象 Call DrawCircle(LayerX.Symbol.Color) Case Else 多边形地理对象 If LayerX.Renderer Is Nothing Then 无任何Renderer，显示单一颜色矩形作为图标 Call DrawRect(LayerX.Symbol.Color) Else If TypeOf LayerX.Renderer Is MapObjects2.ClassBreaksRenderer Then ClassBreak Re

13、nderer，使用颜色渐变的矩形作为图标 Dim ClassBreakX As ClassBreaksRenderer Set ClassBreakX = LayerX.Renderer Dim lp As Long For lp = 0 To 15 frmMain.Picture1.Line (lp, 0)-(lp, 15), RGB(lp * 16, 64 + lp * 12, 128 + lp * 8) Next lp ElseIf TypeOf LayerX.Renderer Is MapObjects2.LabelRenderer Then Label Renderer，使用带有文字

14、“A”的矩形作为图标 Dim LabelX As LabelRenderer Set LabelX = LayerX.Renderer Call DrawRect(LayerX.Symbol.Color) frmMain.Picture1.Line (8, 3)-(5, 11), lcolor frmMain.Picture1.Line (8, 3)-(11, 11), lcolor frmMain.Picture1.Line (7, 8)-(10, 8), lcolor ElseIf TypeOf LayerX.Renderer Is MapObjects2.ValueMapRenderer

15、 Then ValueMap Renderer，使用四个不同色块组成的矩形作为图标 frmMain.Picture1.FillStyle = 0 frmMain.Picture1.Line (2, 3)-(13, 11), RGB(0, 0, 0), B frmMain.Picture1.Line (3, 4)-(4, 10), RGB(255, 255, 255), BF frmMain.Picture1.Line (5, 4)-(6, 10), RGB(255, 0, 0), BF frmMain.Picture1.Line (7, 4)-(8, 10), RGB(0, 0, 255),

16、BF frmMain.Picture1.Line (9, 4)-(10, 10), RGB(0, 255, 0), BF frmMain.Picture1.Line (11, 4)-(12, 10), RGB(255, 255, 0), BF Else 其它，显示单一颜色矩形作为图标 Call DrawRect(LayerX.Symbol.Color) End If End IfEnd Select保存PictureBox中图标到临时文件SavePicture frmMain.Picture1.Image, App.Path & Point.bmp将文件中图标存放在ImageList中等待调用

17、frmLayer.LayerIcon.ListImages.Add , strKey, LoadPicture(App.Path & Point.bmp)删除临时文件Kill App.Path & Point.bmpEnd FunctionPrivate Sub DrawLine(lcolor As Long) 画线 frmMain.Picture1.Line (0, 0)-(6, 12), lcolor frmMain.Picture1.Line (6, 12)-(8, 3), lcolor frmMain.Picture1.Line (8, 3)-(15, 15), lcolorEnd S

18、ubPrivate Sub DrawCircle(lcolor As Long) 画圆点 frmMain.Picture1.FillColor = lcolor frmMain.Picture1.FillStyle = 0 frmMain.Picture1.Circle (8, 8), 3, lcolorEnd SubPrivate Sub DrawRect(lcolor As Long) 画矩形 frmMain.Picture1.FillColor = lcolor frmMain.Picture1.FillStyle = 0 frmMain.Picture1.Line (2, 3)-(13

19、, 11), RGB(0, 0, 0), BEnd Sub3、显示Attribute VB_Name = ModQuestFunction fnLocatePointInRecEx(x As Single, Y As Single) As Boolean判定当前图层指定点附近是否有几何对象若存在,则将数据游标指向这条记录If RecModify Is Nothing Then fnLocatePointInRecEx = False Exit FunctionEnd IfDim PointX As MapObjects2.POINTPointX.x = xPointX.Y = YRecModi

20、fy.MoveFirstIf RecModify.EOF Then fnLocatePointInRecEx = False Exit FunctionEnd IfDim sNearestDistance As SingleDim lSeek As LonglSeek = 0Dim lpointer As Longlpointer = 0sNearestDistance = PointX.DistanceTo(RecModify.Fields(Shape).Value)Do Until RecordX.EOF 逐一判断是否满足条件 If PointX.DistanceTo(RecModify.

21、Fields(Shape).Value) sNearestDistance Then If PointX.DistanceTo(RecModify.Fields(Shape).Value) frmMain.Map1.ToMapDistance(100) Then 不存在满足条件的记录 fnLocatePointInRecEx = False Exit FunctionEnd IfRecModify.MoveFirstFor lpointer = 1 To lSeek RecModify.MoveNext DoEventsNext lpointerfnLocatePointInRecEx = T

22、rueEnd FunctionFunction fnLocatePointInRec(x As Single, Y As Single, Optional bIsPolygon As Boolean = False) As Boolean判定当前图层指定点附近是否有几何对象若存在,则将数据游标指向这条记录If RecModify Is Nothing Then fnLocatePointInRec = False Exit FunctionEnd IfDim PotX As New MapObjects2.POINTDim PolygonX As MapObjects2.PolygonSet PotX = frmMain.Map1.ToMapPoint(x, Y)RecModify.