📄 frmsys.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form FrmSys
BorderStyle = 1 'Fixed Single
Caption = "系统设置"
ClientHeight = 1740
ClientLeft = 45
ClientTop = 330
ClientWidth = 5130
Icon = "FrmSys.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1740
ScaleWidth = 5130
ShowInTaskbar = 0 'False
StartUpPosition = 1 '所有者中心
Begin MSComDlg.CommonDialog CommonDialog1
Left = 1320
Top = 1200
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.TextBox Text2
Height = 300
Left = 3360
TabIndex = 9
Top = 80
Width = 1695
End
Begin VB.ComboBox Combo1
Height = 300
ItemData = "FrmSys.frx":1E72
Left = 1080
List = "FrmSys.frx":1EA9
Style = 2 'Dropdown List
TabIndex = 6
Top = 75
Width = 1335
End
Begin VB.CommandButton Command4
Caption = "取消"
Height = 495
Left = 4320
TabIndex = 5
Top = 1200
Width = 735
End
Begin VB.CommandButton Command3
Caption = "确定"
Height = 495
Left = 3480
TabIndex = 4
Top = 1200
Width = 735
End
Begin VB.CommandButton Command2
Caption = "坐标系统"
Height = 495
Left = 120
TabIndex = 3
Top = 1200
Width = 1095
End
Begin VB.Frame Frame2
Caption = "缺省地图设置"
Height = 615
Left = 120
TabIndex = 0
Top = 480
Width = 4935
Begin VB.CommandButton Command1
Caption = "选择地图"
Height = 375
Left = 3960
TabIndex = 2
Top = 180
Width = 900
End
Begin VB.TextBox Text1
Height = 270
Left = 120
Locked = -1 'True
TabIndex = 1
Top = 240
Width = 3735
End
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "地图名称"
Height = 180
Left = 2520
TabIndex = 8
Top = 145
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "地图单位:"
Height = 180
Left = 120
TabIndex = 7
Top = 145
Width = 900
End
End
Attribute VB_Name = "FrmSys"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim FilePathA As String
Dim FileNameA As String
On Error Resume Next
CommonDialog1.DialogTitle = "选择地图集"
CommonDialog1.Filter = "MapX GeoSet(*.gst)|*.gst"
CommonDialog1.CancelError = True
CommonDialog1.ShowOpen
If Err.Number = 32755 Then Exit Sub
Text1.Text = CommonDialog1.filename
End Sub
Private Sub Command2_Click()
FrmMain.MyMap.DisplayCoordSys.PickCoordSys
Set FrmMain.MyMap.NumericCoordSys = FrmMain.MyMap.DisplayCoordSys
End Sub
Private Sub Command3_Click()
If Combo1.ListIndex < 14 Then
FrmMain.MyMap.MapUnit = Combo1.ListIndex
Else
Select Case Combo1.ListIndex
Case 14
FrmMain.MyMap.MapUnit = 30
Case 15
FrmMain.MyMap.MapUnit = 31
Case 16
FrmMain.MyMap.MapUnit = 32
End Select
End If
MyMapUnit = FrmMain.MyMap.MapUnit
FrmMain.MyMap.Title = Text2.Text
FrmMain.TreeView1.Nodes.Item(1).Text = FrmMain.MyMap.Title
FrmMain.Caption = "电子地图查询系统----" + FrmMain.MyMap.Title
Dim fs
Dim StrA As String, StrB As String, FilePathA As String, FileNameA As String
Dim StrTXT As String, StrTempA As String, StrTempB As String, IntTempA As Integer
StrTXT = Trim(Text1.Text)
If StrTXT <> "" Then
IntTempA = InStrRev(StrTXT, "\")
StrTempA = Left(StrTXT, IntTempA - 1)
If StrTempA = App.Path + "\Maps" Then StrTempA = "\Maps"
StrTempB = Right(StrTXT, Len(StrTXT) - IntTempA)
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(App.Path + "\MapSearch.ini") Then
setProfile App.Path + "\MapSearch.ini", "Options", "DefaultPath", StrTempA
setProfile App.Path + "\MapSearch.ini", "Options", "DefaultName", StrTempB
Else
MsgBox "找不到设置文件,缺省地图设置错误"
End If
End If
Unload Me
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Load()
MyMapUnit = FrmMain.MyMap.MapUnit
If MyMapUnit < 14 Then
Combo1.ListIndex = MyMapUnit
Else
Select Case MyMapUnit
Case 30
Combo1.ListIndex = 14
Case 31
Combo1.ListIndex = 15
Case 32
Combo1.ListIndex = 16
End Select
End If
Text2.Text = FrmMain.MyMap.Title
Dim fs
Dim StrA As String, StrB As String, FilePathA As String, FileNameA As String
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(App.Path + "\MapSearch.ini") Then
StrA = App.Path + "\MapSearch.ini"
StrB = GetProfile(StrA, "Options", "DefaultPath")
If StrB = "\Maps" Then
FilePathA = App.Path + StrB
Else
FilePathA = StrB
End If
FileNameA = GetProfile(StrA, "Options", "DefaultName")
Text1.Text = FilePathA + "\" + FileNameA
Else
MsgBox "找不到设置文件"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
If fs.FileExists(App.Path + "\xj.tmp") Then Kill App.Path + "\xj.tmp"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -