📄 mdifrmmain.frm

📁 用VB开发的巡检系统基于MAPINFo用VB开发的巡检系统基于MAPINFo很好的
💻 FRM
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34
'重命名表
MapInfo.RunMenuCommand 410
End Sub

Private Sub mnu5000_5007_Click()
'紧缩表
MapInfo.RunMenuCommand 403
End Sub

Private Sub mnu5000_5008_Click()
'浏览属性表
With frmReadEquipmentData
    .Caption = "浏览属性表"
    .cmdRead.Visible = False
    .Show
End With
End Sub

Private Sub mnu6000_6001_Click()
'线样式...
MapInfo.RunMenuCommand 501
End Sub

Private Sub mnu6000_6002_Click()
'区域样式...
MapInfo.RunMenuCommand 502
End Sub

Private Sub mnu6000_6003_Click()
'符号样式...
MapInfo.RunMenuCommand 503
End Sub

Private Sub mnu6000_6004_Click()
'文本样式...
MapInfo.RunMenuCommand 504
End Sub

Private Sub mnu6000_6005_Click()
'工具条
mnu6000_6005.Checked = Not mnu6000_6005.Checked
tbarMain.Visible = mnu6000_6005.Checked
MapInfo.Do ""
End Sub

Private Sub mnu6000_6006_Click()
'状态栏
mnu6000_6006.Checked = Not mnu6000_6006.Checked
sbStatusBar.Visible = mnu6000_6006.Checked
End Sub


Private Sub mnu6000_6007_Click()
'地图投影
MapInfo.RunMenuCommand M_MAP_OPTIONS '802
End Sub

Private Sub mnu7000_7001_Click()
'巡检数据处理...(Garmin数据文件)


'##########################刘登杰
''因为公用一个临时文件，设置为一次只能进行一个操作

If gramgps = True Then

MsgBox "请先退出GPS数据文件巡检处理或Garmin数据处理已经打开！", vbInformation + vbOKOnly, "提示"
Exit Sub
End If
''因为公用一个临时文件，设置为一次只能进行一个操作
'##########################刘登杰

frmGarmin.Show
End Sub

Private Sub mnu7000_7002_Click()
'巡检数据处理...(Gps监测数据文件)

'##########################刘登杰

''因为公用一个临时文件，设置为一次只能进行一个操作

If gramgps = True Then
MsgBox "请先退出GARMIN数据文件巡检处理或Gps数据处理已经打开！", vbInformation + vbOKOnly, "提示"
Exit Sub
End If
''因为公用一个临时文件，设置为一次只能进行一个操作

'##########################刘登杰


frmGps_JC.Show
End Sub

Private Sub mnu7000_7003_Click()
'打印巡检报告
frmPrint.Show
End Sub

Private Sub mnu7000_7004_Click()
'清除巡检路线
TableName = "tmpTrack"
If Not IsOpenTable(TableName) Then Exit Sub
'删除临时表的记录
MapInfo.Do "delete from " & TableName
SaveTable TableName
MapInfo.Do "Pack Table " & TableName & " Graphic Data"
End Sub

Private Sub mnu8000_8001_Click()
'人员资料管理
frmUserView.Show
End Sub

Private Sub mnu8000_8002_Click()
'GPS终端管理
frmGPS.Show
End Sub

Private Sub mnu8000_8003_Click()
'绑定设备、人员和GPS终端
frmRelation_GPS.Show
End Sub

Private Sub mnu8000_8004_Click()
'制定巡检目标
frmCheckDestination.Show
End Sub

Private Sub mnu8000_8005_Click()
'提取巡检目标信息
With frmReadEquipmentData
    .Caption = "提取巡检目标信息"
    .cmdRead.Visible = True
    .Show
End With
End Sub

Private Sub mnu8000_8006_Click()
'制定巡检方案

End Sub

Private Sub mnu8000_8007_Click()
'设置初始化工作空间
frmSetInitWorkSpace.Show 1
End Sub

Private Sub mnu9000_9001_Click()
'使用手册
If Dir(App.Path + "\使用手册.chm", vbDirectory) = "" Then
  MsgBox "没有找到使用手册！", vbInformation + vbOKOnly, "提示"
Else
  Shell "hh.exe " & App.Path + "\使用手册.chm", vbMaximizedFocus
End If
End Sub

Private Sub mnu9000_9002_Click()
'关于系统
frmAbout.Show 1

'Global Const PEN_WIDTH = 1
'Global Const PEN_PATTERN = 2
'Global Const PEN_COLOR = 4
'Global Const PEN_INDEX = 5
'Global Const PEN_INTERLEAVED = 6

