?? 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 + -