frmcustomer.frm

机房管理

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmCustomer 
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "消费列表"
   ClientHeight    =   4440
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7980
   Icon            =   "frmCustomer.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4440
   ScaleWidth      =   7980
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdPast 
      BackColor       =   &H00C0C0C0&
      Height          =   435
      Left            =   6450
      Picture         =   "frmCustomer.frx":000C
      Style           =   1  'Graphical
      TabIndex        =   16
      Top             =   2565
      Width           =   1215
   End
   Begin VB.CommandButton cmdDel 
      Height          =   435
      Left            =   6450
      Picture         =   "frmCustomer.frx":1778
      Style           =   1  'Graphical
      TabIndex        =   6
      Top             =   2100
      Width           =   1215
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0C0C0&
      Height          =   1215
      Left            =   165
      TabIndex        =   9
      Top             =   105
      Width           =   7620
      Begin VB.TextBox txtDW 
         BackColor       =   &H00E0E0E0&
         ForeColor       =   &H000000FF&
         Height          =   285
         Left            =   6540
         Locked          =   -1  'True
         TabIndex        =   2
         TabStop         =   0   'False
         ToolTipText     =   "禁止修改"
         Top             =   353
         Width           =   855
      End
      Begin VB.TextBox txtJH 
         BackColor       =   &H00E0E0E0&
         ForeColor       =   &H000000FF&
         Height          =   285
         Left            =   1215
         Locked          =   -1  'True
         TabIndex        =   0
         TabStop         =   0   'False
         ToolTipText     =   "禁止修改"
         Top             =   353
         Width           =   1035
      End
      Begin VB.TextBox txtDJ 
         BackColor       =   &H00E0E0E0&
         ForeColor       =   &H000000FF&
         Height          =   285
         Left            =   1215
         MaxLength       =   12
         TabIndex        =   3
         ToolTipText     =   "禁止修改"
         Top             =   750
         Width           =   1050
      End
      Begin VB.TextBox txtSL 
         Height          =   285
         Left            =   3630
         MaxLength       =   8
         TabIndex        =   4
         Text            =   "1"
         Top             =   750
         Width           =   2085
      End
      Begin VB.ComboBox cmbPM 
         Height          =   300
         Left            =   3630
         Sorted          =   -1  'True
         TabIndex        =   1
         Top             =   345
         Width           =   2085
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "( 按 + 添加记录 )"
         ForeColor       =   &H000000C0&
         Height          =   180
         Left            =   5940
         TabIndex        =   15
         Top             =   825
         Width           =   1530
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "单位:"
         Height          =   180
         Index           =   1
         Left            =   6015
         TabIndex        =   14
         Top             =   405
         Width           =   450
      End
      Begin VB.Label Label6 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "计算机号:"
         ForeColor       =   &H000000FF&
         Height          =   180
         Left            =   300
         TabIndex        =   13
         Top             =   405
         Width           =   810
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "单价(元):"
         Height          =   180
         Left            =   300
         TabIndex        =   12
         Top             =   795
         Width           =   810
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "所购数量:"
         Height          =   180
         Left            =   2715
         TabIndex        =   11
         Top             =   795
         Width           =   810
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "物品名称:"
         Height          =   180
         Index           =   0
         Left            =   2715
         TabIndex        =   10
         Top             =   405
         Width           =   810
      End
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Height          =   435
      Left            =   6450
      Picture         =   "frmCustomer.frx":2EE4
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   3120
      Width           =   1215
   End
   Begin VB.CommandButton cmdAdd 
      Height          =   435
      Left            =   6450
      Picture         =   "frmCustomer.frx":4650
      Style           =   1  'Graphical
      TabIndex        =   5
      Top             =   1635
      Width           =   1215
   End
   Begin MSFlexGridLib.MSFlexGrid Grid1 
      Height          =   2745
      Left            =   195
      TabIndex        =   8
      Top             =   1500
      Width           =   5850
      _ExtentX        =   10319
      _ExtentY        =   4842
      _Version        =   393216
      Cols            =   3
      BackColorSel    =   14737632
      ForeColorSel    =   0
      BackColorBkg    =   12632256
      AllowBigSelection=   0   'False
      FocusRect       =   0
      ScrollBars      =   2
      SelectionMode   =   1
      BorderStyle     =   0
      Appearance      =   0
   End
   Begin VB.Line Line1 
      X1              =   180
      X2              =   180
      Y1              =   1485
      Y2              =   4245
   End
   Begin VB.Line Line2 
      BorderColor     =   &H00FFFFFF&
      X1              =   6045
      X2              =   6045
      Y1              =   1470
      Y2              =   4260
   End
   Begin VB.Line Line3 
      BorderColor     =   &H00FFFFFF&
      X1              =   195
      X2              =   6060
      Y1              =   4260
      Y2              =   4260
   End
   Begin VB.Line Line4 
      X1              =   180
      X2              =   6045
      Y1              =   1470
      Y2              =   1470
   End
End
Attribute VB_Name = "frmCustomer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim sDJ As String

Private Sub cmbPM_Click()

    '查询到名称时
    txtDJ = GetDJ(cmbPM)
    sDJ = txtDJ
    txtDW = sDW  '给出单位
    If txtSL.Visible Then
       txtSL.SetFocus
    End If
    
End Sub

Private Sub cmbPM_KeyPress(KeyAscii As Integer)
 
 On Error GoTo Err_dj
 
 If KeyAscii = 13 And cmbPM.Text <> "" Then
    ' 如果是代码时查询名称
    If GetPm(cmbPM) = "" Then  '没有此名称时
       '查询是否是代码
       If GetCode(cmbPM) = "" Then '退出
          ' 清空输入的内容
            cmbPM = ""  '名称为空
            txtDW = ""  '单位为空
            txtDJ = ""  '单价为空
            Exit Sub
         Else
            cmbPM = GetCode(cmbPM) '代码替代名称
       End If
    End If
    '查询到名称时
    txtDJ = GetDJ(cmbPM)
    sDJ = txtDJ
    txtDW = sDW  '给出单位
    txtSL.SetFocus
 End If
 
 Exit Sub
Err_dj:
 MsgBox "给出单价错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical

End Sub

Private Sub cmdAdd_Click()

 On Error GoTo Err_Add
  If cmbPM = "" Then
     txtDW = ""
     txtDJ = ""
     cmbPM.SetFocus
     Exit Sub ' 名称为空时退出
  End If
  If Val(txtSL) > 0 And Val(txtDJ) > 0 Then  '有值时
  ' 添加记录
  AddRecord cmbPM.Text, "名称", Val(txtDJ), "单价", Val(txtSL), "数量", Val(txtDJ) * Val(txtSL), "金额", txtJH, "房号", Date, "日期", "Customer"
  
  ' 刷新
  ConfigGrid
  
  ' 返回
  cmbPM = ""
  txtDW = ""
  txtDJ = ""
  cmbPM.SetFocus
 End If
 
  Exit Sub
Err_Add:
 MsgBox "添加记录或配置网格错误!    " & vbCrLf & vbCrLf & Err.Description, vbCritical
 
End Sub

Private Sub cmdCancel_Click()

  Unload Me
  
End Sub

Private Sub ConfigGrid()

On Error GoTo Err_grid
sJE = 0
Grid1.Visible = False
Grid1.Clear
Grid1.Cols = 6
Grid1.FormatString = "^ .. |^ 物品名称 |^ 单价 |^ 数量 |^ 金额 | 状态 "
Grid1.ColWidth(0) = 710
Grid1.ColWidth(1) = 1600
Grid1.ColWidth(2) = 800
Grid1.ColWidth(3) = 800
Grid1.ColWidth(4) = 1070
Grid1.ColWidth(5) = 880

Dim GridColor As Long

Dim DB As Database, Ef As Recordset, HH As Integer, DelNo As Long
Dim shiftStr As String, shiftStrL As String, shiftStrR As String, shiftNum As Integer, ili As Integer, TempStr As String, sureStr As String, Qy As Integer
    Set DB = OpenDatabase(ConData, False, False, ConStr)
    'Set DB = OpenConnection(ConData, dbDriverNoPrompt, False, ConStr)
    
    Set Ef = DB.OpenRecordset("Customer", dbOpenTable)
        DelNo = Ef.RecordCount
        Grid1.Rows = Ef.RecordCount + 2
    Set Ef = DB.OpenRecordset("Select * From Customer Where 房号='" & sJH & "'", dbOpenDynaset)
        HH = 1
        Do While Not Ef.EOF()
        
        ' 已送与未送区别
        If Not IsNull(Ef.Fields(7).Value) Then
           If Ef.Fields(7).Value = "已送" Then
              GridColor = &H8000&
             Else
              GridColor = &H80FF&
           End If
        End If
           
           Grid1.Row = HH
           Grid1.Col = 0
           Grid1.CellAlignment = 4
           Grid1.CellForeColor = GridColor
        If Not IsNull(Ef.Fields(0).Value) Then
           Grid1.Text = Ef.Fields(0).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 1
           Grid1.CellForeColor = GridColor
        If Not IsNull(Ef.Fields(1).Value) Then
           Grid1.Text = Ef.Fields(1).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 2
           Grid1.CellAlignment = 1
           Grid1.CellForeColor = GridColor
        If Not IsNull(Ef.Fields(3).Value) Then
           Grid1.Text = Ef.Fields(3).Value
        End If
           Grid1.Row = HH
           Grid1.Col = 3
           Grid1.CellAlignment = 1
           Grid1.CellForeColor = GridColor
        If Not IsNull(Ef.Fields(4).Value) Then
           Grid1.Text = Ef.Fields(4).Value
        End If
           Dim zT As String
           Grid1.Row = HH
           Grid1.Col = 5
           Grid1.CellAlignment = 1
           Grid1.CellForeColor = GridColor
        If Not IsNull(Ef.Fields(7).Value) Then
           Grid1.Text = Ef.Fields(7).Value
           zT = Grid1.Text
        End If
           Grid1.Row = HH
           Grid1.Col = 4
           Grid1.CellAlignment = 7
           Grid1.CellForeColor = GridColor
        If Not IsNull(Ef.Fields(5).Value) Then
           Grid1.Text = Ef.Fields(5).Value
           If zT = "已送" Then
              sJE = sJE + Val(Grid1.Text)
           End If