'Global Const BRUSH_PATTERN = 1
'Global Const BRUSH_FORECOLOR = 2
'Global Const BRUSH_BACKCOLOR = 3

'Global Const FONT_NAME = 1
'Global Const FONT_STYLE = 2
'Global Const FONT_POINTSIZE = 3
'Global Const FONT_FORECOLOR = 4
'Global Const FONT_BACKCOLOR = 5

'Global Const SYMBOL_CODE = 1
'Global Const SYMBOL_COLOR = 2
'Global Const SYMBOL_POINTSIZE = 3
'Global Const SYMBOL_ANGLE = 4
'Global Const SYMBOL_FONT_NAME = 5
'Global Const SYMBOL_FONT_STYLE = 6
'Global Const SYMBOL_KIND = 7
'Global Const SYMBOL_CUSTOM_NAME = 8
'Global Const SYMBOL_CUSTOM_STYLE = 9
'Debug.Print MapInfo.eval("StyleAttr(CurrentPen()," & PEN_WIDTH & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentPen()," & PEN_PATTERN & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentPen()," & PEN_COLOR & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentPen()," & PEN_INDEX & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentPen()," & PEN_INTERLEAVED & ")")
'1
'6
'12582912
'Debug.Print MapInfo.Eval("StyleAttr(CurrentBrush()," & BRUSH_PATTERN & ")")
'Debug.Print MapInfo.Eval("StyleAttr(CurrentBrush()," & BRUSH_FORECOLOR & ")")
'Debug.Print MapInfo.Eval("StyleAttr(CurrentBrush()," & BRUSH_BACKCOLOR & ")")
'5
'8421504
'14737632
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_CODE & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_COLOR & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_POINTSIZE & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_ANGLE & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_FONT_NAME & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_FONT_STYLE & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_KIND & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_CUSTOM_NAME & ")")
'Debug.Print MapInfo.eval("StyleAttr(CurrentSymbol()," & SYMBOL_CUSTOM_STYLE & ")")
'35
'7368816
'9
End Sub

Private Sub tbarMain_ButtonClick(ByVal Button As ComctlLib.Button)
    Dim nLayerName As Integer, LayerName As String, Col1 As String, ColN As Integer
    Dim ADType As String, TZBM As String, FileM0 As String
    Dim I As Integer, j As Integer, intPositionOfQuery As Integer, nSelect As Integer
    Dim ThePictureFile As String, ThePicturePath As String, DirFile As String
    Dim Index As Integer, TheXLFileName As String
    Dim FileTIM1 As String, m As Integer, TheOutFileE00 As String
    
    On Error GoTo Error
    
    bExitSub = False
   
    Call SetToolBarValue0
    
    Select Case Button.Key
        Case "Select" '选择
            tbarMain.Buttons("Select").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_SELECTOR '1701
        Case "Move" '移动
            tbarMain.Buttons("Move").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_RECENTER '1702
        Case "ZoomIn" '放大
            tbarMain.Buttons("ZoomIn").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_EXPAND '1705
        Case "ZoomOut" '缩小
            tbarMain.Buttons("ZoomOut").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_SHRINK '1706
        ''Case "ChangeView" '改变视图
        ''    tbarMain.Buttons("ChangeView").Value = 0
        ''    MapInfo.RunMenuCommand M_MAP_CHANGE_VIEW'805
        Case "SelectRect" '矩形选择
            tbarMain.Buttons("SelectRect").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_SEARCH_RECT '1722
        Case "SelectCircle" '圆形选择
            tbarMain.Buttons("SelectCircle").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_SEARCH_RADIUS '1702
        Case "SelectCreatePoly" '创建一个虚拟多边形区域,选择区域内的对象
            tbarMain.Buttons("SelectCreatePoly").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_SEARCH_POLYGON '1704
    '    Case "SelectPoly" '多边形选择
    '        tbarMain.Buttons("SelectPoly").Value = 1
    '        MapInfo.RunMenuCommand M_TOOLS_SEARCH_BOUNDARY
        Case "AntiSelect" '反选
            MapInfo.RunMenuCommand 311
        Case "LayerControl" '图层控制
            MapInfo.RunMenuCommand M_MAP_LAYER_CONTROL '801
        Case "Ruler"
            MapInfo.RunMenuCommand M_TOOLS_RULER '1710
            MapInfo.Do "Set Window Ruler Parent " & ActiveForm.hwnd & " Show"
            tbarMain.Buttons("Ruler").Value = 1
        Case "ManMark" '手工标注
            tbarMain.Buttons("ManMark").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_LABELER '1708
        'Case "ShowHideLegend" '显示/影藏图例
        '    MapInfo.RunMenuCommand M_WINDOW_LEGEND
        
        Case "Info_Point" '点取信息
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Info_Point").Value = 1
            MapInfo.Do "Run Menu Command ID 2001"
