?? frmsavegeoset.frm
字號:
Height = 375
Left = 144
Style = 1 'Graphical
TabIndex = 5
Top = 1440
Width = 1695
End
Begin VB.CommandButton cmdLayerControl
BackColor = &H00C0C0C0&
Caption = "Layer Control"
Height = 375
Left = 144
MaskColor = &H00808080&
Style = 1 'Graphical
TabIndex = 4
Top = 960
Width = 1695
End
Begin VB.PictureBox pctTools
AutoSize = -1 'True
Height = 495
Index = 3
Left = 1320
ScaleHeight = 435
ScaleWidth = 555
TabIndex = 3
ToolTipText = "Pan Map"
Top = 360
Width = 615
End
Begin VB.PictureBox pctTools
AutoSize = -1 'True
Height = 495
Index = 2
Left = 720
ScaleHeight = 435
ScaleWidth = 555
TabIndex = 2
ToolTipText = "Zoom Out"
Top = 360
Width = 615
End
Begin VB.PictureBox pctTools
AutoSize = -1 'True
Height = 495
Index = 1
Left = 120
ScaleHeight = 435
ScaleWidth = 555
TabIndex = 1
ToolTipText = "Zoom In"
Top = 360
Width = 615
End
End
Begin ComctlLib.ImageList ilstIcons
Left = 1920
Top = 360
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 33
ImageHeight = 31
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 9
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":056A
Key = ""
Object.Tag = "ZoomIn Light"
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":0E18
Key = ""
Object.Tag = "ZoomOut Light"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":16C6
Key = ""
Object.Tag = "Pan Light"
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":1F74
Key = ""
Object.Tag = "Zoom In Dark"
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":2822
Key = ""
Object.Tag = "Zoom Out Dark"
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":30D0
Key = ""
Object.Tag = "Pan Dark"
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":397E
Key = ""
Object.Tag = "New"
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":422C
Key = ""
Object.Tag = "Open"
EndProperty
BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmSaveGeoset.frx":4ADA
Key = ""
Object.Tag = "SAve"
EndProperty
EndProperty
End
Begin VB.Menu mnufile
Caption = "&File"
Index = 1
Begin VB.Menu mnufile1
Caption = "&New Geoset"
Index = 100
Shortcut = ^N
End
Begin VB.Menu mnufile1
Caption = "&Open Geoset"
Index = 101
Shortcut = ^O
End
Begin VB.Menu mnufile1
Caption = "&Save Geoset "
Index = 102
Shortcut = ^S
End
Begin VB.Menu mnufile1
Caption = "-"
Index = 103
End
Begin VB.Menu mnufile1
Caption = "E&xit"
Index = 199
End
Begin VB.Menu mnufile1
Caption = "-"
Index = 499
Visible = 0 'False
End
Begin VB.Menu mnufile1
Caption = ""
Index = 500
Visible = 0 'False
End
Begin VB.Menu mnufile1
Caption = ""
Index = 501
Visible = 0 'False
End
Begin VB.Menu mnufile1
Caption = ""
Index = 502
Visible = 0 'False
End
Begin VB.Menu mnufile1
Caption = ""
Index = 503
Visible = 0 'False
End
End
End
Attribute VB_Name = "frmGeoSets"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'*****************************************************************************************************
'Declarations for various Windows functions for Registry Read/Write
'*****************************************************************************************************
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, _
ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, _
ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
String, ByVal cbData As Long) As Long
Private Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, _
ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
'*****************************************************************************************************
'API Constant Declarations
'*****************************************************************************************************
Const REG_SZ As Long = 1
Const REG_DWORD As Long = 4
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const ERROR_NONE = 0
Const ERROR_BADDB = 1
Const ERROR_BADKEY = 2
Const ERROR_CANTOPEN = 3
Const ERROR_CANTREAD = 4
Const ERROR_CANTWRITE = 5
Const ERROR_OUTOFMEMORY = 6
Const ERROR_INVALID_PARAMETER = 7
Const ERROR_ACCESS_DENIED = 8
Const ERROR_INVALID_PARAMETERS = 87
Const ERROR_NO_MORE_ITEMS = 259
Const KEY_ALL_ACCESS = &H3F
Const REG_OPTION_NON_VOLATILE = 0
'*****************************************************************************************************
'General variables
Dim mstrPathtoGSTs As String
Dim mstrLastUsedFile As String
'*****************************************************************************************************
Private Function QueryValue(sKeyName As String, sValueName As String) As String
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Private Sub SetKeyValue(sKeyName As String, sValueName As String, vValueSetting As Variant, lValueType As Long)
Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key
'open the specified key
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, sKeyName, 0, KEY_ALL_ACCESS, hKey)
lRetVal = SetValueEx(hKey, sValueName, lValueType, vValueSetting)
RegCloseKey (hKey)
End Sub
Public Function SetValueEx(ByVal hKey As Long, sValueName As String, lType As Long, vValue As Variant) As Long
Dim lValue As Long
Dim sValue As String
Select Case lType
Case REG_SZ
sValue = vValue
SetValueEx = RegSetValueExString(hKey, sValueName, 0&, lType, sValue, Len(sValue))
Case REG_DWORD
lValue = vValue
SetValueEx = RegSetValueExLong(hKey, sValueName, 0&, lType, lValue, 4)
End Select
End Function
Private Sub cmdCoordSys_Click()
'*****************************************************************************************************
'Show the Coordinate Picker
Map1.DisplayCoordSys.PickCoordSys
End Sub
Private Sub cmdLayerControl_Click()
'*****************************************************************************************************
'Show Layer Control
Map1.Layers.LayersDlg
End Sub
Private Sub Form_Load()
'*****************************************************************************************************
Dim strTemp As String
Dim intCounter As Integer
Dim lngtemp As Long
'Create the Registry Key for Most recently Used FileList if it doesn't exist
RegCreateKeyEx HKEY_LOCAL_MACHINE, "SOFTWARE\MapInfo\GeosetManager", lngtemp, strTemp, lngtemp, lngtemp, lngtemp, lngtemp, lngtemp
'Calling UpdateFileMenu will find the Most Recently Used file list and make menu choices for them
Call UpdateFileMenu
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -