📄 linkfrm.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form LinkFrm
Caption = "添加路段"
ClientHeight = 3990
ClientLeft = 6210
ClientTop = 5010
ClientWidth = 2970
Icon = "LinkFrm.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3990
ScaleWidth = 2970
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Caption = "自定义字段："
Height = 615
Left = 0
TabIndex = 19
Top = 2760
Width = 2895
Begin VB.ComboBox cmbfd
Height = 300
Left = 120
TabIndex = 8
Text = "Combo1"
Top = 240
Width = 1215
End
Begin VB.TextBox TxtUser
Height = 270
Left = 1440
TabIndex = 9
Top = 240
Width = 1335
End
End
Begin VB.CommandButton Command2
Caption = "取消"
Height = 375
Left = 2160
TabIndex = 11
Top = 3600
Width = 735
End
Begin VB.CommandButton Command1
Caption = "确定"
Default = -1 'True
Height = 375
Left = 1320
TabIndex = 10
Top = 3600
Width = 735
End
Begin MSComCtl2.UpDown UpDown1
Height = 270
Left = 2640
TabIndex = 18
Top = 2280
Width = 240
_ExtentX = 423
_ExtentY = 476
_Version = 393216
Value = 4
AutoBuddy = -1 'True
BuddyControl = "LaneNum"
BuddyDispid = 196611
OrigLeft = 2640
OrigTop = 2280
OrigRight = 2880
OrigBottom = 2535
Max = 16
Min = 1
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin VB.TextBox LaneNum
Height = 270
Left = 1200
TabIndex = 7
Text = "4"
Top = 2280
Width = 1455
End
Begin VB.TextBox Networktype
Height = 270
Left = 1200
TabIndex = 6
Text = "99"
Top = 1920
Width = 1695
End
Begin VB.TextBox Txtmode
Height = 270
Left = 1200
TabIndex = 5
Text = "cbpa"
Top = 1560
Width = 1695
End
Begin VB.TextBox Txtlength
Height = 270
Left = 1200
TabIndex = 4
Top = 1200
Width = 1695
End
Begin VB.TextBox Txtend
Height = 270
Left = 1200
TabIndex = 3
Top = 840
Width = 1695
End
Begin VB.TextBox Txtstart
Height = 270
Left = 1200
TabIndex = 2
Top = 480
Width = 1695
End
Begin VB.ComboBox cmbfield
Height = 300
Left = 1200
TabIndex = 1
Text = "Combo1"
Top = 120
Width = 1695
End
Begin VB.Line Line1
BorderColor = &H80000009&
Index = 1
X1 = 0
X2 = 2880
Y1 = 3495
Y2 = 3495
End
Begin VB.Line Line1
BorderColor = &H80000003&
Index = 0
X1 = 0
X2 = 2880
Y1 = 3480
Y2 = 3480
End
Begin VB.Label Label2
Caption = "车道数："
Height = 255
Index = 4
Left = 120
TabIndex = 17
Top = 2400
Width = 975
End
Begin VB.Label Label2
Caption = "网络类型："
Height = 255
Index = 3
Left = 120
TabIndex = 16
Top = 2040
Width = 975
End
Begin VB.Label Label2
Caption = "路段模式："
Height = 255
Index = 2
Left = 120
TabIndex = 15
Top = 1680
Width = 975
End
Begin VB.Label Label2
Caption = "路段长度："
Height = 255
Index = 1
Left = 120
TabIndex = 14
Top = 1320
Width = 975
End
Begin VB.Label Label1
Caption = "路段终点："
Height = 255
Index = 1
Left = 120
TabIndex = 13
Top = 960
Width = 975
End
Begin VB.Label Label2
Caption = "路段起点："
Height = 255
Index = 0
Left = 120
TabIndex = 12
Top = 600
Width = 975
End
Begin VB.Label Label1
Caption = "路段类型："
Height = 255
Index = 0
Left = 120
TabIndex = 0
Top = 240
Width = 975
End
End
Attribute VB_Name = "LinkFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*********************************************************************
'*
'* 本源码完全免费，共交通同仁学习参考 *
'* www.tranbbs.com *
'* Developed by Yang Ming *
'* Nanjing Institute of City Transportation Planning *
'* 请保留本版权信息，谢谢合作 *
'* 中国交通技术论坛 *
'* *
'* *
'*********************************************************************
Public Write2db As Boolean
Private Sub cmbfd_Click()
If FdNum <> 0 Then
Dim TempNum
If cmbfd.ListIndex = -1 Then
TempNum = 1
Else
TempNum = cmbfd.ListIndex + 1
End If
TxtUser.Text = UserName(TempNum)
End If
End Sub
Private Sub Command1_Click()
Write2db = True
Dim LinkTypeSel As String
Dim LinkModeSel As String
Dim NetworkTypeSel As String
Dim LaneNumSel As Integer
Dim IMaxId
LinkModeSel = Txtmode.Text
NetworkTypeSel = Networktype.Text
LaneNumSel = Val(LaneNum.Text)
If cmbfield.Text = "双行线" Then
LinkTypeSel = "a="
ElseIf cmbfield.Text = "单行线" Then
LinkTypeSel = "a"
End If
Dim RS_addlink As Recordset
Set RS_addlink = mDbBiblio.OpenRecordset("Links")
'添加到数据库中
RS_addlink.AddNew
RS_addlink!LinkId = LinkIdNum
RS_addlink!NodeI = LinkStart
RS_addlink!NodeJ = LinkEnd
RS_addlink!Length = LinkLength
RS_addlink!LinkType = LinkTypeSel
RS_addlink!Mode = LinkModeSel
RS_addlink!Networktype = NetworkTypeSel
RS_addlink!LaneNum = LaneNumSel
If FdNum <> 0 Then
Dim i
For i = 1 To FdNum
If UserName(i) = "" Then
Dim Resp
Resp = MsgBox("自定义字段" & cmbfd.List(i - 1) & "未输入有效值，确认继续吗？选择继续将以0填充该字段！", vbOKCancel)
If Resp = vbOK Then
UserName(i) = 0
Else
Exit Sub
End If
End If
RS_addlink.Fields(cmbfd.List(i - 1)) = UserName(i)
Next i
End If
RS_addlink.Update
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
TxtUser.Enabled = True
cmbfield.AddItem "双行线"
cmbfield.AddItem "单行线"
cmbfield.Text = "双行线"
Txtstart.Text = LinkStart
Txtend.Text = LinkEnd
Txtlength.Text = LinkLength
Write2db = False
Dim Fd As Field
Dim AllFdNum
AllFdNum = mDbBiblio.TableDefs("Links").Fields.Count
If AllFdNum <> 0 Then
step = 0
For Each Fd In mDbBiblio.TableDefs("Links").Fields
If Fd.Name <> "LinkType" And Fd.Name <> "NodeI" And Fd.Name <> "NodeJ" And Fd.Name <> "LinkId" And Fd.Name <> "Length" And Fd.Name <> "Mode" And Fd.Name <> "NetworkType" And Fd.Name <> "LaneNum" Then
step = step + 1
cmbfd.AddItem Fd.Name
End If
Next
FdNum = step
If FdNum <> 0 Then
cmbfd.Text = cmbfd.List(0)
ReDim UserName(1 To FdNum)
Else
cmbfd.Text = "无自定义字段"
TxtUser.Enabled = False
End If
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Write2db = False Then
MsgBox "该路段信息没有写入数据库，选择该图元点击删除即可清除！"
End If
End Sub
Private Sub TxtUser_Change()
If FdNum <> 0 Then
Dim TempNum
If cmbfd.ListIndex = -1 Then
TempNum = 1
Else
TempNum = cmbfd.ListIndex + 1
End If
UserName(TempNum) = TxtUser.Text
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -