📄 frmykgllr.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FrmYkgllr
Caption = "游客信息录入"
ClientHeight = 6180
ClientLeft = 60
ClientTop = 450
ClientWidth = 9120
Icon = "FrmYkgllr.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6180
ScaleWidth = 9120
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton CmdOk
Caption = "保存(&O)"
Height = 420
Left = 4560
TabIndex = 20
Top = 5580
Width = 1230
End
Begin VB.CommandButton cmdExit
Caption = "退出(&X)"
Height = 420
Left = 7380
TabIndex = 19
Top = 5580
Width = 1230
End
Begin VB.CommandButton CmdQk
Caption = "清空(&K)"
Height = 420
Left = 6000
TabIndex = 18
Top = 5580
Width = 1230
End
Begin VB.Frame Frame1
Caption = "游客信息"
ForeColor = &H00FF0000&
Height = 5100
Left = 180
TabIndex = 10
Top = 240
Width = 8805
Begin VB.ComboBox CmbSex
Height = 300
Left = 4680
Style = 2 'Dropdown List
TabIndex = 1
Top = 337
Width = 1155
End
Begin VB.TextBox TxtNl
Height = 300
Left = 6780
TabIndex = 2
Top = 337
Width = 1800
End
Begin VB.TextBox TxtName
Height = 300
Left = 1020
TabIndex = 0
Top = 337
Width = 2445
End
Begin VB.ComboBox CmbJd
Height = 300
Left = 1020
Style = 2 'Dropdown List
TabIndex = 6
Top = 1807
Width = 2445
End
Begin VB.TextBox TxtJg
Height = 300
Left = 7380
TabIndex = 8
Top = 1807
Width = 1200
End
Begin VB.TextBox TxtSfzh
Height = 300
Left = 1020
TabIndex = 3
Top = 840
Width = 2445
End
Begin VB.TextBox Txtbz
Height = 2535
Left = 1020
MultiLine = -1 'True
TabIndex = 9
Top = 2340
Width = 7545
End
Begin VB.TextBox TxtLxdh
Height = 300
Left = 4680
TabIndex = 4
Top = 840
Width = 3885
End
Begin VB.TextBox TxtLxdz
Height = 300
Left = 1020
TabIndex = 5
Top = 1317
Width = 7560
End
Begin MSComCtl2.DTPicker DTPCxsj
Height = 315
Left = 4680
TabIndex = 7
Top = 1800
Width = 1635
_ExtentX = 2884
_ExtentY = 556
_Version = 393216
Format = 69599232
CurrentDate = 39421
End
Begin VB.Label Label6
Caption = "性 别"
Height = 165
Left = 3840
TabIndex = 23
Top = 405
Width = 735
End
Begin VB.Label Label12
Caption = "年龄"
Height = 165
Left = 6300
TabIndex = 22
Top = 405
Width = 390
End
Begin VB.Label Label2
Caption = "游客姓名"
Height = 165
Left = 180
TabIndex = 21
Top = 405
Width = 750
End
Begin VB.Label Label8
Caption = "价格(元)"
Height = 165
Left = 6540
TabIndex = 17
Top = 1875
Width = 750
End
Begin VB.Label Label3
Caption = "出行时间"
Height = 165
Left = 3840
TabIndex = 16
Top = 1875
Width = 795
End
Begin VB.Label Label4
Caption = "旅游景点"
Height = 165
Left = 180
TabIndex = 15
Top = 1875
Width = 750
End
Begin VB.Label Label13
Caption = "身份证号"
Height = 165
Left = 180
TabIndex = 14
Top = 895
Width = 795
End
Begin VB.Label Label9
Caption = "备 注"
Height = 165
Left = 180
TabIndex = 13
Top = 3420
Width = 750
End
Begin VB.Label Label1
Caption = "联系电话"
Height = 165
Left = 3840
TabIndex = 12
Top = 908
Width = 750
End
Begin VB.Label Label5
Caption = "联系地址"
Height = 165
Left = 180
TabIndex = 11
Top = 1385
Width = 795
End
End
End
Attribute VB_Name = "FrmYkgllr"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private strSQL As String
Private bsfbcsj As Boolean
Private cnntemp As New ADODB.Connection
Private rstTemp As New ADODB.Recordset
Private rstlr As New ADODB.Recordset
Private Sub CmbJd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub CmbSex_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub CmdExit_Click()
Unload Me
End Sub
Private Sub CmdOK_Click()
Dim Ans As String
If Trim(TxtName.Text) = "" Then
MsgBox "请填写游客姓名", vbInformation, Me.Caption
TxtName.SetFocus
Exit Sub
End If
If bsfbcsj Then
Ans = MsgBox("保存以上信息吗？", vbYesNo + vbQuestion, Me.Caption)
If Ans = vbYes Then
' On Error GoTo RollbackOrder
cnntemp.BeginTrans
strSQL = "select * from db_ykgl where 游客姓名='" & Trim(TxtName.Text) & "'"
With rstlr
If .State = adStateOpen Then .Close
.CursorLocation = adUseClient
.Open strSQL, cnntemp, adOpenKeyset, adLockPessimistic, Options:=adCmdText
.AddNew
.Fields("游客姓名") = TxtName.Text
.Fields("性别") = CmbSex.Text
.Fields("年龄") = Val(TxtNl.Text)
.Fields("身份证号") = TxtSfzh.Text
.Fields("联系电话") = TxtLxdh.Text
.Fields("联系地址") = TxtLxdz.Text
.Fields("旅游景点") = CmbJd.Text
.Fields("出行时间") = DTPCxsj.Value
.Fields("价格") = CCur(Val(TxtJg.Text))
.Fields("备注") = Txtbz.Text
.Update
End With
cnntemp.CommitTrans
MsgBox "游客信息录入成功!", vbInformation, Me.Caption
bsfbcsj = False
rstlr.Close
ElseIf Ans = vbNo Then
Exit Sub
End If
End If
Exit Sub
RollbackOrder:
If Err.Number <> 0 Then
MsgBox Err.Description & vbCrLf & "未录入！请检查各项目是否填写正确", vbExclamation, Me.Caption
Exit Sub
End If
cnntemp.RollbackTrans
bsfbcsj = True
On Error GoTo 0
End Sub
Private Sub CmdQk_Click()
bsfbcsj = False
ClearAllText Me
TxtName.SetFocus
End Sub
Private Sub DTPCxsj_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
SendKeys "{tab}"
End If
End Sub
Private Sub Form_Load()
Me.Show
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, 0
DoEvents
DTPCxsj.Value = Date
TxtName.SetFocus
With CmbSex
.AddItem "男"
.AddItem "女"
.ListIndex = 1
End With
Call ShowJdxx
On Error GoTo Err
' Dim strConnect As String
'
' strConnect = ServerIp
'
' Set cnntemp = Nothing
' With cnntemp
' .Open strConnect
' End With
Set cnntemp = Nothing
With cnntemp
.Provider = "Microsoft.jet.OLEDB.4.0"
.Open App.Path & "\travel.mdb", "admin"
End With
bsfbcsj = False
Exit Sub
Err:
If Err.Number <> 0 Then
MsgBox Err.Description & vbCrLf & "请检查操作是否正确", vbExclamation, Me.Caption
Exit Sub
End If
On Error GoTo 0
End Sub
Private Sub TxtJg_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtLxdh_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtLxdz_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtName_Change()
bsfbcsj = True
End Sub
Private Sub TxtName_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtNl_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtSfzh_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub ShowJdxx()
strSQL = "select 景点名称 from DB_jdgl"
Call DirectRecordset(strSQL, rstTemp)
If rstTemp.RecordCount <> 0 Then
With CmbJd
rstTemp.MoveFirst
Do While Not rstTemp.EOF
.AddItem rstTemp("景点名称")
rstTemp.MoveNext
Loop
rstTemp.Close
.ListIndex = -1
End With
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -