form1.frm

杭州舟远信息技术连锁有限公司的棋牌管理系统源代码

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{74848F95-A02A-4286-AF0C-A3C755E4A5B3}#1.0#0"; "actskn43.ocx"
Begin VB.Form N_WP 
   Caption         =   "消费品设置"
   ClientHeight    =   6990
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   8550
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   6990
   ScaleWidth      =   8550
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command8 
      Caption         =   "修改"
      Height          =   375
      Index           =   1
      Left            =   2760
      TabIndex        =   18
      Top             =   4320
      Width           =   735
   End
   Begin VB.CommandButton Command6 
      Caption         =   "查看全部物品"
      Height          =   375
      Left            =   2520
      TabIndex        =   17
      Top             =   360
      Width           =   1335
   End
   Begin VB.TextBox Text5 
      CausesValidation=   0   'False
      Enabled         =   0   'False
      Height          =   270
      Index           =   3
      Left            =   240
      TabIndex        =   16
      Text            =   "名称："
      Top             =   840
      Width           =   615
   End
   Begin VB.TextBox Text5 
      CausesValidation=   0   'False
      Enabled         =   0   'False
      Height          =   270
      Index           =   2
      Left            =   240
      TabIndex        =   15
      Text            =   "价格："
      Top             =   1440
      Width           =   615
   End
   Begin VB.TextBox Text5 
      Enabled         =   0   'False
      Height          =   270
      Index           =   1
      Left            =   240
      TabIndex        =   14
      Text            =   "说明："
      Top             =   2040
      Width           =   615
   End
   Begin VB.TextBox Text5 
      CausesValidation=   0   'False
      Enabled         =   0   'False
      Height          =   270
      Index           =   0
      Left            =   240
      TabIndex        =   13
      Text            =   "类别："
      Top             =   360
      Width           =   615
   End
   Begin ACTIVESKINLibCtl.Skin Skin1 
      Left            =   240
      OleObjectBlob   =   "Form1.frx":0000
      Top             =   3840
   End
   Begin VB.Frame Frame1 
      Caption         =   "增加新类别"
      Height          =   1455
      Left            =   240
      TabIndex        =   8
      Top             =   4920
      Width           =   3495
      Begin VB.CommandButton Command5 
         Caption         =   "删除"
         Height          =   375
         Left            =   2280
         TabIndex        =   12
         Top             =   960
         Width           =   735
      End
      Begin VB.CommandButton Command4 
         Caption         =   "修改"
         Height          =   375
         Left            =   1320
         TabIndex        =   11
         Top             =   960
         Width           =   735
      End
      Begin VB.CommandButton Command3 
         Caption         =   "新增"
         Height          =   375
         Left            =   360
         TabIndex        =   10
         Top             =   960
         Width           =   735
      End
      Begin VB.TextBox Text4 
         Height          =   375
         Left            =   240
         TabIndex        =   9
         Top             =   360
         Width           =   2895
      End
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   1080
      Style           =   2  'Dropdown List
      TabIndex        =   7
      Top             =   360
      Width           =   1335
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   1080
      TabIndex        =   5
      Top             =   1440
      Width           =   2535
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1080
      TabIndex        =   4
      Top             =   840
      Width           =   2535
   End
   Begin VB.TextBox Text3 
      Height          =   2055
      Left            =   1080
      TabIndex        =   3
      Top             =   2040
      Width           =   2535
   End
   Begin VB.CommandButton Command8 
      Caption         =   "删除"
      Height          =   375
      Index           =   0
      Left            =   1920
      TabIndex        =   2
      Top             =   4320
      Width           =   735
   End
   Begin VB.CommandButton Command2 
      Caption         =   "新增"
      Height          =   375
      Left            =   1080
      TabIndex        =   1
      Top             =   4320
      Width           =   735
   End
   Begin VB.CommandButton Command1 
      Caption         =   "退出"
      Height          =   375
      Left            =   3120
      TabIndex        =   0
      Top             =   6480
      Width           =   855
   End
   Begin MSFlexGridLib.MSFlexGrid gd1 
      Height          =   6900
      Left            =   4080
      TabIndex        =   6
      Top             =   0
      Width           =   4380
      _ExtentX        =   7726
      _ExtentY        =   12171
      _Version        =   393216
      Rows            =   10
      Cols            =   3
      FixedCols       =   0
      BackColor       =   12648447
      FocusRect       =   0
      SelectionMode   =   1
   End
End
Attribute VB_Name = "N_WP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim t_bt As String       '存储列表显示的表头
Dim t_fields As Variant  '存储列表显示的字段名
Dim t_fdxs As Variant    '表示显示列是否由代码转换成文字
Dim t_fdcounts As Integer   '表示列表所显示的字段的个数
Dim t_pri As Variant

Private Sub Combo1_click()
 Text4.Text = Trim(Combo1.Text)
 Text1.Text = ""
 Text2.Text = ""
 Text3.Text = ""
t_fields = Array("ID", "WP", "WPJG", "WPMS") '设置显示字段
t_fdxs = Array(0, 0, 0, 0) '设置显示字段
t_bt = "<ID  | <物品名            |<单价（元）    |<说明              "   '设置显示表头格式
t_fdcounts = 4
t_pri = Array("ID", "物品名 ", "单价（元）", "说明")
Command2.Enabled = True
Command8(0).Enabled = False
Command8(1).Enabled = False
Call flex_refresh1
 
 
 
Command6.Visible = True
'Line1.Visible = True
End Sub

Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()
On Error GoTo Error_Handler
Dim ID_REC As ADODB.Recordset
If Trim(Text4.Text) = "" Then
    MsgBox "类别为空，错误！"
    Exit Sub
End If

If Trim(Text1.Text) = "" Then
    MsgBox "物品名为空，错误！"
    Exit Sub
End If

Set ID_REC = New ADODB.Recordset
ID_REC.Source = "SELECT * FROM  N_spb where wp='" + Trim(Text1.Text) + "'"
Set ID_REC.ActiveConnection = objConn
ID_REC.CursorType = adOpenDynamic
ID_REC.LockType = adLockOptimistic
ID_REC.Open
If Not ID_REC.EOF Then
    MsgBox "物品名重复输入，错误！"
    ID_REC.Close
    Set ID_REC = Nothing
    Exit Sub
End If

ID_REC.Close
Set ID_REC = Nothing

If Not IsNumeric(Text2.Text) Then
    MsgBox "价格输入错误！"
    Exit Sub
End If

Set ID_REC = New ADODB.Recordset
ID_REC.Source = "SELECT * FROM  N_SPB"
Set ID_REC.ActiveConnection = objConn
ID_REC.CursorType = adOpenDynamic
ID_REC.LockType = adLockOptimistic
ID_REC.Open
ID_REC.AddNew
ID_REC.Fields("ID") = fGetMaxComID("N_SPB", "ID") + 1
ID_REC.Fields("WP") = Trim(Text1.Text)
ID_REC.Fields("WPJG") = Trim(Text2.Text)
ID_REC.Fields("WPMS") = Trim(Text3.Text)
ID_REC.Fields("MENU") = Trim(Combo1.Text)
ID_REC.Update
ID_REC.Close
Set ID_REC = Nothing
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Call flex_refresh
Error_Handler:
End Sub

Private Sub Command3_Click()
On Error GoTo Error_Handler
Dim menu As ADODB.Recordset

If Trim(Text4.Text) = "" Then
    MsgBox "菜单名为空，错误！"
    Exit Sub
End If

Set menu = New ADODB.Recordset
menu.Source = "SELECT * FROM  N_MENU where menu='" + Trim(Text4.Text) + "'"
Set menu.ActiveConnection = objConn
menu.CursorType = adOpenDynamic
menu.LockType = adLockOptimistic
menu.Open
If Not menu.EOF Then
    MsgBox "物品名重复输入，错误！"
    menu.Close
    Set menu = Nothing
    Exit Sub
End If

menu.Close
Set menu = Nothing


Set menu = New ADODB.Recordset
menu.Source = "SELECT * FROM  N_MENU"
Set menu.ActiveConnection = objConn
menu.CursorType = adOpenDynamic
menu.LockType = adLockOptimistic
menu.Open
menu.AddNew
menu.Fields("ID") = fGetMaxComID("N_MENU", "ID") + 1
menu.Fields("MENU") = Trim(Text4.Text)
menu.Update
menu.Close
Set menu = Nothing
Text4.Text = ""
Combo1.Clear
Call combo_refresh
Error_Handler:
End Sub

Private Sub Command4_Click()
If Trim(Text4.Text) = "" Then
 MsgBox "请输入物品名"
 Exit Sub
End If
On Error Resume Next
 Set menu = New ADODB.Recordset
 menu.Source = "SELECT * FROM  N_MENU where menu='" + Trim(Combo1.Text) + "'"
 Set menu.ActiveConnection = objConn
 menu.CursorType = adOpenDynamic
 menu.LockType = adLockOptimistic
 menu.Open
If Text4.Text = menu("MENU") Then
    MsgBox "物品名重复输入，错误！"
    menu.Close
    Set menu = Nothing
    Exit Sub
End If

menu.Close
Set menu = Nothing


Set menu = New ADODB.Recordset
menu.Source = "SELECT * FROM  N_MENU where menu='" + Trim(Combo1.Text) + "'"
Set menu.ActiveConnection = objConn
menu.CursorType = adOpenDynamic
menu.LockType = adLockOptimistic
menu.Open
 menu.Fields("menu") = Trim(Text4.Text)
 menu.Update
 menu.Close
Set menu = Nothing
Text4.Text = ""
Combo1.Clear
Call combo_refresh
Error_Handler:
End Sub

Private Sub Command5_Click()
 If Combo1.Text = "" Then
  MsgBox "请选择要删除的类别"
  Exit Sub
 End If
On Error Resume Next
 Dim rs As ADODB.Recordset
 Set rs = New ADODB.Recordset
 rs.Source = "delete from N_MENU where menu ='" & Trim(Combo1.Text) & "'"
 Set rs.ActiveConnection = objConn
 rs.CursorType = adOpenDynamic
 rs.LockType = adLockOptimistic
 rs.Open
 rs.Close
 Set rs = Nothing
 Text4.Text = ""
 Combo1.Clear
 Call combo_refresh
End Sub




Private Sub Command8_Click(Index As Integer)
On Error Resume Next
    Dim ID_REC As ADODB.Recordset
    Set ID_REC = New ADODB.Recordset
    ID_REC.Source = "SELECT * FROM  N_SPB WHERE ID ='" + gd1.TextArray(gd1.Row * 4) + "'"
    Set ID_REC.ActiveConnection = objConn
    ID_REC.CursorType = adOpenDynamic
    ID_REC.LockType = adLockOptimistic
    ID_REC.Open
    
    If ID_REC.EOF Then
        MsgBox "无该项物品，或者数据错误！"
    Else
    Select Case Index
      Case 0
        ID_REC.Delete
        ID_REC.Update
      Case 1
        ID_REC.Fields("wp") = Trim(Text1.Text)
        ID_REC.Fields("wpjg") = Trim(Text2.Text)
        ID_REC.Fields("wpms") = Trim(Text3.Text)
        ID_REC.Update
    End Select
    End If
    
    ID_REC.Close
    Set ID_REC = Nothing
    Call flex_refresh
    Text1.Text = ""
    Text2.Text = ""
    Text3.Text = ""
    Command2.Enabled = True
    Command8(0).Enabled = False
    Command8(1).Enabled = False
Error_Handler:

End Sub

Private Sub Form_Load()
t_fields = Array("ID", "WP", "WPJG", "WPMS") '设置显示字段
t_fdxs = Array(0, 0, 0, 0) '设置显示字段
t_bt = "<ID  | <物品名            |<单价（元）    |<说明              "   '设置显示表头格式
t_fdcounts = 4
t_pri = Array("ID", "物品名 ", "单价（元）", "说明")
Command2.Enabled = True
Command8(0).Enabled = False
Command8(1).Enabled = False
Call flex_refresh
 
Skin1.LoadSkin App.Path + "\棋牌界面"
Skin1.ApplySkin hWnd
 

On Error Resume Next
    Dim ID_REC As ADODB.Recordset
    Set ID_REC = New ADODB.Recordset
    ID_REC.Source = "SELECT * FROM  N_MENU"
    Set ID_REC.ActiveConnection = objConn
    ID_REC.CursorType = adOpenDynamic
    ID_REC.LockType = adLockOptimistic
    ID_REC.Open
     While Not ID_REC.EOF
      Combo1.AddItem (ID_REC("menu"))
      a = ID_REC("ID")
     ID_REC.MoveNext
     Wend
    ID_REC.Close
    Set ID_REC = Nothing
    'gd1.Refresh
Error_Handler:

End Sub

Private Sub flex_refresh()
On Error Resume Next
    Dim ID_REC As ADODB.Recordset
    Set ID_REC = New ADODB.Recordset
    ID_REC.Source = "SELECT * FROM  N_SPB"
    Set ID_REC.ActiveConnection = objConn
    ID_REC.CursorType = adOpenDynamic
    ID_REC.LockType = adLockOptimistic
    ID_REC.Open
    
    Call Flex_full(gd1, t_bt, ID_REC, t_fields, t_fdcounts - 1, t_fdxs)
    ID_REC.Close
    Set ID_REC = Nothing
    'gd1.Refresh
Error_Handler:
End Sub

Private Sub flex_refresh1()
On Error Resume Next
    Dim ID_REC As ADODB.Recordset
    Set ID_REC = New ADODB.Recordset
    ID_REC.Source = "SELECT * FROM  N_SPB where menu='" & Trim(Combo1.Text) & "'"
    Set ID_REC.ActiveConnection = objConn
    ID_REC.CursorType = adOpenDynamic
    ID_REC.LockType = adLockOptimistic
    ID_REC.Open
    
    Call Flex_full(gd1, t_bt, ID_REC, t_fields, t_fdcounts - 1, t_fdxs)
    ID_REC.Close
    Set ID_REC = Nothing
    'gd1.Refresh
Error_Handler:
End Sub

Private Sub combo_refresh()
On Error Resume Next
    Dim ID_REC As ADODB.Recordset
    Set ID_REC = New ADODB.Recordset
    ID_REC.Source = "SELECT * FROM  N_MENU"
    Set ID_REC.ActiveConnection = objConn
    ID_REC.CursorType = adOpenDynamic
    ID_REC.LockType = adLockOptimistic
    ID_REC.Open
     While Not ID_REC.EOF
      Combo1.AddItem (ID_REC("menu"))
     ID_REC.MoveNext
     Wend
    Set ID_REC = Nothing
Error_Handler:
End Sub

Private Sub gd1_click()
'Text6.Text = gd1.TextArray(gd1.Row * 4 + 0)
Text1.Text = gd1.TextArray(gd1.Row * 4 + 1)
Text2.Text = gd1.TextArray(gd1.Row * 4 + 2)
Text3.Text = gd1.TextArray(gd1.Row * 4 + 3)
Command2.Enabled = False
Command8(0).Enabled = True
Command8(1).Enabled = True
End Sub


Private Sub command6_Click()
Command6.Visible = False
'Line1.Visible = False
t_fields = Array("ID", "WP", "WPJG", "WPMS") '设置显示字段
t_fdxs = Array(0, 0, 0, 0) '设置显示字段
t_bt = "<ID  | <物品名            |<单价（元）    |<说明              "   '设置显示表头格式
t_fdcounts = 4
t_pri = Array("ID", "物品名 ", "单价（元）", "说明")
Command2.Enabled = True
Command8(0).Enabled = False
Command8(1).Enabled = False
Call flex_refresh
 
End Sub