📄 linkfrmedit.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FrmLinkEdit
Caption = "路段属性"
ClientHeight = 3990
ClientLeft = 6210
ClientTop = 5010
ClientWidth = 2910
Icon = "LinkFrmEdit.frx":0000
LinkTopic = "Form1"
ScaleHeight = 3990
ScaleWidth = 2910
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Caption = "自定义字段："
Height = 615
Left = 0
TabIndex = 19
Top = 2760
Width = 2895
Begin VB.TextBox TxtUser
Height = 270
Left = 1440
TabIndex = 9
Top = 240
Width = 1335
End
Begin VB.ComboBox cmbfd
Height = 300
Left = 120
TabIndex = 8
Text = "Combo1"
Top = 240
Width = 1215
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 = 196614
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
Locked = -1 'True
TabIndex = 4
Top = 1200
Width = 1695
End
Begin VB.TextBox Txtend
Height = 270
Left = 1200
Locked = -1 'True
TabIndex = 3
Top = 840
Width = 1695
End
Begin VB.TextBox Txtstart
Height = 270
Left = 1200
Locked = -1 'True
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 = "FrmLinkEdit"
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 *
'* 请保留本版权信息，谢谢合作 *
'* 中国交通技术论坛 *
'* *
'* *
'*********************************************************************
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()
Dim LinkRs As Recordset
Set LinkRs = mDbBiblio.OpenRecordset("select * from Links where LinkId=" & FidIdEdit)
'添加到数据库中
LinkRs.Edit
LinkRs!Length = LinkLength
If cmbfield.Text = "双行线" Then
LinkRs!LinkType = "a="
Else
LinkRs!LinkType = "a"
End If
LinkRs!Mode = Txtmode.Text
LinkRs!Networktype = Networktype.Text
LinkRs!LaneNum = LaneNum.Text
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
LinkRs.Fields(cmbfd.List(i - 1)) = UserName(i)
Next i
End If
LinkRs.Update
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim LinkRs As Recordset
Set LinkRs = mDbBiblio.OpenRecordset("select * from Links where LinkId=" & FidIdEdit)
cmbfield.AddItem "双行线"
cmbfield.AddItem "单行线"
If IsNull(LinkRs!LinkType) = True Then
cmbfield.Text = "N/A"
Else
If LinkRs!LinkType = "a=" Then
cmbfield.Text = "双行线"
ElseIf LinkRs!LinkType = "a" Then
cmbfield.Text = "单行线"
Else
cmbfield.Text = "双行线"
End If
End If
Txtstart.Text = LinkRs!NodeI
Txtend.Text = LinkRs!NodeJ
Txtlength.Text = LinkLength
If IsNull(LinkRs!Mode) = True Then
Txtmode.Text = "N/A"
Else
Txtmode.Text = LinkRs!Mode
End If
If IsNull(LinkRs!Networktype) = True Then
Networktype.Text = "N/A"
Else
Networktype.Text = LinkRs!Networktype
End If
If IsNull(LinkRs!LaneNum) = True Then
LaneNum.Text = 4
Else
LaneNum.Text = 4
End If
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
Dim i
If FdNum <> 0 Then
For i = 1 To FdNum
If IsNull(LinkRs.Fields(cmbfd.List(i - 1))) = True Then
UserName(i) = 0
Else
UserName(i) = LinkRs.Fields(cmbfd.List(i - 1))
End If
TxtUser.Text = UserName(1)
Next i
End If
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 + -