📄 newform.frm
字号:
VERSION 5.00
Begin VB.Form NewForm
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "添加新的展会资料"
ClientHeight = 4725
ClientLeft = 45
ClientTop = 330
ClientWidth = 8130
ControlBox = 0 'False
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 4725
ScaleWidth = 8130
ShowInTaskbar = 0 'False
Begin VB.TextBox FieldTxt
Height = 285
Index = 3
Left = 1185
MaxLength = 5
TabIndex = 3
Top = 1875
Width = 780
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 10
Left = 4710
MaxLength = 2
TabIndex = 10
Top = 3510
Width = 645
End
Begin VB.Data Data1
Caption = "Data1"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 'DefaultCursor
DefaultType = 2 'UseODBC
Exclusive = 0 'False
Height = 345
Left = 0
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = -900
Visible = 0 'False
Width = 1140
End
Begin VB.Frame Frame2
Height = 1695
Left = 4140
TabIndex = 27
Top = 1665
Width = 3735
Begin VB.TextBox FieldTxt
Height = 1455
Index = 9
Left = 75
MaxLength = 125
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 9
Top = 165
Width = 3585
End
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 11
Left = 1170
MaxLength = 30
TabIndex = 11
Top = 4215
Width = 2745
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 8
Left = 1170
MaxLength = 80
TabIndex = 8
Top = 3840
Width = 2745
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 7
Left = 1170
MaxLength = 80
TabIndex = 7
Top = 3465
Width = 2745
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 6
Left = 1170
MaxLength = 50
TabIndex = 6
Top = 3090
Width = 2745
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 5
Left = 1170
MaxLength = 50
TabIndex = 5
Top = 2715
Width = 2745
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 4
Left = 1170
MaxLength = 30
TabIndex = 4
Top = 2340
Width = 2745
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 2
Left = 1185
MaxLength = 10
TabIndex = 2
Top = 1500
Width = 1485
End
Begin VB.TextBox FieldTxt
Height = 285
Index = 1
Left = 4020
MaxLength = 40
TabIndex = 1
Top = 810
Width = 3840
End
Begin VB.TextBox FieldTxt
BackColor = &H00FFFFFF&
Height = 285
Index = 0
Left = 4020
MaxLength = 30
TabIndex = 0
Top = 405
Width = 3840
End
Begin VB.PictureBox Picture1
AutoRedraw = -1 'True
BorderStyle = 0 'None
Height = 510
Left = 5325
ScaleHeight = 510
ScaleWidth = 2625
TabIndex = 17
Top = 4005
Width = 2625
Begin VB.CommandButton QX
Cancel = -1 'True
Caption = "取消(&C)"
Height = 405
Left = 1320
TabIndex = 13
ToolTipText = "取消保存"
Top = 30
Width = 1230
End
Begin VB.CommandButton OK
Caption = "确定(&O)"
Height = 405
Left = 30
TabIndex = 12
ToolTipText = "保存当前的展会资料"
Top = 30
Width = 1230
End
End
Begin VB.Frame Frame1
Caption = "New Fair Register"
ForeColor = &H00004040&
Height = 870
Left = 240
TabIndex = 14
Top = 255
Width = 2370
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "新的展览会"
BeginProperty Font
Name = "宋体"
Size = 20.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 405
Index = 1
Left = 180
TabIndex = 16
Top = 315
Width = 2100
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "新的展览会"
BeginProperty Font
Name = "宋体"
Size = 20.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 405
Index = 0
Left = 165
TabIndex = 15
Top = 330
Width = 2100
End
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
Index = 1
X1 = 255
X2 = 7875
Y1 = 1305
Y2 = 1305
End
Begin VB.Line Line1
Index = 0
X1 = 240
X2 = 7875
Y1 = 1275
Y2 = 1275
End
Begin VB.Label Label11
AutoSize = -1 'True
Caption = "展 出 内 容"
ForeColor = &H00800000&
Height = 180
Left = 5580
TabIndex = 31
Top = 1500
Width = 990
End
Begin VB.Label Label5
AutoSize = -1 'True
Caption = "联系人："
Height = 180
Left = 465
TabIndex = 30
Top = 1920
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "天数："
Height = 180
Left = 4170
TabIndex = 29
Top = 3570
Width = 540
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "例:1999/01/01"
ForeColor = &H00808000&
Height = 180
Left = 2790
TabIndex = 28
Top = 1545
Width = 1170
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "地址："
Height = 180
Left = 615
TabIndex = 26
Top = 4230
Width = 540
End
Begin VB.Label Label10
AutoSize = -1 'True
Caption = "网址："
Height = 180
Left = 615
TabIndex = 25
Top = 3855
Width = 540
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = "邮件："
Height = 180
Left = 615
TabIndex = 24
Top = 3495
Width = 540
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "传真："
Height = 180
Left = 615
TabIndex = 23
Top = 3120
Width = 540
End
Begin VB.Label Label7
AutoSize = -1 'True
Caption = "电话："
Height = 180
Left = 615
TabIndex = 22
Top = 2745
Width = 540
End
Begin VB.Label Label6
AutoSize = -1 'True
Caption = "单位："
Height = 180
Left = 615
TabIndex = 21
Top = 2385
Width = 540
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = "展出时间："
Height = 180
Left = 270
TabIndex = 20
Top = 1545
Width = 900
End
Begin VB.Label Label3
AutoSize = -1 'True
Caption = "展出地点："
Height = 180
Left = 3090
TabIndex = 19
Top = 855
Width = 900
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "展会名称："
Height = 180
Left = 3090
TabIndex = 18
Top = 450
Width = 900
End
End
Attribute VB_Name = "NewForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub FieldTxt_Change(Index As Integer)
If Index = 2 Then
If Len(FieldTxt(2).Text) = 4 Or Len(FieldTxt(2).Text) = 7 Then
FieldTxt(2).Text = FieldTxt(2).Text + "/"
FieldTxt(2).SelStart = Len(FieldTxt(2).Text)
FieldTxt(2).SelLength = 0
End If
End If
End Sub
Private Sub FieldTxt_GotFocus(Index As Integer)
FieldTxt(Index).BackColor = &HFF0000
FieldTxt(Index).ForeColor = &HFFFFFF
End Sub
Private Sub FieldTxt_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
If KeyCode = 38 Then
If Index > 0 Then
FieldTxt(Index - 1).SetFocus
End If
End If
If KeyCode = 40 Then
If Index < 11 Then
FieldTxt(Index + 1).SetFocus
End If
End If
End Sub
Private Sub FieldTxt_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 And Index <> 9 Then
SendKeys "{tab}"
Exit Sub
End If
If Index = 2 Then
If KeyAscii = 8 Then Exit Sub
If KeyAscii < 47 Or KeyAscii > 57 Then
KeyAscii = 0
Exit Sub
End If
End If
If Index = 10 Then
If KeyAscii = 8 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 57 Then
KeyAscii = 0
Exit Sub
End If
End If
End Sub
Private Sub FieldTxt_LostFocus(Index As Integer)
FieldTxt(Index).BackColor = &HFFFFFF
FieldTxt(Index).ForeColor = &H0
If InStr(1, FieldTxt(Index).Text, "'", vbTextCompare) Then
MsgBox "该项目之中有特殊字符" + "<'>", vbOKOnly + 48, "提示："
FieldTxt(Index).SetFocus
End If
End Sub
Private Sub Form_Load()
NewForm.Left = Menu.Width
NewForm.Top = Menu.Height - NewForm.Height
End Sub
Private Sub OK_Click()
If Trim(FieldTxt(0).Text) = "" Then
MsgBox "登记展会时,展会名称不能为空！", vbOKOnly + 32, "警告!"
FieldTxt(0).SetFocus
Exit Sub
End If
If VerifyDate(FieldTxt(2).Text) = False Then
MsgBox "展会日期有错误或者为空！", vbOKOnly + 48, "提示："
FieldTxt(2).SelStart = 0
FieldTxt(2).SelLength = Len(FieldTxt(2).Text)
FieldTxt(2).SetFocus
Exit Sub
End If
If Val(FieldTxt(10).Text) <= 0 Then
FieldTxt(10).Text = 0
End If
Dim Db As Database, Ef As Recordset, X As Integer, TempStr As String, DebugStr As String
X = 0
For X = 0 To 11
If X = 2 Or X = 10 Then
Select Case X
Case 2
TempStr = TempStr + "#" + FieldTxt(X).Text + "#,"
Case 10
TempStr = TempStr + FieldTxt(X).Text + ","
End Select
ElseIf X < 11 Then
TempStr = TempStr + "'" + FieldTxt(X).Text + "',"
Else
TempStr = TempStr + "'" + FieldTxt(X).Text + "'"
End If
Next
TempStr = " Values (" + TempStr + ")"
DebugStr = "Insert into Fair (展会名称,展会地点,展会时间,联系人,举办单位,电话,传真,邮件,网址,展会内容,展会天数,地址)"
DebugStr = DebugStr + TempStr
Set Db = OpenDatabase(Browser + "Fair.mdb")
Db.Execute DebugStr
Db.Close
X = 0
For X = 0 To 11
FieldTxt(X).Text = ""
Next
FieldTxt(0).SetFocus
End Sub
Private Sub QX_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -