📄 emme2.frm
字号:
VERSION 5.00
Begin VB.Form Emme2
BorderStyle = 1 'Fixed Single
Caption = "检索数据库,选择需要导出的字段"
ClientHeight = 5190
ClientLeft = 45
ClientTop = 330
ClientWidth = 4605
Icon = "Emme2.frx":0000
LinkTopic = "Form2"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5190
ScaleWidth = 4605
StartUpPosition = 2 '屏幕中心
Begin VB.TextBox Text1
Appearance = 0 'Flat
Height = 270
Left = 840
TabIndex = 17
Top = 4320
Width = 3735
End
Begin VB.CommandButton Command2
Caption = "帮助(&H)"
Height = 375
Left = 0
TabIndex = 14
Top = 4800
Width = 855
End
Begin VB.Frame Frame3
Caption = "路段数据字段选择"
Height = 2055
Left = 0
TabIndex = 9
Top = 2160
Width = 4575
Begin VB.CommandButton cmdsel
Caption = "<-"
Enabled = 0 'False
Height = 375
Index = 3
Left = 2040
TabIndex = 16
Top = 1320
Width = 555
End
Begin VB.CommandButton cmdsel
Caption = "->"
Height = 375
Index = 2
Left = 2040
TabIndex = 15
Top = 720
Width = 555
End
Begin VB.ListBox List4
Height = 1320
Left = 2640
TabIndex = 13
Top = 480
Width = 1815
End
Begin VB.ListBox List1
Height = 1320
Left = 120
TabIndex = 10
Top = 480
Width = 1815
End
Begin VB.Label Label1
Caption = "EMME/2数据必需字段："
Height = 360
Index = 3
Left = 2640
TabIndex = 12
Top = 240
Width = 1800
End
Begin VB.Label Label1
Caption = "数据库其他可用字段："
Height = 360
Index = 0
Left = 120
TabIndex = 11
Top = 240
Width = 1815
End
End
Begin VB.Frame Frame2
Caption = "节点数据字段选择"
Height = 2055
Left = 0
TabIndex = 2
Top = 0
Width = 4575
Begin VB.ListBox List3
Height = 1320
Left = 2640
TabIndex = 7
Top = 480
Width = 1785
End
Begin VB.CommandButton cmdsel
Caption = "->"
Enabled = 0 'False
Height = 375
Index = 0
Left = 2040
TabIndex = 6
Top = 720
Width = 555
End
Begin VB.CommandButton cmdsel
Caption = "<-"
Enabled = 0 'False
Height = 375
Index = 1
Left = 2040
TabIndex = 5
Top = 1320
Width = 555
End
Begin VB.ListBox List2
Height = 1320
Left = 120
TabIndex = 3
Top = 480
Width = 1845
End
Begin VB.Label Label1
Caption = "EMME/2数据必需字段："
Height = 360
Index = 2
Left = 2640
TabIndex = 8
Top = 240
Width = 1800
End
Begin VB.Label Label1
Caption = "数据库其他可用字段："
Height = 360
Index = 1
Left = 120
TabIndex = 4
Top = 240
Width = 1815
End
End
Begin VB.CommandButton Command1
Caption = "取消(&C)"
Height = 375
Left = 3720
TabIndex = 1
Top = 4800
Width = 855
End
Begin VB.CommandButton cmdll
Caption = "导出(&E)"
Default = -1 'True
Height = 375
Left = 2760
TabIndex = 0
Top = 4800
Width = 915
End
Begin VB.Label Label2
Caption = "保存路径："
Height = 255
Left = 0
TabIndex = 18
Top = 4320
Width = 975
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = -240
X2 = 6360
Y1 = 4710
Y2 = 4710
End
Begin VB.Line Line1
BorderColor = &H00404040&
Index = 0
X1 = -240
X2 = 6360
Y1 = 4695
Y2 = 4695
End
End
Attribute VB_Name = "Emme2"
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 *
'* 请保留本版权信息，谢谢合作 *
'* 中国交通技术论坛 *
'* *
'* *
'*********************************************************************
Option Explicit
Private Sub cmdsel_Click(Index As Integer)
On Error GoTo b0:
Select Case Index
Case 0
'把List2中需要查询的字段，向List3列表框中添加，
'以便于用其来构造SQL语句。
If List2.ListCount = 1 Then cmdsel(0).Enabled = False
cmdsel(1).Enabled = True
List3.AddItem List2.Text
List2.RemoveItem List2.ListIndex
List2.Selected(List2.ListIndex + 1) = True
List3.Selected(List3.NewIndex) = True
Case 1
'把List3中不需要查询的字段移去。
If List3.ListCount = 1 Then cmdsel(1).Enabled = False
cmdsel(0).Enabled = True
List2.AddItem List3.Text
List3.RemoveItem List3.ListIndex
List3.Selected(List3.ListIndex + 1) = True
List2.Selected(List2.NewIndex) = True
Case 2
'把List2中需要查询的字段，向List3列表框中添加，
'以便于用其来构造SQL语句。
If List1.ListCount = 1 Then cmdsel(2).Enabled = False
cmdsel(3).Enabled = True
List4.AddItem List1.Text
List1.RemoveItem List1.ListIndex
List1.Selected(List1.ListIndex + 1) = True
List4.Selected(List4.NewIndex) = True
Case 3
'把List3中不需要查询的字段移去。
If List4.ListCount = 1 Then cmdsel(3).Enabled = False
cmdsel(2).Enabled = True
List1.AddItem List4.Text
List4.RemoveItem List4.ListIndex
List4.Selected(List4.ListIndex + 1) = True
List1.Selected(List1.NewIndex) = True
b0:
End Select
End Sub
Private Sub cmdll_Click()
Dim i As Integer
Dim SpChar As String
SpChar = vbTab
'构造SQL语句。
If List3.ListCount > 0 Then
For i = 0 To List3.ListCount - 1
List3.Selected(i) = True
'SQL语句有严格的语法要求，如果要查询的字段的字段名中
'包含有空格或其他的特殊字符，一定要要用ASCII码为96的
'字符(即Esc键的下面那个键)将它括起来，以免导致查询失败。
If InStr(1, List3.Text, " ") <> 0 Then
SQL_str = SQL_str & "Nodes" & "." & "`" & List3.Text & "`" & ","
Else
SQL_str = SQL_str & "Nodes" & "." & List3.Text & ","
End If
Next i
SQL_str = Left(SQL_str, Len(SQL_str) - 1)
SQL_str = "SELECT " & SQL_str & " FROM " & "Nodes"
End If
Dim Rstemp As Recordset
Dim FidCount As Integer
Set Rstemp = mDbBiblio.OpenRecordset(SQL_str)
FidCount = Rstemp.Fields.Count
Rstemp.MoveFirst
Open ExportPath & ExportName For Output As #1
Dim tempstr
tempstr = "t nodes init /@(#) d211.in 9.1@(#)"
Print #1, tempstr
Do Until Rstemp.EOF
tempstr = ""
For i = 0 To FidCount - 1
tempstr = tempstr & Rstemp.Fields(i) & SpChar
Next i
Print #1, tempstr
Rstemp.MoveNext
Loop
Set Rstemp = Nothing
FidCount = 0
SQL_str = ""
If List4.ListCount > 0 Then
For i = 0 To List4.ListCount - 1
List4.Selected(i) = True
'SQL语句有严格的语法要求，如果要查询的字段的字段名中
'包含有空格或其他的特殊字符，一定要要用ASCII码为96的
'字符(即Esc键的下面那个键)将它括起来，以免导致查询失败。
If InStr(1, List4.Text, " ") <> 0 Then
SQL_str = SQL_str & "links" & "." & "`" & List4.Text & "`" & ","
Else
SQL_str = SQL_str & "links" & "." & List4.Text & ","
End If
Next i
SQL_str = Left(SQL_str, Len(SQL_str) - 1)
SQL_str = "SELECT " & SQL_str & " FROM " & "links"
End If
Set Rstemp = mDbBiblio.OpenRecordset(SQL_str)
FidCount = Rstemp.Fields.Count
Rstemp.MoveFirst
tempstr = "t links init"
Print #1, ""
Print #1, tempstr
Do Until Rstemp.EOF
tempstr = ""
For i = 0 To FidCount - 1
tempstr = tempstr & Rstemp.Fields(i) & SpChar
Next i
Print #1, tempstr
Rstemp.MoveNext
Loop
Close #1
Dim RespView
RespView = MsgBox("输出导出成功，是否需要查看所导出的文件？", vbOKCancel, "数据导出成功")
If RespView = vbOK Then
Dim OpenF
OpenF = "NotePad.EXE " & ExportPath & ExportName
Shell OpenF, vbNormalFocus
End If
Unload Me
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Form_Load()
List1.Clear
List2.Clear
List3.Clear
List4.Clear
Dim tempstr
'遍历表中的字段，将其字段名添加到 List1/2 中。
For Each Fd In mDbBiblio.TableDefs("Nodes").Fields
tempstr = Fd.Name
If tempstr <> "NodeType" And tempstr <> "NodeId" And tempstr <> "NodeX" And tempstr <> "NodeY" Then
List2.AddItem Fd.Name
End If
Next
List3.AddItem "NodeType"
List3.AddItem "NodeId"
List3.AddItem "NodeX"
List3.AddItem "NodeY"
For Each Fd In mDbBiblio.TableDefs("Links").Fields
tempstr = Fd.Name
If tempstr <> "LinkType" And tempstr <> "NodeI" And tempstr <> "NodeJ" And tempstr <> "Length" And tempstr <> "Mode" And tempstr <> "NetworkType" And tempstr <> "LaneNum" Then
List1.AddItem Fd.Name
End If
Next
List4.AddItem "LinkType"
List4.AddItem "NodeI"
List4.AddItem "NodeJ"
List4.AddItem "Length"
List4.AddItem "Mode"
List4.AddItem "NetworkType"
List4.AddItem "LaneNum"
'控制cmdsel按钮数组的有效性，以免发生错误。
If List2.ListCount <> 0 Then
cmdsel(0).Enabled = True
List2.Selected(0) = True
Else
cmdsel(0).Enabled = False
End If
If List1.ListCount <> 0 Then
cmdsel(2).Enabled = True
List1.Selected(0) = True
Else
cmdsel(2).Enabled = False
End If
Text1.Text = ExportPath & ExportName
Text1.Enabled = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -