form3.frm

[smith.rar] - smith原图

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form Form3 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form3"
   ClientHeight    =   5655
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7815
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5655
   ScaleWidth      =   7815
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox sfje 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   4800
      TabIndex        =   6
      Top             =   4020
      Width           =   975
   End
   Begin VB.CommandButton Command1 
      Caption         =   "结帐"
      Height          =   375
      Left            =   2160
      TabIndex        =   5
      Top             =   4920
      Width           =   3735
   End
   Begin MSFlexGridLib.MSFlexGrid jsb 
      Height          =   2175
      Left            =   240
      TabIndex        =   2
      Top             =   1680
      Width           =   7395
      _ExtentX        =   13044
      _ExtentY        =   3836
      _Version        =   393216
      Cols            =   7
      FixedCols       =   0
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1800
      TabIndex        =   1
      Top             =   690
      Width           =   855
   End
   Begin VB.Label Label3 
      Caption         =   "实付金额："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   3720
      TabIndex        =   7
      Top             =   4080
      Width           =   1050
   End
   Begin VB.Label heji 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   1800
      TabIndex        =   4
      Top             =   4035
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "累计金额："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   720
      TabIndex        =   3
      Top             =   4080
      Width           =   1050
   End
   Begin VB.Label Label1 
      Caption         =   "上机牌号："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   600
      TabIndex        =   0
      Top             =   720
      Width           =   1095
   End
End
Attribute VB_Name = "Form3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rsprice As New ADODB.Recordset
Dim dayprice As Currency
Dim sjds As Integer
Dim inputcno() As String

Private Sub Command1_Click()
If Not IsNumeric(sfje.Text) Then
   MsgBox "实付金额不对"
   Exit Sub
End If

Dim rs1 As New ADODB.Recordset
Call bas.openrs(rs1, "select kh,edate,etime,jzflag,jzys,jzss,yyy from 营业流水 where jzflag=false")
If jsb.Rows = 2 Then
rs1.MoveFirst
jsb.Row = 1
jsb.Col = 0
rs1.Find "kh=" + jsb.Text
jsb.Col = 3
rs1!edate = DateValue(jsb.Text)
jsb.Col = 4
rs1!etime = TimeValue(jsb.Text)
jsb.Col = 6
rs1!jzys = Val(jsb.Text)
rs1!jzss = Val(sfje.Text)
rs1!jzflag = True
rs1!yyy = usname
rs1.Update

zxrs = zxrs - 1
sykw = sykw + 1
tcash = tcash + Val(sfje.Text)

Else
    Dim diffje As Currency
    Dim i As Integer
    diffje = FormatNumber((Val(sfje.Text) - Val(heji.Caption)) / (jsb.Rows - 1), 2, vbTrue)
For i = 1 To jsb.Rows - 1
    jsb.Row = i
    jsb.Col = 0
    rs1.MoveFirst
    rs1.Find "kh=" + jsb.Text
    jsb.Col = 3
    rs1!edate = DateValue(jsb.Text)
    jsb.Col = 4
    rs1!etime = TimeValue(jsb.Text)
    jsb.Col = 6
    rs1!jzys = Val(jsb.Text)
    rs1!jzss = Val(jsb.Text) + diffje
    tcash = tcash + Val(jsb.Text) + diffje
    rs1!jzflag = True
    rs1!yyy = usname
    rs1.Update

    zxrs = zxrs - 1
    sykw = sykw + 1
    
Next i
    
End If
rs1.Close
Set rs1 = Nothing
Form1.lzxrs.Caption = zxrs
Form1.lsykw.Caption = sykw
Form1.Lcash.Caption = Str(tcash)


Command1.Enabled = False
heji.Caption = "0"
jsb.Rows = 1
jsb.Row = 0
jsb.Col = 0
jsb.Text = "卡号"
jsb.Col = 1
jsb.Text = "上机日期"
jsb.Col = 2
jsb.Text = "上机时间"
jsb.Col = 3
jsb.Text = "下机日期"
jsb.Col = 4
jsb.Text = "下机时间"
jsb.Col = 5
jsb.Text = "上机时长"
jsb.Col = 6
jsb.Text = "应收金额"

ReDim inputcno(0)

End Sub

Private Sub Form_Load()

Call bas.openrs(rsprice, "select sum(s2eprice) as dayprce ,count(s2eprice) as sjd from 价格表")
sjds = rsprice!sjd
dayprice = rsprice!dayprce
rsprice.Close
Call bas.openrs(rsprice, "select * from 价格表 order by bh")
'Form1.Enabled = False
Command1.Enabled = False
heji.Caption = "0"
jsb.Rows = 1
jsb.Row = 0
jsb.Col = 0
jsb.Text = "卡号"
jsb.Col = 1
jsb.Text = "上机日期"
jsb.Col = 2
jsb.Text = "上机时间"
jsb.Col = 3
jsb.Text = "下机日期"
jsb.Col = 4
jsb.Text = "下机时间"
jsb.Col = 5
jsb.Text = "上机时长"
jsb.Col = 6
jsb.Text = "应收金额"
jsb.AllowUserResizing = flexResizeColumns
ReDim inputcno(0)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'On Error Resume Next
rsprice.Close
Set rsprice = Nothing
'Form1.Enabled = True
db.Close
db.Open
Form1.Adodc1.Refresh
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)

If KeyAscii = 13 Then
   Dim tprice As Currency
   
   If Not IsNumeric(Text1.Text) Or (Val(Text1.Text) <= 0 Or Val(Text1.Text) > jqcount) Or Fix(Val(Text1.Text)) <> Val(Text1.Text) Then
      MsgBox "牌号输入错误"
      Text1.Text = ""
      Exit Sub
   End If
   Dim rs1 As New ADODB.Recordset
   Call bas.openrs(rs1, "select * from 营业流水 where jzflag=false and kh=" + LTrim(Trim(Text1.Text)))
   If rs1.EOF() And rs1.BOF() Then
      MsgBox Text1.Text + "号牌未被领用"
      Text1.Text = ""
      rs1.Close
      Set rs1 = Nothing
      Exit Sub
   End If
   
   Dim iii As Integer
   
   For iii = 0 To UBound(inputcno)
       If LTrim(Trim(inputcno(iii))) = LTrim(Trim(Text1.Text)) Then
          MsgBox "输入卡号不能重复"
          Text1.Text = ""
          rs1.Close
          Set rs1 = Nothing
          Exit Sub
       End If
   Next iii
       ReDim Preserve inputcno(UBound(inputcno) + 1)
       inputcno(UBound(inputcno)) = Text1.Text
   
   
   
   
   
   
   If Command1.Enabled = False Then Command1.Enabled = True
  Dim enddate As Date
  Dim endtime As Date
  Dim days, sdh, edh As Integer
  enddate = Date
  endtime = Time
  days = IIf(Time >= rs1!stime, DateDiff("d", rs1!sdate, enddate), DateDiff("d", rs1!sdate, enddate) - 1)
  tprice = dayprice * days
  
  If sjds > 1 Then
  rsprice.MoveFirst
  Do While Not rsprice.EOF
     If rsprice!etime > rsprice!stime Then
        If rs1!stime >= rsprice!stime And rs1!stime < rsprice!etime Then
           sdh = rsprice!bh
           tprice = ((Hour(rsprice!etime) - Hour(rs1!stime)) * 60 + Minute(rsprice!etime) - Minute(rs1!stime)) * rsprice!price / 60 + tprice
        End If
        If endtime >= rsprice!stime And endtime < rsprice!etime Then
           edh = rsprice!bh
           tprice = ((Hour(endtime) - Hour(rsprice!stime)) * 60 + Minute(endtime) - Minute(rsprice!stime)) * rsprice!price / 60 + tprice
        End If
     Else
        If (rs1!stime >= rsprice!stime And rs1!stime <= TimeSerial(23, 59, 59)) Or (rs1!stime >= TimeSerial(0, 0, 0) And rs1!stime < rsprice!etime) Then
            sdh = rsprice!bh
            If rs1!stime >= rsprice!stime And rs1!stime <= TimeSerial(23, 59, 59) Then
               tprice = ((Hour(rsprice!etime) - Hour(rs1!stime) + 24) * 60 + Minute(rsprice!etime) - Minute(rs1!stime)) * rsprice!price / 60 + tprice
            Else
               tprice = ((Hour(rsprice!etime) - Hour(rs1!stime)) * 60 + Minute(rsprice!etime) - Minute(rs1!stime)) * rsprice!price / 60 + tprice
            End If
        End If
        If (endtime >= rsprice!stime And endtime <= TimeSerial(23, 59, 59)) Or (endtime >= TimeSerial(0, 0, 0) And endtime < rsprice!etime) Then
            edh = rsprice!bh
           If endtime >= rsprice!stime And endtime <= TimeSerial(23, 59, 59) Then
              tprice = ((Hour(endtime) - Hour(rsprice!stime)) * 60 + Minute(endtime) - Minute(rsprice!stime)) * rsprice!price / 60 + tprice
           Else
              tprice = ((Hour(endtime) - Hour(rsprice!stime) + 24) * 60 + Minute(endtime) - Minute(rsprice!stime)) * rsprice!price / 60 + tprice
           End If
        End If
        
     End If
     rsprice.MoveNext
  Loop
  
  Dim ii, jj As Integer
  jj = sdh
  For ii = 1 To sjds
      If jj = sjds Then jj = 0
      jj = jj + 1
      If jj = edh Then Exit For
      rsprice.MoveFirst
      rsprice.Find "bh=" + Str(jj)
      tprice = tprice + rsprice!s2eprice
  Next ii
      If sdh = edh Then
         rsprice.MoveFirst
         rsprice.Find "bh=" + Str(sdh)
         If endtime >= rs1!stime Then
            tprice = dayprice * days + ((Hour(endtime) - Hour(rs1!stime)) * 60 + Minute(endtime) - Minute(rs1!stime)) * rsprice!price / 60
         Else
            tprice = dayprice * days + ((Hour(endtime) - Hour(rs1!stime) + 24) * 60 + Minute(endtime) - Minute(rs1!stime)) * rsprice!price / 60
         End If
      End If
  Else
  rsprice.MoveFirst
  If endtime >= rs1!stime Then
     tprice = tprice + ((Hour(endtime) - Hour(rs1!stime)) * 60 + Minute(endtime) - Minute(rs1!stime)) * rsprice!price / 60
  Else
     tprice = tprice + ((Hour(endtime) - Hour(rs1!stime) + 24) * 60 + Minute(endtime) - Minute(rs1!stime)) * rsprice!price / 60
  End If
  End If
  
  jsb.Rows = jsb.Rows + 1
  jsb.Row = jsb.Rows - 1
  jsb.Col = 0
  jsb.Text = rs1!kh
  jsb.Col = 1
  jsb.Text = rs1!sdate
  jsb.Col = 2
  jsb.Text = rs1!stime
  jsb.Col = 3
  jsb.Text = enddate
  jsb.Col = 4
  jsb.Text = endtime
  jsb.Col = 5
  jsb.Text = difftime(rs1!sdate, rs1!stime, enddate, endtime)
  jsb.Col = 6
  jsb.Text = FormatNumber(tprice, 2, vbTrue)
  heji.Caption = Val(heji.Caption) + Val(jsb.Text)
  sfje.Text = heji.Caption
  Text1.Text = ""
  rs1.Close
 Set rs1 = Nothing
  
End If

End Sub