lx.frm

这款双龙风景区售票系统 Ver 1.0

VERSION 5.00
Object = "{CFA7AFF4-3242-4269-9172-7389D695AE01}#1.0#0"; "StoneXP.ocx"
Object = "{DAAC6951-59A4-4C08-9D6E-FE3919B64861}#1.0#0"; "FlexCell.ocx"
Begin VB.Form lx 
   BorderStyle     =   0  'None
   Caption         =   "售票类型管理"
   ClientHeight    =   4215
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   6090
   Icon            =   "lx.frx":0000
   LinkTopic       =   "xiaoqu"
   MaxButton       =   0   'False
   ScaleHeight     =   4215
   ScaleWidth      =   6090
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin FlexCell.Grid Grid1 
      Height          =   4215
      Left            =   0
      TabIndex        =   3
      Top             =   0
      Width           =   4695
      _ExtentX        =   8281
      _ExtentY        =   7435
      Appearance      =   0
      Cols            =   5
      Rows            =   30
      ScrollBars      =   2
   End
   Begin StoneXP.XPButton XPButton1 
      Height          =   375
      Left            =   4920
      TabIndex        =   1
      Top             =   2160
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Caption         =   "增 加"
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton2 
      Height          =   375
      Left            =   4920
      TabIndex        =   2
      Top             =   2640
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Caption         =   "保 存"
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton5 
      Height          =   375
      Left            =   4920
      TabIndex        =   0
      Top             =   3600
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Caption         =   "退 出"
      MousePointer    =   99
   End
   Begin StoneXP.XPButton XPButton3 
      Height          =   375
      Left            =   4920
      TabIndex        =   4
      Top             =   3120
      Width           =   975
      _ExtentX        =   1720
      _ExtentY        =   661
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Caption         =   "删 除"
      MousePointer    =   99
   End
   Begin VB.Menu cz 
      Caption         =   "操作"
      Visible         =   0   'False
      Begin VB.Menu renovate 
         Caption         =   "刷新"
      End
   End
End
Attribute VB_Name = "lx"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'作者：星零工作室
'发布日期：2007/03/08
'描    述：双龙风景区售票系统 Ver 1.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Dim i As Integer
Private Declare Function GetKeyState Lib "user32" _
   (ByVal nVirtKey As Long) As Integer
Dim gcolor1, gcolor2 As String
Dim m, n As Integer

Private Sub Form_Load()
With Grid1
    .AllowUserResizing = True
    .DisplayFocusRect = False
    '.ExtenfjastCol = True
    .Appearance = Flat
    .FixedRowColStyle = Flat
    .ScrollBarStyle = Flat
    
    .DefaultFont.Name = "Tahoma"
    .DefaultFont.Size = 8
    .BackColorFixed = RGB(128, 217, 193)  'RGB(90, 158, 214)
    .BackColorFixedSel = RGB(128, 217, 193)  'RGB(110, 180, 230)
    .BackColorBkg = RGB(128, 217, 193)  'RGB(90, 158, 214)
    .BackColorScrollBar = RGB(128, 217, 193)
    .BackColor1 = RGB(231, 235, 247)
    .BackColor2 = RGB(239, 243, 255)
    .GridColor = RGB(148, 190, 231)
    .Column(0).Width = 0
    .Column(1).Width = 100
    .Column(2).Width = 100
End With
Me.BackColor = RGB(128, 217, 193)
fjtable = "售票类型"
Call callmain
End Sub

Private Sub callmain()
fjsave = False
fjedit = True
fjdel = True
Set fj1 = cnn.Execute("select * from " & fjtable)
Grid1.Rows = 1 '清除所有记录
i = 3
Grid1.Cols = i + 1 '必须+1,因为实际上为4行,但第一行是隐藏的
For i = 0 To i - 1  '显示数据的字段名
Grid1.Cell(0, i + 1).Text = fj1.Fields(i).Name  '读取表中的各字段名
Next
n = i
i = 1
Do While Not fj1.EOF
 Grid1.Rows = Grid1.Rows + 1
 For j = 1 To n '设定读取列
 If fj1.Fields(j - 1) = Null Then '空值的处理
 Grid1.Cell(i, j).Text = ""
 Else
 Grid1.Cell(i, j).Text = fj1.Fields(j - 1)
  If Mid(Grid1.Cell(i, j).Text, 1, 1) = "." Then
   Grid1.Cell(i, j).Text = "0" & Grid1.Cell(i, j).Text
  End If
 End If
 Next
  i = i + 1
 fj1.MoveNext '读取下一记录
Loop
Grid1.Column(1).Locked = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
Call XPButton5_Click
End Sub

Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
PopupMenu cz
End If
End Sub

Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
End Sub

Private Sub Grid1_Validate(Cancel As Boolean) '设定TAB键切换
Dim nActiveRow As Long, nActiveCol As Long
    Const VK_TAB = 9

    If GetKeyState(VK_TAB) < 0 Then
        nActiveRow = Grid1.ActiveCell.Row
        nActiveCol = Grid1.ActiveCell.Col
        If nActiveCol < Grid1.Cols - 1 Then
            Grid1.Range(nActiveRow, nActiveCol + 1, _
                        nActiveRow, nActiveCol + 1).Selected
        End If
        Cancel = True
    End If
    End Sub

Private Sub renovate_Click()
Call callmain
End Sub

Private Sub XPButton1_Click()
fjsave = True
Set fj1 = cnn.Execute("select * from " & fjtable)
Grid1.Rows = 1 '清除所有记录
Grid1.Rows = 21 '默认为2行
For i = 0 To 1   '显示数据的字段名
Grid1.Cell(0, i + 1).Text = fj1.Fields(i).Name  '读取表中的各字段名
Next
Grid1.Column(1).Locked = False
Grid1.Cell(1, 1).SetFocus
XPButton2.Default = True
End Sub

Private Sub XPButton2_Click()
If fjsave = False Then
MsgBox "不支持保存操作！", vbInformation, "当前不支持"
Exit Sub
End If
If m <> 0 And n <> 0 Then
Grid1.Range(m, 1, m, 2).BackColor = gcolor1
Grid1.Range(n, 1, n, 2).BackColor = gcolor2
End If
For i = 1 To Grid1.Rows - 1
 For j = i + 1 To Grid1.Rows - 1
  If Grid1.Cell(i, 1).Text <> "" Then
   If Grid1.Cell(i, 2).Text = "" Then
   MsgBox "第" & i & "行的数据请填完整!", vbInformation, "错误提示"
   Grid1.Cell(i, 2).SetFocus
   Exit Sub
   End If
  If Grid1.Cell(i, 1).Text = Grid1.Cell(j, 1).Text And Grid1.Cell(i, 2).Text = Grid1.Cell(j, 2).Text Then
  MsgBox "第" & i & "行与" & j & "行的数据出现重复，请修改!", vbInformation, "重复错误"
  m = i
  n = j
  gcolor1 = Grid1.Cell(m, 1).BackColor
  gcolor2 = Grid1.Cell(n, 1).BackColor
  Grid1.Range(i, 1, i, 2).BackColor = RGB(90, 158, 214)
  Grid1.Range(j, 1, j, 2).BackColor = RGB(90, 158, 214)
  Exit Sub
  End If
  End If
 Next
Next
For i = 1 To Grid1.Rows - 1
If Grid1.Cell(i, 1).Text <> "" Then

Set fj2 = cnn.Execute("insert into 售票类型 values('" & Grid1.Cell(i, 1).Text & "','" & Grid1.Cell(i, 2).Text & "'," & Grid1.Cell(1, 3).Text & ")")
End If
Next
MsgBox "资料已保存！", vbInformation, "完成"
Call callmain
End Sub

Private Sub XPButton3_Click()
If fjdel = False Then
MsgBox "当前删除操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
If hang = 0 Then
Exit Sub
End If
If Grid1.Cell(hang, 1).Text = "" Then
Exit Sub
End If
Set fj1 = cnn.Execute("delete from " & fjtable & " where " & fj1.Fields(0).Name & "='" & Grid1.Cell(hang, 1).Text & "' and " & fj1.Fields(1).Name & "='" & Grid1.Cell(hang, 2).Text & "'")
MsgBox "目标己删除,请刷新数据!", vbInformation, "删除成功"
Call callmain
End Sub

Private Sub XPButton5_Click()
Unload Me
End Sub