⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 quickinput.frm

📁 这是一套超市完整的代码
💻 FRM
字号:
VERSION 5.00
Begin VB.Form quickinput 
   Caption         =   "快速输入"
   ClientHeight    =   1560
   ClientLeft      =   4245
   ClientTop       =   6495
   ClientWidth     =   5070
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1560
   ScaleWidth      =   5070
   Begin VB.CommandButton cmdend 
      Caption         =   "输入完毕"
      Height          =   375
      Left            =   3840
      TabIndex        =   6
      Top             =   960
      Width           =   855
   End
   Begin VB.CommandButton cmdquit 
      Caption         =   "取消"
      Height          =   375
      Left            =   2280
      TabIndex        =   5
      Top             =   960
      Width           =   855
   End
   Begin VB.CommandButton cmdok 
      Caption         =   "确定"
      Height          =   375
      Left            =   480
      TabIndex        =   4
      Top             =   960
      Width           =   975
   End
   Begin VB.TextBox Text2 
      Height          =   375
      Left            =   3600
      TabIndex        =   1
      Top             =   240
      Width           =   1335
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   1320
      TabIndex        =   0
      Top             =   240
      Width           =   1335
   End
   Begin VB.Label Label2 
      Caption         =   "数量:"
      Height          =   375
      Left            =   2880
      TabIndex        =   3
      Top             =   240
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "条形码编号:"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   1215
   End
End
Attribute VB_Name = "quickinput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdend_Click()
    Unload Me
    pay.Show 1
End Sub

Private Sub cmdok_Click()
    'Dim Mcon As ADODB.Connection
    'Set Mcon = New ADODB.Connection
    Dim rsMerchInfo As New ADODB.Recordset
    Dim mid As String
    Dim mname As String
    Dim mprice As Currency
    Dim mnum As Integer
    Dim mallowsell As Integer
    Dim mallowabate As Integer
    Dim memID As String
    Dim flag As Boolean
    'Static i As Integer
    Dim j As Integer
    'Dim temp1 As Integer
    'Static temp2 As Integer
    'Dim temp3 As Currency
    Dim flag3 As Boolean
    Dim k As Integer
    Dim num As Integer
    Dim mcode As String
    'Static total As Currency
    '打开数据库连接
    'Mcon.ConnectionString = "Provider=sqloledb;Data Source=172.27.2.249;Initial Catalog=SuperMarketdb;User Id=sa;Password=jszx;"
    'Mcon.Open
    
    rsMerchInfo.Open "SELECT MerchID,MerchName,MerchPrice ,MerchNum,BarCode,AllowAbate,AllowSale FROM MerchInfo", Mcon, adOpenStatic, adLockBatchOptimistic
    
    '获取记录
    Do While Not rsMerchInfo.EOF
        mid = rsMerchInfo!MerchID
        mcode = rsMerchInfo!BarCode
        mname = rsMerchInfo!MerchName
        mprice = rsMerchInfo!MerchPrice
        mnum = rsMerchInfo!MerchNum
        mallowabate = rsMerchInfo!AllowAbate
        mallowsell = rsMerchInfo!AllowSale
    '判断商品是否能销售
        If Text1.Text = "" Or Text2.Text = "" Then
            MsgBox "请输入商品ID和商品数量!", , "提示:"
            Text1.SetFocus
            Exit Sub
        End If
        If Text2.Text <= 0 Then
            MsgBox "请输入购买商品的正确数量!", , "提示:"
        End If
        
        If mcode = CStr(Text1.Text) Then
            If mallowsell = 0 Then
            MsgBox "该产品不允许销售!", , "警告:"
            Exit Sub
            Else
            flag = True
            rsMerchInfo.MoveFirst
            Exit Do
        End If
            Else: flag = False
        End If
        rsMerchInfo.MoveNext
    Loop
        
       '自动增加网格
        If (i + 2) > menu.MSHFlexGrid1.Rows And flag = True Then
            
        k = (i + 1) - menu.MSHFlexGrid1.Rows
        menu.MSHFlexGrid1.Rows = i + 2
        menu.Height = menu.Height + 300 * k
        menu.MSHFlexGrid1.Height = menu.MSHFlexGrid1.Height + k * 300
        menu.Label5.Top = menu.Label5.Top + k * 300
        menu.Label6.Top = menu.Label6.Top + k * 300
        menu.Label7.Top = menu.Label7.Top + k * 300
        menu.Label8.Top = menu.Label8.Top + k * 300
        menu.Label9.Top = menu.Label9.Top + k * 300
        menu.Label10.Top = menu.Label10.Top + k * 300
        menu.Line1.Y1 = menu.Line1.Y1 + k * 300
        menu.Line1.Y2 = menu.Line1.Y2 + k * 300
        menu.cmdinput.Top = menu.cmdinput.Top + k * 300
    End If
        

          

        
    If flag = True Then
        i = i + 1
        'number = i
        'For j = 1 To i
            'If mid = CStr(menu.MSHFlexGrid1.TextMatrix(j, 0)) Then
                'flag3 = True
                'menu.MSHFlexGrid1.TextMatrix(j, 3) = Str(Val(menu.MSHFlexGrid1.TextMatrix(j, 3)) + Val(Text2.Text))
                'Exit For
                'Else: flag3 = False
            
            'End If
        'Next j
        
        '在网格中显示数据
        'If flag3 = False Then
        
            menu.MSHFlexGrid1.TextMatrix(i, 0) = mid
            'temp1 = menu.MSHFlexGrid1.TextMatrix(i, 0)
            menu.MSHFlexGrid1.TextMatrix(i, 1) = mname
        
            menu.MSHFlexGrid1.TextMatrix(i, 2) = mprice
            'temp3 = menu.MSHFlexGrid1.TextMatrix(i, 2)
            menu.MSHFlexGrid1.TextMatrix(i, 3) = Text2.Text
            'temp2 = menu.MSHFlexGrid1.TextMatrix(i, 3)
        'End If
            
        '计算总值
        If flag2 = True And mallowabate = 1 Then
                total = total + mprice * 0.95 * CInt(Text2.Text)
                
        ElseIf flag2 = False Or mallowabate = 0 Then
                total = total + mprice * CInt(Text2.Text)
            
        End If
         'MsgBox total
        temp2 = total + mtotal
       
        
        Text1.Text = ""
        Text2.Text = ""
        Text1.SetFocus
        
        'Mcon.Execute ("update MerchInfo set MerchNum= " & temp3 & "  where MerchID =" & temp1 & "")
        
        Else: MsgBox "不存在该产品,请检查是否输入错误!", , "提示:"
        Text1.SetFocus
    End If
        rsMerchInfo.Close
    menu.Label10.Caption = total
    Text2.Text = 1
End Sub

Private Sub cmdquit_Click()
    Text1.Text = ""
    Text2.Text = ""
    Text1.SetFocus
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdok.SetFocus
        cmdok_Click
    End If
    
End Sub



Private Sub Form_Load()
    Text2.Text = 1
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdok_Click
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        cmdok_Click
    End If
    If KeyAscii < 57 And KeyAscii > 47 Or KeyAscii = 8 Then
        Else: MsgBox "请输入数字!", , "提示:"
    End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -