📄 frmdygllr.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FrmDygllr
Caption = "导游信息录入"
ClientHeight = 6120
ClientLeft = 60
ClientTop = 450
ClientWidth = 8880
Icon = "FrmDygllr.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6120
ScaleWidth = 8880
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton CmdOk
Caption = "保存(&O)"
Height = 420
Left = 4440
TabIndex = 17
Top = 5460
Width = 1230
End
Begin VB.CommandButton cmdExit
Caption = "退出(&X)"
Height = 420
Left = 7260
TabIndex = 16
Top = 5460
Width = 1230
End
Begin VB.CommandButton CmdQk
Caption = "清空(&K)"
Height = 420
Left = 5880
TabIndex = 15
Top = 5460
Width = 1230
End
Begin VB.Frame Frame1
Caption = "导游信息"
ForeColor = &H00FF0000&
Height = 5040
Left = 180
TabIndex = 7
Top = 180
Width = 8505
Begin VB.ComboBox CmbSex
Height = 300
Left = 7500
Style = 2 'Dropdown List
TabIndex = 2
Top = 390
Width = 735
End
Begin VB.TextBox TxtCysj
Height = 300
Left = 5100
TabIndex = 4
Top = 967
Width = 1500
End
Begin VB.TextBox TxtDybh
Height = 300
Left = 1200
TabIndex = 0
Top = 390
Width = 2520
End
Begin VB.TextBox TxtDyjd
Height = 300
Left = 1200
TabIndex = 5
Top = 1590
Width = 7080
End
Begin VB.TextBox Txtbz
Height = 2535
Left = 1200
MultiLine = -1 'True
TabIndex = 6
Top = 2220
Width = 7065
End
Begin VB.TextBox TxtName
Height = 300
Left = 4800
TabIndex = 1
Top = 390
Width = 1785
End
Begin MSComCtl2.DTPicker DTPCsrq
Height = 315
Left = 1200
TabIndex = 3
Top = 960
Width = 2475
_ExtentX = 4366
_ExtentY = 556
_Version = 393216
Format = 154009600
CurrentDate = 39421
End
Begin VB.Label Label8
Caption = "从业时间(年)"
Height = 165
Left = 3960
TabIndex = 14
Top = 1035
Width = 1230
End
Begin VB.Label Label3
Caption = "出生日期"
Height = 165
Left = 240
TabIndex = 13
Top = 1035
Width = 795
End
Begin VB.Label Label4
Caption = "导游证编号"
Height = 165
Left = 180
TabIndex = 12
Top = 458
Width = 990
End
Begin VB.Label Label13
Caption = "性别"
Height = 165
Left = 6960
TabIndex = 11
Top = 458
Width = 435
End
Begin VB.Label Label12
Caption = "导游景点"
Height = 165
Left = 240
TabIndex = 10
Top = 1665
Width = 750
End
Begin VB.Label Label2
Caption = "导游姓名"
Height = 165
Left = 3960
TabIndex = 9
Top = 458
Width = 750
End
Begin VB.Label Label9
Caption = "备 注"
Height = 165
Left = 240
TabIndex = 8
Top = 2820
Width = 750
End
End
End
Attribute VB_Name = "FrmDygllr"
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 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(TxtDybh.Text) = "" Then
MsgBox "请填写导游证编号", vbInformation, Me.Caption
TxtDybh.SetFocus
Exit Sub
End If
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_dygl where 导游证编号='" & Trim(TxtDybh.Text) & "'"
With rstlr
If .State = adStateOpen Then .Close
.CursorLocation = adUseClient
.Open strSQL, cnntemp, adOpenKeyset, adLockPessimistic, Options:=adCmdText
.AddNew
.Fields("导游证编号") = TxtDybh.Text
.Fields("导游姓名") = TxtName.Text
.Fields("性别") = CmbSex.Text
.Fields("出生日期") = DTPCsrq.Value
.Fields("从业时间") = Val(TxtCysj.Text)
.Fields("导游景点") = TxtDyjd.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
TxtDybh.SetFocus
End Sub
Private Sub DTPCsrq_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
DTPCsrq.Value = Date
TxtDybh.SetFocus
With CmbSex
.AddItem "男"
.AddItem "女"
.ListIndex = 1
End With
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 TxtCysj_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtDybh_Change()
bsfbcsj = True
End Sub
Private Sub TxtDybh_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtDyjd_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
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -