📄 frmdbmanage.frm
字号:
VERSION 5.00
Begin VB.Form FrmDbManage
Caption = "数据库字段管理"
ClientHeight = 3870
ClientLeft = 60
ClientTop = 345
ClientWidth = 4230
Icon = "FrmDbManage.frx":0000
LinkTopic = "Form2"
ScaleHeight = 3870
ScaleWidth = 4230
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Caption = "字段修改"
Height = 1095
Left = 0
TabIndex = 4
Top = 2760
Width = 4215
Begin VB.CommandButton Command3
Caption = "关闭窗口"
Height = 375
Left = 3120
TabIndex = 12
Top = 600
Width = 975
End
Begin VB.ComboBox cmbfld
Height = 300
Left = 960
TabIndex = 11
Text = "Combo1"
Top = 600
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "数据查看"
Height = 375
Left = 2160
TabIndex = 8
Top = 600
Width = 975
End
Begin VB.CommandButton Cmdll
Caption = "删除字段"
Height = 375
Left = 3120
TabIndex = 7
Top = 240
Width = 975
End
Begin VB.CommandButton Command2
Caption = "增加字段"
Default = -1 'True
Height = 375
Left = 2160
TabIndex = 6
Top = 240
Width = 975
End
Begin VB.TextBox TxtField
Height = 270
Left = 960
TabIndex = 5
Top = 300
Width = 1095
End
Begin VB.Label Label2
Caption = "数据类型"
Height = 255
Index = 1
Left = 120
TabIndex = 10
Top = 680
Width = 975
End
Begin VB.Label Label2
Caption = "字段名称"
Height = 255
Index = 0
Left = 120
TabIndex = 9
Top = 360
Width = 1095
End
End
Begin VB.ListBox List2
Height = 2040
Left = 2205
TabIndex = 1
Top = 315
Width = 2010
End
Begin VB.ListBox List1
Height = 2040
Left = 0
TabIndex = 0
Top = 315
Width = 2190
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = 0
X2 = 6600
Y1 = 2660
Y2 = 2660
End
Begin VB.Line Line1
BorderColor = &H00404040&
Index = 0
X1 = 0
X2 = 6600
Y1 = 2640
Y2 = 2640
End
Begin VB.Label Label1
Caption = "可用字段："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 1
Left = 2250
TabIndex = 3
Top = 45
Width = 870
End
Begin VB.Label Label1
Caption = "数据库表："
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 240
Index = 0
Left = 45
TabIndex = 2
Top = 45
Width = 870
End
End
Attribute VB_Name = "FrmDbManage"
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
Const NameNotInCollection = 3265
Private Sub cmdedit_Click()
' On Error Resume Next
Dim RsTable As TableDef
Dim Fd As Field
Set RsTable = mDbBiblio.TableDefs(List1.Text)
Set Fd = RsTable(List2.Text)
Dim FldName As String
Dim FldType As Integer
FldName = TxtField.Text
FldType = FieldTypeNum(cmbfld.Text)
Fd.CreateProperty FldName, FldType
mDbBiblio.TableDefs(List1.Text).Fields.Refresh
RsTable.Fields.Append Fd
mDbBiblio.TableDefs.Append RsTable
MsgBox "修改成功！"
End Sub
Private Sub cmdll_Click()
On Error GoTo b0:
'默认字段不能删除
Dim delstr
delstr = TxtField.Text
If delstr = "NodeId" Or delstr = "NodeX" Or delstr = "Crosstype" Or delstr = "NodeY" Or delstr = "NodeType" Or delstr = "LinkId" Or delstr = "NodeI" Or delstr = "NodeJ" Or delstr = "Length" Or delstr = "Mode" & delstr = "LinkType" Or delstr = "LaneNum" Or delstr = "NetworkType" Then
MsgBox "对不起，默认字段不能删除，如需修改默认字段数据类型，请直接在ACCESS里面修改！"
Exit Sub
End If
'把List2中需要查询的字段，向List3列表框中添加，
'以便于用其来构造SQL语句。
If List2.ListCount > 0 Then
If TxtField.Text <> "" Then
cmdll.Enabled = True
mDbBiblio.TableDefs(List1.Text).Fields.Delete mDbBiblio.TableDefs(List1.Text).Fields(TxtField.Text).Name
List2.RemoveItem List2.ListIndex
List2.Selected(List2.ListIndex + 1) = True
MsgBox "字段删除成功！"
End If
End If
b0:
Exit Sub
End Sub
Private Sub Command1_Click()
Load FrmDatashow2
FrmDatashow2.Show
End Sub
Private Sub Command2_Click()
On Error Resume Next
Dim RsTable As TableDef
Dim Fd As Field
Set RsTable = mDbBiblio.TableDefs(List1.Text)
Dim TestField As String
Dim FldName As String
Dim FldType As Integer
FldName = TxtField.Text
FldType = FieldTypeNum(cmbfld.Text)
TestField = RsTable(FldName).Name
If Err = NameNotInCollection Then
Set Fd = RsTable.CreateField(FldName, FldType)
RsTable.Fields.Append Fd
mDbBiblio.TableDefs.Append RsTable
MsgBox "字段添加成功！"
Err = 0
List2.AddItem FldName
List2.Selected(List2.ListCount) = True
ElseIf Err <> NameNotInCollection Then
MsgBox "表中已经含有该字段，如需修改，请点击修改选项！"
Exit Sub
End If
List2.Refresh
End Sub
Private Sub Command4_Click()
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
Dim x, tdf
For x = 0 To mDbBiblio.TableDefs.Count - 1
Set tdf = mDbBiblio.TableDefs(x)
If (tdf.Attributes And dbSystemObject) = 0 Then '避开系统的 Table
List1.AddItem mDbBiblio.TableDefs(x).Name
End If
Next
SQL_str = ""
cmbfld.AddItem "dbBoolean"
cmbfld.AddItem "dbByte"
cmbfld.AddItem "dbInteger"
cmbfld.AddItem "dbLong"
cmbfld.AddItem "dbCurrency"
cmbfld.AddItem "dbSingle"
cmbfld.AddItem "dbDouble"
cmbfld.AddItem "dbDate"
cmbfld.AddItem "dbText"
cmbfld.AddItem "dbLongBinary"
cmbfld.AddItem "dbMemo"
cmbfld.AddItem "dbGUID"
cmbfld.Text = "dbboolean"
End Sub
Private Sub List1_Click()
List2.Clear
'遍历表中的字段，将其字段名添加到 List2 中。
For Each Fd In mDbBiblio.TableDefs(List1.Text).Fields
List2.AddItem Fd.Name
Next
'控制cmdsel按钮数组的有效性，以免发生错误。
If List2.ListCount <> 0 Then
cmdll.Enabled = True
List2.Selected(0) = True
Else
cmdll.Enabled = False
End If
'获取要查询的表名。
TbName = List1.Text
End Sub
Private Sub List2_Click()
TxtField.Text = List2.Text
cmbfld.Text = FieldType(mDbBiblio.TableDefs(List1.Text).Fields(List2.Text).Type)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -