📄 frmdygl.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form FrmDygl
Caption = "导游信息管理"
ClientHeight = 8325
ClientLeft = 60
ClientTop = 450
ClientWidth = 11865
Icon = "FrmDygl.frx":0000
LinkTopic = "Form1"
ScaleHeight = 8325
ScaleWidth = 11865
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton CmdNew
Caption = "刷新(&N)"
Height = 495
Left = 10260
TabIndex = 14
Top = 4620
Width = 1335
End
Begin VB.Frame Frakfh
Caption = "基本信息"
ForeColor = &H00FF0000&
Height = 6615
Left = 240
TabIndex = 12
Top = 1260
Width = 9615
Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFryxx
Height = 6135
Left = 120
TabIndex = 13
Top = 240
Width = 9375
_ExtentX = 16536
_ExtentY = 10821
_Version = 393216
RowHeightMin = 350
BackColorSel = 12640511
ForeColorSel = 16711680
SelectionMode = 1
AllowUserResizing= 3
RowSizingMode = 1
_NumberOfBands = 1
_Band(0).Cols = 2
End
End
Begin VB.Frame Frahtjbxx
Caption = "请输入查询内容"
ForeColor = &H00FF0000&
Height = 990
Left = 240
TabIndex = 4
Top = 120
Width = 9645
Begin VB.ComboBox CmbNr
Height = 300
Left = 4380
Style = 2 'Dropdown List
TabIndex = 11
Top = 420
Width = 2115
End
Begin VB.TextBox Txtdata
Enabled = 0 'False
Height = 360
Left = 4380
TabIndex = 9
Top = 420
Width = 2115
End
Begin VB.ComboBox Cmbcompare
Enabled = 0 'False
ForeColor = &H00FF0000&
Height = 300
ItemData = "FrmDygl.frx":0312
Left = 2400
List = "FrmDygl.frx":0314
Style = 2 'Dropdown List
TabIndex = 8
Top = 420
Width = 1695
End
Begin VB.CommandButton Cmdcz
Caption = "查询(&S)"
Enabled = 0 'False
Height = 375
Left = 6840
TabIndex = 7
Top = 360
Width = 1335
End
Begin VB.ComboBox Lstcxsrk
Height = 300
Left = 240
Style = 2 'Dropdown List
TabIndex = 6
Top = 420
Width = 2055
End
Begin VB.TextBox Txtfind
Height = 285
Left = 6540
TabIndex = 5
Top = 420
Visible = 0 'False
Width = 540
End
Begin MSAdodcLib.Adodc Adodchtb
Height = 375
Left = 8160
Top = 360
Visible = 0 'False
Width = 1380
_ExtentX = 2434
_ExtentY = 661
ConnectMode = 0
CursorLocation = 3
IsolationLevel = -1
ConnectionTimeout= 15
CommandTimeout = 30
CursorType = 3
LockType = 3
CommandType = 8
CursorOptions = 0
CacheSize = 50
MaxRecords = 0
BOFAction = 0
EOFAction = 0
ConnectStringType= 3
Appearance = 1
BackColor = -2147483643
ForeColor = -2147483640
Orientation = 0
Enabled = -1
Connect = "DSN=lf"
OLEDBString = ""
OLEDBFile = ""
DataSourceName = "lf"
OtherAttributes = ""
UserName = ""
Password = ""
RecordSource = ""
Caption = "Adodc1"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_Version = 393216
End
Begin MSComCtl2.DTPicker DTPdate
Height = 360
Left = 4380
TabIndex = 10
Top = 420
Width = 2115
_ExtentX = 3731
_ExtentY = 635
_Version = 393216
Format = 26673152
CurrentDate = 36948
End
End
Begin VB.CommandButton CmdAdd
Caption = "新 增(&A)"
Height = 495
Left = 10260
TabIndex = 3
Top = 1020
Width = 1335
End
Begin VB.CommandButton CmdXg
Caption = "修 改(&G)"
Height = 495
Left = 10260
TabIndex = 2
Top = 2220
Width = 1335
End
Begin VB.CommandButton CmdDel
Caption = "删 除(&D)"
Height = 495
Left = 10260
TabIndex = 1
Top = 3420
Width = 1335
End
Begin VB.CommandButton CmdExit
Caption = "退出(&X)"
Height = 495
Left = 10260
TabIndex = 0
Top = 6360
Width = 1335
End
Begin MSComctlLib.StatusBar StatusBar1
Align = 2 'Align Bottom
Height = 300
Left = 0
TabIndex = 15
Top = 8025
Width = 11865
_ExtentX = 20929
_ExtentY = 529
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 5
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 10583
MinWidth = 10583
Text = "旅行社管理信息系统"
TextSave = "旅行社管理信息系统"
EndProperty
BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Object.Width = 3528
MinWidth = 3528
EndProperty
BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 6
TextSave = "2007-12-7"
EndProperty
BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Style = 5
TextSave = "13:15"
EndProperty
BeginProperty Panel5 {8E3867AB-8586-11D1-B16A-00C0F0283628}
Enabled = 0 'False
Text = "xj"
TextSave = "xj"
EndProperty
EndProperty
End
End
Attribute VB_Name = "FrmDygl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private rstTemp As New ADODB.Recordset
Private strConnect As String
Private strSQL As String
Private strLst As String
Private Sub Adodchtb_Error(ByVal ErrorNumber As Long, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, fCancelDisplay As Boolean)
End Sub
Private Sub Adodchtb_WillMove(ByVal adReason As ADODB.EventReasonEnum, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
End Sub
Private Sub Cmbcompare_Click()
Txtdata.Enabled = True
If Txtdata.Visible = True Then
Txtdata.SelStart = 0
Txtdata.SelLength = Len(Txtdata.Text)
Txtdata.SetFocus
End If
End Sub
Private Sub CmdAdd_Click()
Load FrmDygllr
End Sub
Private Sub Cmdcz_Click()
Dim slhj As Stream
'On Error GoTo Errmsg
If Cmbcompare.Text = "" Then
MsgBox "请选择查询类型", vbExclamation, "查询提示"
Cmbcompare.SetFocus
Exit Sub
End If
Call MakeFindString
If Txtdata.Text = "所有" Then
With Adodchtb
strSQL = "select * from db_dygl"
Call DirectRecordset(strSQL, rstTemp)
Set .Recordset = rstTemp
.Refresh
End With
Set MSHFryxx.DataSource = rstTemp
Else
With Adodchtb
strSQL = "select * from db_dygl where " & Txtfind.Text
Call DirectRecordset(strSQL, rstTemp)
If rstTemp.RecordCount = 0 Then
MSHFryxx.Clear
' MSHFryxx.Rows = 2
' MSHFryxx.Cols = 44
MSHFryxx.FixedCols = 1
Else
Set .Recordset = rstTemp
.Refresh
Set MSHFryxx.DataSource = rstTemp
End If
End With
End If
Call Showryxx
Exit Sub
Errmsg:
If Err.Number <> 0 Then
MsgBox Err.Description & vbCrLf & "请检查操作是否正确", vbExclamation, Me.Caption
Exit Sub
End If
On Error GoTo 0
End Sub
Private Sub CmdDel_Click()
Dim Ans As String
If MSHFryxx.MouseRow >= MSHFryxx.FixedRows Then
If MSHFryxx.TextMatrix(MSHFryxx.Row, 1) <> "" Then
Ans = MsgBox("确实删除本条信息吗?", vbYesNo, Me.Caption)
If Ans = vbYes Then
'On Error GoTo RollbackOrder
cnntemp.BeginTrans '删除数据
strSQL = "delete from db_dygl where id=" & MSHFryxx.TextMatrix(MSHFryxx.Row, 1)
cnntemp.Execute strSQL
cnntemp.CommitTrans
Else
Exit Sub
End If
End If
With Adodchtb
strSQL = "select * from db_dygl"
Call DirectRecordset(strSQL, rstTemp)
Set .Recordset = rstTemp
.Refresh
End With
'
Set MSHFryxx.DataSource = rstTemp
Call Showryxx
End If
Exit Sub
RollbackOrder:
If Err.Number <> 0 Then
MsgBox Err.Description & vbCrLf & "未删除!请检查各项内容是否正确", vbExclamation, Me.Caption
Exit Sub
End If
cnntemp.RollbackTrans
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -