frmjdgl.frm

旅行社管理信息系统主要实现旅游路线、景点、交通工具等的查询、修改和删除功能

        Exit Sub
    End If
     cnntemp.RollbackTrans
    
     On Error GoTo 0
End Sub

Private Sub CmdExit_Click()
Unload Me
End Sub


Private Sub CmdNew_Click()
If MSHFryxx.Rows = 1 Then
    Unload Me
    Load FrmJdgl
End If

strSQL = "select * from db_jdgl order by id"
Call DirectRecordset(strSQL, rstTemp)
   
Set MSHFryxx.DataSource = rstTemp
Call Showryxx
End Sub

Private Sub CmdXg_Click()
Dim Ans As String
'On Error GoTo Err
Dim intcol As Integer
If MSHFryxx.MouseRow >= MSHFryxx.FixedRows Then
    If MSHFryxx.TextMatrix(MSHFryxx.Row, 1) <> "" Then
        strSQL = "select * from db_jdgl where id=" & MSHFryxx.TextMatrix(MSHFryxx.Row, 1) & ""
        Call DirectRecordset(strSQL, rstTemp)
        If rstTemp.RecordCount <> 0 Then
            FrmJdglXg.TxtID.Text = rstTemp!id
        End If
    End If
End If
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 DTPdate_Change()
'Call MakeFindString
End Sub
Private Sub Form_Load()
Dim lvht As ListItem
SetWindowPos Me.hwnd, HWND_TOPMOST, Me.Left / Screen.TwipsPerPixelX _
, Me.Top \ Screen.TwipsPerPixelY, Me.Width \ Screen.TwipsPerPixelX, _
Me.Height \ Screen.TwipsPerPixelY, 0
Me.Show
DoEvents
With Lstcxsrk
    .AddItem "请选择查询字段"
    .AddItem "景点名称"
    .AddItem "游览天数"
    .AddItem "交通工具"
    .AddItem "发团日期"
    .AddItem "价格"
    .ListIndex = 0
End With

'On Error GoTo Err
With Adodchtb
    strSQL = "select * from db_jdgl order by id"
    Call DirectRecordset(strSQL, rstTemp)
    Set .Recordset = rstTemp
    .Refresh
End With
'
Set MSHFryxx.DataSource = rstTemp
Call Showryxx
'Set rstTemp = Nothing
DTPdate.Value = Format(Now, "yyyy-mm-dd")

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
Exit Sub
Err:
If Err.Number <> 0 Then
    MsgBox Err.Description & vbCrLf & "请检查操作是否正确", vbExclamation, Me.Caption
    Exit Sub
End If
End Sub

Private Sub MakeFindString()
If Cmbcompare.Text = "模糊查询" Then
    Txtfind.Text = "[" & Lstcxsrk.Text & "]" & "like"
ElseIf Cmbcompare.Text = "精确查询" Then
    Txtfind.Text = "[" & Lstcxsrk.Text & "]" & "="
Else
    Txtfind.Text = "[" & Lstcxsrk.Text & "]" & Cmbcompare
End If

Select Case Adodchtb.Recordset.Fields(Lstcxsrk.Text).Type
    Case 202 'adVarChar '字符
         If Cmbcompare.Text = "模糊查询" Then
            If Lstcxsrk.Text = "性别" Or Lstcxsrk.Text = "文化程度" Then
                Txtfind = Txtfind & "'" & "%" & CmbNr.Text & "%" & "'"
            Else
                Txtfind = Txtfind & "'" & "%" & Txtdata.Text & "%" & "'"
            End If
         Else
            If Lstcxsrk.Text = "性别" Or Lstcxsrk.Text = "政治面貌" Or Lstcxsrk.Text = "文化程度" Or Lstcxsrk.Text = "婚姻状况" Then
                Txtfind = Txtfind & "'" & CmbNr.Text & "'"
            Else
                Txtfind = Txtfind & "'" & Txtdata.Text & "'"
            End If
         End If
    Case adDate '日期
         'Txtfind = Txtfind & "#" & Txtdata.Text & "#"
         Txtfind = Txtfind & "#" & DTPdate.Year & "-" & DTPdate.Month & "-" & DTPdate.Day & "#"
    Case Else
        
'         Txtfind = Txtfind & " " & Val(Txtdata.Text)
            Txtfind = Txtfind & "'" & DTPdate.Value & "'"
End Select
End Sub

Private Sub Lstcxsrk_Click()
Cmbcompare.Enabled = True
If Lstcxsrk.Text <> "请选择查询字段" Then
    Cmdcz.Enabled = True
    Select Case Adodchtb.Recordset.Fields(Lstcxsrk.Text).Type
        Case 202 'adVarChar '字符

             Cmbcompare.Clear
             Cmbcompare.AddItem "精确查询"
             Cmbcompare.AddItem "模糊查询"
             Cmbcompare.ListIndex = 1
             Txtdata.Text = ""
             If Lstcxsrk.Text = "性别" Then
                Txtdata.Visible = False
                DTPdate.Visible = False
                CmbNr.Visible = True
                With CmbNr
                    .Clear
                    .AddItem "男"
                    .AddItem "女"
                    .ListIndex = 0
                End With
            
              ElseIf Lstcxsrk.Text = "文化程度" Then
                    Txtdata.Visible = False
                    DTPdate.Visible = False
                    CmbNr.Visible = True
                    With CmbNr
                        .Clear
                        .AddItem "博士"
                        .AddItem "硕士"
                        .AddItem "本科"
                        .AddItem "大专"
                        .AddItem "中专"
                        .AddItem "技校"
                        .AddItem "高中"
                        .AddItem "职高"
                        .AddItem "初中"
                        .AddItem "小学"
                        .AddItem "文盲"
                    End With
             Else
                    Txtdata.Text = "所有"
                    Txtdata.SelStart = 0
                    Txtdata.SelLength = Len(Txtdata.Text)
                    Txtdata.Visible = True
                    DTPdate.Visible = False
                    CmbNr.Visible = False
             End If
             
        Case adDate '日期
        
             Txtdata.Text = ""
             Cmbcompare.Clear
             Cmbcompare.AddItem "="
             Cmbcompare.AddItem ">"
             Cmbcompare.AddItem "<"
             Cmbcompare.AddItem ">="
             Cmbcompare.AddItem "<="
             Cmbcompare.ListIndex = 0
             DTPdate.Value = Date
             Txtdata.Visible = False
             DTPdate.Visible = True
        Case Else
            Cmbcompare.Clear
            Cmbcompare.AddItem "="
            Cmbcompare.AddItem ">"
            Cmbcompare.AddItem "<"
            Cmbcompare.AddItem ">="
            Cmbcompare.AddItem "<="
            Cmbcompare.ListIndex = 0
            Txtdata.Visible = True
            DTPdate.Visible = False
           
            
    End Select
     Call MakeFindString
Else
    Cmdcz.Enabled = False
End If
End Sub
Private Sub Showryxx()
Dim i As Integer
With MSHFryxx
    .Cols = 11
    .ColWidth(0) = 500
    .ColWidth(1) = 0
    .ColWidth(2) = 3000
    .ColWidth(3) = 1500
    .ColWidth(4) = 3000
    .ColWidth(5) = 3500
    .ColWidth(6) = 3500
    .ColWidth(7) = 2000
    .ColWidth(8) = 3000
    .ColWidth(9) = 2000
    .ColWidth(10) = 3500
   
    
    .TextMatrix(0, 0) = "序号"
    .TextMatrix(0, 2) = "景点名称"
    .TextMatrix(0, 3) = "游览天数"
    .TextMatrix(0, 4) = "交通工具"
    
    .TextMatrix(0, 5) = "起点"
    .TextMatrix(0, 6) = "终点"
    .TextMatrix(0, 7) = "发团日期"
    .TextMatrix(0, 8) = "集合地点"
    .TextMatrix(0, 9) = "价格"
    .TextMatrix(0, 10) = "备注"
    
    
    For i = 1 To .Rows - 1
        .TextMatrix(i, 0) = i
        .TextMatrix(i, 7) = Format(.TextMatrix(i, 7), "yyyy-mm-dd")
    Next i
End With
StatusBar1.Panels(1).Text = "共查到" & rstTemp.RecordCount & "条记录"
End Sub

Private Sub mnu_Del_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_jdgl 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_jdgl"
        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
    
     On Error GoTo 0
End Sub


Private Sub mnu_New_Click()
strSQL = "select * from db_jdgl order by id"
Call DirectRecordset(strSQL, rstTemp)
   
Set MSHFryxx.DataSource = rstTemp
Call Showryxx

End Sub

Private Sub mnu_Xg_Click()
'Dim Ans As String
''On Error GoTo Err
'Dim intcol As Integer
'If MSHFryxx.MouseRow >= MSHFryxx.FixedRows Then
'    If MSHFryxx.TextMatrix(MSHFryxx.Row, 1) <> "" Then
'        strSQL = "select * from db_jdgl where id='" & MSHFryxx.TextMatrix(MSHFryxx.Row, 1) & "'"
'        Call DirectRecordset(strSQL, rstTemp)
'        If rstTemp.RecordCount <> 0 Then
'            FrmjdgltXg.TxtID.Text = rstTemp!id
'        End If
'    End If
'End If
'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 MSHFryxx_DblClick()
'Dim Ans As String
''On Error GoTo Err
'Dim intcol As Integer
'If MSHFryxx.MouseRow >= MSHFryxx.FixedRows Then
'    If MSHFryxx.TextMatrix(MSHFryxx.Row, 1) <> "" Then
'        strSQL = "select * from db_jdgl where id='" & MSHFryxx.TextMatrix(MSHFryxx.Row, 1) & "'"
'        Call DirectRecordset(strSQL, rstTemp)
'        If rstTemp.RecordCount <> 0 Then
'            FrmNdwtCk.TxtID.Text = rstTemp!id
'        End If
'    End If
'End If
'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 MSHFryxx_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'If MSHFryxx.MouseRow >= MSHFryxx.FixedRows Then
'    If Button = vbRightButton Then
'        PopupMenu mnuAD
'    End If
'End If
End Sub