'            MapInfo.RunMenuCommand M_TOOLS_PNT_QUERY '1707
        Case "Info_Rect" '矩形信息
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Info_Rect").Value = 1
            MapInfo.Do "Run Menu Command ID 2002"
            
        Case "Symbol" '符号
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Symbol").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_POINT '1711
        Case "Line" '直线
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Line").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_LINE '1712
        Case "PolyLine"
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("PolyLine").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_POLYLINE '1713
        Case "Arc"
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Arc").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_ARC '1716
        Case "Polygon" '创建多边形区域
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Polygon").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_POLYGON '1714
        Case "Ellipse"
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Ellipse").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_ELLIPSE '1715
        Case "Rectangle"
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Rectangle").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_RECTANGLE '1717
        Case "RoundedRectangle"
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("RoundedRectangle").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_ROUNDEDRECT '1718
        Case "Text"
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("Text").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_TEXT '1709
        Case "ReShape"
            tbarMain.Buttons("Select").Value = 1
            tbarMain.Buttons("ReShape").Value = 1
            MapInfo.RunMenuCommand M_EDIT_RESHAPE '1601
        Case "AddNode"
            tbarMain.Buttons("Select").Value = 0
            tbarMain.Buttons("AddNode").Value = 1
            MapInfo.RunMenuCommand M_TOOLS_ADD_NODE '1723
            
        Case "SymbolStyle"
            tbarMain.Buttons("SymbolStyle").Value = 0
            MapInfo.RunMenuCommand M_FORMAT_PICK_SYMBOL '503
        Case "LineStyle"
            tbarMain.Buttons("LineStyle").Value = 0
            MapInfo.RunMenuCommand M_FORMAT_PICK_LINE '501
        Case "RegionStyle"
            tbarMain.Buttons("RegionStyle").Value = 0
            MapInfo.RunMenuCommand M_FORMAT_PICK_FILL '502
        Case "TextStyle"
            tbarMain.Buttons("TextStyle").Value = 0
             MapInfo.RunMenuCommand M_FORMAT_PICK_FONT '504
    End Select
    Exit Sub
Error:
    Screen.MousePointer = 0
    ADType = MsgBox("没有选中地图对象,可能是无可选图层！ ", vbOKOnly, "关于查询分析 ")
    bExitSub = False
End Sub

'判断表是否可地图化
Private Sub BrowserAddCreateTable(TableName As String, iMapper As Integer)
    If (iMapper = 0) Then
        LoadNewForm
        
        MapInfo.Do "Browse * from " & TableName
    
        BrowserWinID = CLng(MapInfo.Eval("FrontWindow()"))
        TableName = MapInfo.Eval("WindowInfo(" & BrowserWinID & "," & WIN_INFO_TABLE & ")")

        FormBrowser = FormBrowser + 1
        ActiveForm.Caption = TableName + " Browser:" + Format(FormBrowser, "#0")
    Else
        If thereIsAMap Then '已有一个地图,添加新图层
            ''If (MapinfoRunTime = True) Then
                MapInfo.Do "Add Map Layer " & TableName
                ActiveForm.Caption = TableName + "," + ActiveForm.Caption
            ''End If
        Else '创建新地图窗口
            LoadNewForm
            MapInfo.Do "Map From " & TableName
            mapWinID = CLng(MapInfo.Eval("FrontWindow()"))
            thereIsAMap = True
            ActiveForm.Caption = TableName + " Map"
            MapInfo.Do "Set Map Display Position"
            MapInfo.Do "Set Map Layer 0 Editable ON"
        End If
        Call UpdateMenuAndToolbar(True)
    End If
    MapInfo.Do "Set Map XY Units ""degree"" Distance Units ""km"" Area Units ""sq m"""
End Sub

'选择样式
Sub EditStyle(ByVal sStyle As String)
Select Case sStyle
    Case "SymbolStyle"
        tbarMain.Buttons("SymbolStyle").Value = 0
        MapInfo.RunMenuCommand M_FORMAT_PICK_SYMBOL
    Case "LineStyle"
        tbarMain.Buttons("LineStyle").Value = 0
        MapInfo.RunMenuCommand M_FORMAT_PICK_LINE
    Case "RegionStyle"
        tbarMain.Buttons("RegionStyle").Value = 0
        MapInfo.RunMenuCommand M_FORMAT_PICK_FILL
    Case "TextStyle"
        tbarMain.Buttons("TextStyle").Value = 0
        MapInfo.RunMenuCommand M_FORMAT_PICK_FONT
End Select
End Sub
上一页 1 2 34
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -