📄 frmareasel.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form FrmAreaSel
BorderStyle = 1 'Fixed Single
ClientHeight = 4440
ClientLeft = 15
ClientTop = 15
ClientWidth = 5895
ControlBox = 0 'False
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4440
ScaleWidth = 5895
Begin VB.Frame Frame1
BackColor = &H80000004&
ClipControls = 0 'False
Height = 4455
Left = 0
TabIndex = 0
Top = 0
Width = 5895
Begin MSComctlLib.TreeView TreeView1
Height = 3855
Left = 120
TabIndex = 1
Top = 480
Width = 5655
_ExtentX = 9975
_ExtentY = 6800
_Version = 393217
HideSelection = 0 'False
LabelEdit = 1
Sorted = -1 'True
Style = 7
HotTracking = -1 'True
SingleSel = -1 'True
ImageList = "ImageList3"
BorderStyle = 1
Appearance = 1
MousePointer = 99
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
MouseIcon = "FrmAreaSel.frx":0000
End
Begin VB.Image Image2
Height = 180
Left = 5400
MouseIcon = "FrmAreaSel.frx":031A
MousePointer = 99 'Custom
Picture = "FrmAreaSel.frx":0624
Stretch = -1 'True
Top = 240
Width = 300
End
Begin VB.Image Image1
Height = 180
Left = 4920
MouseIcon = "FrmAreaSel.frx":075A
MousePointer = 99 'Custom
Picture = "FrmAreaSel.frx":0A64
Stretch = -1 'True
Top = 240
Width = 300
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Label1"
Height = 180
Left = 240
TabIndex = 2
Top = 240
Width = 540
End
End
Begin MSComctlLib.ImageList ImageList3
Left = 0
Top = 1200
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483628
ImageWidth = 16
ImageHeight = 16
MaskColor = 16777215
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 5
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmAreaSel.frx":0B92
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmAreaSel.frx":3524
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmAreaSel.frx":5EB6
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmAreaSel.frx":8848
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "FrmAreaSel.frx":B1DA
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "FrmAreaSel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'AreaLevel表示限定选择地域的级别
'0-表示无限制
'1-表示选择洲
'2-表示选择国家
'3-表示选择省
'4-表示选择市/县
'5-表示可以选择国家、省、市/县
Public AreaLevel As Integer
Public ClickOK As Boolean
Private Sub Form_Load()
Dim TmpNode As Node
FocusAreaName = "中国"
FocusAreaId = CurArea.AreaId
'Root Node
Set TmpNode = TreeView1.Nodes.Add(, , "a0", "全球地域", 1, 3)
TmpNode.Selected = True
TmpNode.ExpandedImage = 2
ClickOK = False
'0-表示无限制
'1-表示选择洲
'2-表示选择国家
'3-表示选择省
'4-表示选择市/县
'5-表示可以选择国家、省、市/县
'6-表示可以选择省、市或县
Select Case AreaLevel
Case 0
Label1 = "您可以选择任意地域"
Case 1
Label1 = "请您选择一个洲"
Case 2
Label1 = "请您选择一个国家"
Case 3
Label1 = "请您选择一个省"
Case 4
Label1 = "请您选择一个市或县"
Case 5
Label1 = "请您选择一个国家、省、市或县"
Case 6
Label1 = "请您选择一个省、市或县"
End Select
Call Add_AreaToTree(TreeView1)
TreeView1.Scroll = True
TreeView1_Click
End Sub
Private Sub Image1_Click()
TreeView1_DblClick
End Sub
Private Sub Image2_Click()
ClickOK = False
Unload Me
End Sub
Private Sub TreeView1_Click()
FocusKey = TreeView1.SelectedItem.Key
MyArea.AreaName = TreeView1.SelectedItem.Text
Tmp_type = Asc(Left(TreeView1.SelectedItem.Key, 1))
MyArea.AreaType = Tmp_type - Asc("a")
MyArea.AreaId = Val(Right(TreeView1.SelectedItem.Key, Len(TreeView1.SelectedItem.Key) - 1))
If MyArea.AreaType = 0 Then '全球地域
Exit Sub
End If
MyArea.GetInfo (MyArea.AreaId)
End Sub
Private Sub TreeView1_DblClick()
Dim TmpStr As String
If AreaLevel > 0 And AreaLevel < 5 And AreaLevel <> MyArea.AreaType Then
Select Case AreaLevel
Case 1
TmpStr = "洲"
Case 2
TmpStr = "国家"
Case 3
TmpStr = "省"
Case 4
TmpStr = "市/县"
End Select
MsgBox "请选择 " + TmpStr
Exit Sub
Else
If AreaLevel = 5 Then '选择国家、省、市/县
If MyArea.AreaType < 2 Or MyArea.AreaType > 4 Then
MsgBox "请选择 国家、省、市或县"
Exit Sub
End If
End If
If AreaLevel = 6 Then '选择省、市/县
If MyArea.AreaType < 3 Or MyArea.AreaType > 4 Then
MsgBox "请选择 省、市或县"
Exit Sub
End If
End If
End If
CurArea.AreaId = MyArea.AreaId
CurArea.AreaName = MyArea.AreaName
CurArea.AreaType = MyArea.AreaType
ClickOK = True
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -