📄 frmgps_jc.frm
字号:
End If
'定位该对象在表中记录位置
MapInfo.do "Fetch Rec " & I + 1 & " From selection"
Next
MapInfo.do "Set Style Brush MakeBrush(1,8421504,14737632)"
Me.Text2.Text = "当前GPS终端号(" & Me.Combo1.Text & ")要求巡检设备线路" _
& EquipmentCount & "条，共巡检" & n & "条，巡检结果详见明细。"
'''''###############刘登杰----06年1月
'添加可视化功能：在巡检缓冲区内的用一种符号标识
'不在的用另一种符号标识 （用颜色区分）
'''''###############刘登杰----06年1月
ElseIf Me.Option1(2).Value = True Then
''################刘 杰
On Error GoTo Error1 '添加容错处理
''################刘 杰
'3)缓冲区域与巡检设备面的叠加重合度
MapInfo.do "select * from " & SearchTable & " into selection"
lngSelectCount = Val(MapInfo.Eval("SelectionInfo(3)"))
'应该是对每个对象进行缓冲在进行叠加
MapInfo.do "Fetch First From Selection"
For I = 1 To lngSelectCount
'巡检设备的缓冲
MapInfo.do "OBJ_Temp1=Selection.OBJ"
'MapInfo.Do ("OBJ_Buffer1=Buffer(OBJ_Temp1,20," & mBufferDistince & ",""m"")")
'MapInfo.Do "Insert Into " & TableName & "(Object) values (OBJ_Buffer1)"
'求重合度
MapInfo.do ("OBJ_Intersect=Overlap( OBJ_Buffer,OBJ_Temp1)")
dArea1 = MapInfo.Eval("Area(OBJ_Intersect,""sq km"")")
dArea2 = MapInfo.Eval("Area(OBJ_Temp1,""sq km"")") '设备面
If dArea1 > 0 Then
MapInfo.do "Set Style Brush MakeBrush(5,8421504,14737632)"
MapInfo.do "Insert Into " & TableName & "(Object) values (OBJ_Intersect)"
MapInfo.do "Set Style Brush MakeBrush(1,8421504,14737632)"
'根据设备号判别巡检的设备
For j = 1 To EquipmentCount
iEquipmentID = MapInfo.Eval(SearchTable & ".设备号")
If UCase$(iEquipmentID) = ListView2.ListItems(j).SubItems(1) Then
n = n + 1
ListView2.ListItems(j).SubItems(3) = "重合度:" & Format(dArea1 / dArea2 * 100, "#.##") & "%"
Exit For
End If
Next
End If
'定位该对象在表中记录位置
MapInfo.do "Fetch Rec " & I + 1 & " From selection"
Next
MapInfo.do "Set Style Brush MakeBrush(1,8421504,14737632)"
Me.Text2.Text = "当前GPS终端号(" & Me.Combo1.Text & ")要求巡检设备面" _
& EquipmentCount & "个，共巡检" & n & "个，巡检结果详见明细。"
'''''###############刘登杰----06年1月
'添加可视化功能：在巡检缓冲区内的用一种符号标识
'不在的用另一种符号标识 （用颜色区分）
'''''###############刘登杰----06年1月
End If
'保存表
' SaveTable TableName
'显示范围：临时层
MapInfo.do "Set Map Zoom Entire Layer " & TableName
Command7.Enabled = True
''################### 刘登杰 于2005年11月27
' bShowTrackLine = False'去掉该语句可以使一次显示轨迹，多次分析
Exit Sub '退出程序，以免进入错误处理
Error1:
MsgBox "指定设备样式与实际图元类型不符合，请检查更正！", vbOKOnly, "提示"
'退出时系统自动删除临时层后保存
'清除巡检路线
TableName = "tmpTrack"
If IsOpenTable(TableName) Then
'删除临时表的记录
MapInfo.do "delete from " & TableName
SaveTable TableName
MapInfo.do "Pack Table " & TableName & " Graphic Data"
bShowTrackLine = False
End If
Exit Sub
''################### 刘登杰 于2005年11月27
End Sub
Private Sub Command7_Click()
'生成报告
Dim sReportCode As String
Dim sStartTime As String, sEndTime As String
Dim sDate1, sTime1 As String, sDate2, sTime2 As String
Dim sGpsID As String, nPts As Long
Dim sReoprtResult As String
Dim I As Integer, cou As Integer
Dim iEquipmentID As Integer, sEquipmentName As String
Dim sState As String
Dim dCenterX As Double, dCenterY As Double
Dim strSql As String, strSql2 As String
sReoprtResult = Me.Text2.Text
If sReoprtResult = "" Then
MsgBox "没有巡检结果内容，无法生成巡检报告！", vbInformation, "提示"
Exit Sub
End If
sGpsID = Me.Combo1.Text
nPts = Me.ListView1.ListItems.Count
sStartTime = Me.ListView1.ListItems(1).SubItems(3)
sDate1 = Format(sStartTime, "YYMMDD")
sTime1 = Format(sStartTime, "HHMM")
sEndTime = Me.ListView1.ListItems(nPts).SubItems(3)
sDate2 = Format(sEndTime, "YYMMDD")
sTime2 = Format(sEndTime, "HHMM")
sReportCode = sGpsID & "-" & sDate1 & sTime1 & "-" & sDate2 & sTime2
'写入报告主表
Set rs = Nothing
strSql = "select * from tbl_Gps_CheckReport where ReportCode='" & sReportCode & "'"
rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
If rs.RecordCount > 0 Then
If MsgBox("已经存在当前的巡检报告，是否要重新写入报告？", vbYesNo, "提示") = vbYes Then
rs.Delete adAffectCurrent
rs.AddNew
rs.Fields("ReportCode").Value = sReportCode
rs.Fields("GpsID").Value = sGpsID
rs.Fields("StartTime").Value = sStartTime
rs.Fields("EndTime").Value = sEndTime
rs.Fields("CheckResult").Value = sReoprtResult
rs.Update
Else
rs.Close
Exit Sub
End If
Else
rs.AddNew
rs.Fields("ReportCode").Value = sReportCode
rs.Fields("GpsID").Value = sGpsID
rs.Fields("StartTime").Value = sStartTime
rs.Fields("EndTime").Value = sEndTime
rs.Fields("CheckResult").Value = sReoprtResult
rs.Update
End If
rs.Close
'写入报告明细表
cou = Me.ListView2.ListItems.Count
For I = 1 To cou
iEquipmentID = Me.ListView2.ListItems(I).SubItems(1)
sEquipmentName = Me.ListView2.ListItems(I).SubItems(2)
sState = Me.ListView2.ListItems(I).SubItems(3)
Set rs = Nothing
strSql = "select * from tbl_Gps_CheckReport_list where ReportCode='" & sReportCode & "' and EquipmentID=" & iEquipmentID
rs.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
If rs.RecordCount > 0 Then
rs.Delete adAffectCurrent
'----------------------
'提取设备的资料
Set rs2 = Nothing
strSql2 = "select * from tbl_Equipment where EquipmentID=" & iEquipmentID
rs2.Open strSql2, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
If rs2.RecordCount > 0 Then
dCenterX = rs2("Center_X")
dCenterY = rs2("Center_Y")
Else
dCenterX = 0
dCenterX = 0
End If
rs2.Close
'----------------------
rs.AddNew
rs.Fields("ReportCode").Value = sReportCode
rs.Fields("GpsID").Value = sGpsID
rs.Fields("EquipmentID").Value = iEquipmentID
rs.Fields("Name").Value = sEquipmentName
rs.Fields("Center_X").Value = dCenterX
rs.Fields("Center_Y").Value = dCenterY
rs.Fields("State").Value = sState
rs.Update
Else
'----------------------
'提取设备的资料
Set rs2 = Nothing
strSql2 = "select * from tbl_Equipment where EquipmentID=" & iEquipmentID
rs2.Open strSql2, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
If rs2.RecordCount > 0 Then
dCenterX = rs2("Center_X")
dCenterY = rs2("Center_Y")
Else
dCenterX = 0
dCenterX = 0
End If
rs2.Close
'----------------------
rs.AddNew
rs.Fields("ReportCode").Value = sReportCode
rs.Fields("GpsID").Value = sGpsID
rs.Fields("EquipmentID").Value = iEquipmentID
rs.Fields("Name").Value = sEquipmentName
rs.Fields("Center_X").Value = dCenterX
rs.Fields("Center_Y").Value = dCenterY
rs.Fields("State").Value = sState
rs.Update
End If
rs.Close
Next
Command7.Enabled = False
MsgBox "生成巡检报告完毕，并且写入报告库！", vbInformation, "提示"
End Sub
Private Sub Form_Load()
''################刘登杰
bchuli = False
bShowTrackLine = False
gramgps = True
'MDIFrmMain.mnu7000_7001.Enabled = False '不可操作garmain
''因为公用一个临时文件，设置为一次只能进行一个操作
''################刘登杰
With Me.ListView1
.ColumnHeaders.Add , , "点号", 600, 0
.ColumnHeaders.Add , , "经度", 1800, 2
.ColumnHeaders.Add , , "纬度", 1800, 2
.ColumnHeaders.Add , , "接收时间", 1900, 2
.View = lvwReport
End With
With Me.ListView2
.ColumnHeaders.Add , , "序号", 600, 0
.ColumnHeaders.Add , , "设备号", 1000, 2
.ColumnHeaders.Add , , "设备名称", 2000, 2
.ColumnHeaders.Add , , "分析结果", 1600, 2
.View = lvwReport
End With
'加载GPSID
Load_GpsID rs, Me.Combo1
'加载巡检目标图层（从绑定表中提取）
Get_DestinationTableName Me.Combo2
If Me.Combo2.ListCount > 0 Then Me.Combo2.Text = Me.Combo2.List(0)
'默认缓冲半径
Me.NumericText1.pText = 30
Me.Command7.Enabled = False
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState = 1 Then Exit Sub
Me.Width = 13815
Me.Height = 10110
End Sub
Private Sub Form_Unload(Cancel As Integer)
''##############刘登杰
bchuli = False '重置，始下一次处理操作提示先处理
bShowTrackLine = False
gramgps = False
''##############刘登杰
'退出时系统自动删除临时层后保存
'清除巡检路线
TableName = "tmpTrack"
If IsOpenTable(TableName) Then
'删除临时表的记录
MapInfo.do "delete from " & TableName
SaveTable TableName
MapInfo.do "Pack Table " & TableName & " Graphic Data"
End If
Cancel = 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -