📄 frmjdglxg.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FrmJdglXg
Caption = "景点信息修改"
ClientHeight = 6450
ClientLeft = 60
ClientTop = 450
ClientWidth = 9300
Icon = "FrmjdglXg.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6450
ScaleWidth = 9300
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Caption = "景点信息"
ForeColor = &H00FF0000&
Height = 5400
Left = 180
TabIndex = 12
Top = 180
Width = 8985
Begin VB.TextBox TxtJg
Height = 300
Left = 7440
TabIndex = 7
Top = 1440
Width = 1440
End
Begin VB.TextBox TxtJhdd
Height = 300
Left = 3960
TabIndex = 6
Top = 1440
Width = 2280
End
Begin VB.TextBox TxtYlts
Height = 300
Left = 5400
TabIndex = 1
Top = 337
Width = 780
End
Begin VB.TextBox TxtJtgj
Height = 300
Left = 7440
TabIndex = 2
Top = 337
Width = 1440
End
Begin VB.TextBox Txtbz
Height = 2775
Left = 1020
MultiLine = -1 'True
TabIndex = 8
Top = 2040
Width = 7845
End
Begin VB.TextBox TxtJdmc
Height = 300
Left = 1020
TabIndex = 0
Top = 337
Width = 2805
End
Begin VB.TextBox TxtQd
Height = 300
Left = 1020
TabIndex = 3
Top = 900
Width = 2805
End
Begin VB.TextBox TxtZd
Height = 300
Left = 5400
TabIndex = 4
Top = 900
Width = 3480
End
Begin MSComCtl2.DTPicker DTPFtrq
Height = 315
Left = 1020
TabIndex = 5
Top = 1440
Width = 1815
_ExtentX = 3201
_ExtentY = 556
_Version = 393216
Format = 25493504
CurrentDate = 39421
End
Begin VB.Label Label8
Caption = "价格(元)"
Height = 165
Left = 6480
TabIndex = 21
Top = 1515
Width = 990
End
Begin VB.Label Label3
Caption = "发团日期"
Height = 165
Left = 180
TabIndex = 20
Top = 1515
Width = 795
End
Begin VB.Label Label4
Caption = "集合地点"
Height = 165
Left = 3120
TabIndex = 19
Top = 1515
Width = 750
End
Begin VB.Label Label13
Caption = "游览天数(天)"
Height = 165
Left = 4200
TabIndex = 18
Top = 405
Width = 1155
End
Begin VB.Label Label12
Caption = "交通工具"
Height = 165
Left = 6480
TabIndex = 17
Top = 405
Width = 750
End
Begin VB.Label Label2
Caption = "景点名称"
Height = 165
Left = 180
TabIndex = 16
Top = 405
Width = 750
End
Begin VB.Label Label9
Caption = "备 注"
Height = 165
Left = 180
TabIndex = 15
Top = 2700
Width = 750
End
Begin VB.Label Label1
Caption = "起 点"
Height = 165
Left = 180
TabIndex = 14
Top = 975
Width = 750
End
Begin VB.Label Label5
Caption = "终 点"
Height = 165
Left = 4200
TabIndex = 13
Top = 975
Width = 1155
End
End
Begin VB.TextBox TxtID
Height = 375
Left = 1980
TabIndex = 11
Top = 5760
Visible = 0 'False
Width = 1575
End
Begin VB.CommandButton CmdOk
Caption = "修改(&O)"
Height = 420
Left = 5760
TabIndex = 9
Top = 5820
Width = 1230
End
Begin VB.CommandButton cmdExit
Caption = "退出(&X)"
Height = 420
Left = 7500
TabIndex = 10
Top = 5820
Width = 1230
End
End
Attribute VB_Name = "FrmJdglXg"
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 CmdExit_Click()
Unload Me
End Sub
Private Sub CmdOK_Click()
Dim Ans As String
If Trim(TxtJdmc.Text) = "" Then
MsgBox "请填写景点名称", vbInformation, Me.Caption
TxtJdmc.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 = "delete from db_jdgl where id=" & Trim(TxtID.Text)
cnntemp.Execute strSQL
strSQL = "select * from db_jdgl where 景点名称='" & Trim(TxtJdmc.Text) & "'"
With rstlr
If .State = adStateOpen Then .Close
.CursorLocation = adUseClient
.Open strSQL, cnntemp, adOpenKeyset, adLockPessimistic, Options:=adCmdText
.AddNew
.Fields("景点名称") = TxtJdmc.Text
.Fields("游览天数") = Val(TxtYlts.Text)
.Fields("交通工具") = TxtJtgj.Text
.Fields("起点") = TxtQd.Text
.Fields("终点") = TxtZd.Text
.Fields("发团日期") = DTPFtrq.Value
.Fields("集合地点") = TxtJhdd.Text
.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 DTPFtrq_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
TxtJdmc.SetFocus
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 TxtID_Change()
bsfbcsj = True
'On Error GoTo Err
strSQL = "select * from db_jdgl where id=" & TxtID.Text & ""
Call DirectRecordset(strSQL, rstTemp)
With rstTemp
If .RecordCount = 0 Then
MsgBox "没有此景点位信息！", vbInformation, "提示"
Exit Sub
Else
'调出basic数据
TxtJdmc.Text = .Fields("景点名称") & ""
TxtYlts.Text = .Fields("游览天数") & ""
TxtJtgj.Text = .Fields("交通工具") & ""
TxtQd.Text = .Fields("起点") & ""
TxtZd.Text = .Fields("终点") & ""
DTPFtrq.Value = .Fields("发团日期") & ""
TxtJhdd.Text = .Fields("集合地点") & ""
TxtJg.Text = .Fields("价格") & ""
Txtbz.Text = .Fields("备注") & ""
End If
End With
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 TxtJdmc_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtJg_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtJhdd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtJtgj_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtQd_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtYlts_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{tab}"
End If
End Sub
Private Sub TxtZd_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 + -