frm0001.frm

便利店管理系统 VB+ACCESS 附上数据库和源码

   Begin VB.TextBox txSName 
      BackColor       =   &H00C0FFFF&
      Height          =   315
      Left            =   4080
      Locked          =   -1  'True
      TabIndex        =   17
      Top             =   540
      Width           =   1875
   End
   Begin VB.TextBox txPvID 
      Height          =   315
      Left            =   900
      TabIndex        =   34
      Top             =   0
      Visible         =   0   'False
      Width           =   315
   End
   Begin VB.TextBox txSID 
      Height          =   315
      Left            =   4020
      TabIndex        =   35
      Top             =   420
      Visible         =   0   'False
      Width           =   315
   End
   Begin VB.Label lbDate 
      Alignment       =   1  'Right Justify
      Caption         =   "时间"
      Height          =   255
      Left            =   6000
      TabIndex        =   36
      Top             =   180
      Width           =   675
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000005&
      Index           =   1
      X1              =   0
      X2              =   10000
      Y1              =   1395
      Y2              =   1395
   End
   Begin VB.Line Line1 
      Index           =   0
      X1              =   0
      X2              =   10000
      Y1              =   1380
      Y2              =   1380
   End
   Begin VB.Label lbMerchandise 
      Alignment       =   1  'Right Justify
      Caption         =   "商品"
      Height          =   195
      Left            =   3180
      TabIndex        =   21
      Top             =   600
      Width           =   840
   End
   Begin VB.Label lbRemark 
      Alignment       =   1  'Right Justify
      Caption         =   "备注"
      Height          =   195
      Left            =   6600
      TabIndex        =   33
      Top             =   1020
      Width           =   600
   End
   Begin VB.Label lbStorage 
      Alignment       =   1  'Right Justify
      Caption         =   "库存"
      Height          =   195
      Left            =   1980
      TabIndex        =   32
      Top             =   1020
      Width           =   660
   End
   Begin VB.Label lbBill 
      Alignment       =   1  'Right Justify
      Caption         =   "单据号"
      Height          =   195
      Left            =   3180
      TabIndex        =   28
      Top             =   180
      Width           =   840
   End
   Begin VB.Label lbTotal 
      Alignment       =   1  'Right Justify
      Caption         =   "合计"
      Height          =   195
      Left            =   3540
      TabIndex        =   27
      Top             =   5700
      Width           =   960
   End
   Begin VB.Label lbSubTotal 
      Alignment       =   1  'Right Justify
      Caption         =   "小计"
      Height          =   195
      Left            =   4980
      TabIndex        =   26
      Top             =   1020
      Width           =   720
   End
   Begin VB.Label lbPrice 
      Alignment       =   1  'Right Justify
      Caption         =   "单价"
      Height          =   195
      Left            =   3360
      TabIndex        =   25
      Top             =   1020
      Width           =   720
   End
   Begin VB.Label lbPurchaseAmount 
      Alignment       =   1  'Right Justify
      Caption         =   "采购数量"
      Height          =   195
      Left            =   0
      TabIndex        =   24
      Top             =   1020
      Width           =   1260
   End
   Begin VB.Label lbBarCode 
      Alignment       =   1  'Right Justify
      Caption         =   "条形码"
      Height          =   195
      Left            =   60
      TabIndex        =   23
      Top             =   600
      Width           =   840
   End
   Begin VB.Label lbUnit 
      Alignment       =   1  'Right Justify
      Caption         =   "单位"
      Height          =   195
      Left            =   5940
      TabIndex        =   22
      Top             =   600
      Width           =   720
   End
   Begin VB.Label lbProvider 
      Alignment       =   1  'Right Justify
      Caption         =   "供货商"
      Height          =   195
      Left            =   60
      TabIndex        =   20
      Top             =   180
      Width           =   840
   End
End
Attribute VB_Name = "frm0001"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub LoadFormLang()
    Me.Caption = getFormCaptionResource("0001")
    
    Me.lbProvider.Caption = getResource("resProvider")
    Me.lbBill.Caption = getResource("resBill")
    Me.lbDate.Caption = getResource("resDate")
    Me.lbMerchandise.Caption = getResource("resMerchandise")
    Me.lbBarCode.Caption = getResource("resBarCode")
    Me.lbUnit.Caption = getResource("resUnit")
    Me.lbPurchaseAmount.Caption = getResource("resPurchase") & getResource("resAmount")
    Me.lbStorage.Caption = getResource("resStorage")
    Me.lbPrice.Caption = getResource("resPrice")
    Me.lbSubTotal.Caption = getResource("resSubTotal")
    Me.lbRemark.Caption = getResource("resRemark")
    Me.lbTotal.Caption = getResource("resTotal")
    
    Me.lbAddProvider.Caption = getResource("resAdd") & getResource("resProvider") & ">>"
    Me.lbAddMerchandise.Caption = getResource("resAdd") & getResource("resMerchandise") & ">>"
    
    Me.lbAddMerchandise.Enabled = (curSystemUser.uOp0201 > 0)
    Me.lbAddProvider.Enabled = (curSystemUser.uOp0202 > 0)
    
    Me.cmdCheckIn.Caption = getResource("resCheckIn") & "(&Z)"
    Me.cmdDelRow.Caption = getResource("resDelRow") & "(&X)"
    Me.cmdEmptyTable.Caption = getResource("resEmptyTable") & "(&D)"
    Me.cmdCheckOut.Caption = getResource("resCheckOut") & "(&C)"
    Me.cmdPrint.Caption = getResource("resPrint") & "(&P)"
    Me.cmdExit.Caption = getResource("resExit") & "(Esc)"
    
    Me.dgImPort.Columns("pvName").Caption = getResource("resProvider")
    Me.dgImPort.Columns("Bill").Caption = getResource("resBill")
    Me.dgImPort.Columns("sName").Caption = getResource("resMerchandise")
    Me.dgImPort.Columns("BarCode").Caption = getResource("resBarCode")
    Me.dgImPort.Columns("Unit").Caption = getResource("resUnit")
    Me.dgImPort.Columns("Price").Caption = getResource("resPrice")
    Me.dgImPort.Columns("Amount").Caption = getResource("resPurchase") & getResource("resAmount")
    Me.dgImPort.Columns("SubTotal").Caption = getResource("resSubTotal")
    Me.dgImPort.Columns("Remark").Caption = getResource("resRemark")
    
End Sub

Private Sub RefreshForm()
    Me.txPvID.Text = ""
    Me.txPvName.Text = ""
    Me.txSBill.Text = ""
    Me.txSID.Text = ""
    Me.dtpSOpDate.Value = Date
    Me.txSName.Text = ""
    Me.txSBarCode.Text = ""
    Me.txSUnit.Text = ""
    Me.txSimAmount.Text = "0"
    Me.txSAmount.Text = "0"
    Me.txSImPrice.Text = "0"
    Me.txSUnit.Text = "0"
    Me.txSSubtotal.Text = "0"
    Me.txSRemark.Text = ""
    
    myDE.rsrsImPort.Requery
    Set Me.dgImPort.DataSource = myDE
    Me.dgImPort.DataMember = "rsImPort"
    Me.dgImPort.Refresh
    
    myDE.rsrsImPortTotal.Requery
    myDE.rsrsImPortTotal.MoveFirst
    Me.txSTotal.Text = Format$(myDE.rsrsImPortTotal.Fields("Total").Value & "", "##,##0.00")
    
    If myDE.rsrsImPort.RecordCount > 0 Then
        Me.cmdDelRow.Enabled = True
        Me.cmdEmptyTable.Enabled = True
        Me.cmdCheckOut.Enabled = True
        Me.cmdPrint.Enabled = True
    Else
        Me.cmdDelRow.Enabled = False
        Me.cmdEmptyTable.Enabled = False
        Me.cmdCheckOut.Enabled = False
        Me.cmdPrint.Enabled = False
    End If
    
End Sub
Private Sub cauSubTotal()
'计算每种产品金额小计
On Error GoTo errDealWith
    Me.txSSubtotal.Text = CStr(CDbl(Me.txSimAmount.Text) * CDbl(Me.txSImPrice.Text))
    
Exit Sub
errDealWith:
    Me.txSSubtotal.Text = "0"
End Sub

Private Sub cmdBarCode_Click()
    frmStorage.Show 1
    Me.txSID.Text = curStorage.sID
    Me.txSName.Text = curStorage.sName
    Me.txSBarCode.Text = curStorage.sBarCode
    Me.txSUnit.Text = curStorage.sUnit
    Me.txSImPrice.Text = curStorage.sImPrice
    Me.txSAmount.Text = curStorage.sAmount

End Sub

Private Sub cmdCheckIn_Click()
On Error GoTo errHandel
    If Not TestText(Me.txPvName.Text) Then
        Me.txPvID.Text = "0"
    End If
        
    If Not TestText(Me.txSBarCode.Text) Then
        MsgBox getResource("resMsgF0001001"), vbCritical + vbOKOnly
        Me.txSBarCode.SetFocus
        Exit Sub
    End If
    
    If Not TestText(Me.txSimAmount.Text) Then
        MsgBox getResource("resMsgF0001002"), vbCritical + vbOKOnly
        Me.txSimAmount.SetFocus
        Exit Sub
    End If
    If CDbl(Me.txSimAmount.Text) = 0 Then
        MsgBox getResource("resMsgF0001002"), vbCritical + vbOKOnly
        Me.txSimAmount.SetFocus
        Exit Sub
    End If
    
    If Not TestText(Me.txSImPrice.Text) Then
        MsgBox getResource("resMsgF0001003"), vbCritical + vbOKOnly
        Me.txSImPrice.SetFocus
        Exit Sub
    End If
    If CDbl(Me.txSImPrice.Text) = 0 Then
        MsgBox getResource("resMsgF0001003"), vbCritical + vbOKOnly
        Me.txSImPrice.SetFocus
        Exit Sub
    End If
    
    If Not TestText(Me.txSSubtotal.Text) Then
        MsgBox getResource("resMsgF0001004"), vbCritical + vbOKOnly
        Me.txSSubtotal.SetFocus
        Exit Sub
    End If
    If CDbl(Me.txSSubtotal.Text) = 0 Then
        MsgBox getResource("resMsgF0001004"), vbCritical + vbOKOnly
        Me.txSSubtotal.SetFocus
        Exit Sub
    End If
    
    
    With curImExPort
        .pcID = Me.txPvID.Text
        .ieBill = Me.txSBill.Text
        .sID = Me.txSID.Text
        .iePrice = Me.txSImPrice.Text
        .ieAmount = Me.txSimAmount.Text
        .ieOpDate = Me.dtpSOpDate.Value
        .iekind = 1
        .ieFlag = 0
        .ieOperator = curSystemUser.uID   '操作员
        .ieRemark = Me.txSRemark
    End With
    
    Call ImExPortAddNew(curImExPort)
    
    Call RefreshForm
    
Exit Sub
errHandel:
    MsgBox Err.Description, vbCritical
End Sub



Private Sub cmdCuName_Click()
    frmProvider.Show 1
    Me.txPvID.Text = curProvider.pID
    Me.txPvName.Text = curProvider.pName

End Sub

Private Sub cmdDelRow_Click()
    If MsgBox(getResource("resMsgF0001005"), vbQuestion + vbYesNo) = vbYes Then
        Call RunSql("DELETE FROM ImExPort WHERE ID=" & Me.dgImPort.Columns("ID").Value)
    End If
    
    Call RefreshForm
End Sub

Private Sub cmdEmptyTable_Click()
    If MsgBox(getResource("resMsgF0001006"), vbQuestion + vbYesNo) = vbYes Then
        Call RunSql("DELETE FROM ImExPort WHERE Kind=1 AND Flag=0")
    End If
    
    Call RefreshForm
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdCheckOut_Click()
Dim sql1 As String
Dim sql2 As String

    '将未入库商品数量加入库存
    sql1 = "UPDATE ImExPort INNER JOIN Storage ON ImExPort.sID = Storage.ID " & _
            "SET Storage.Amount = [ImExPort].[Amount]+[Storage].[Amount] " & _
            "WHERE (((ImExPort.kind)=1) AND ((ImExPort.flag)=0)) "
    '将未入库商品标记为已入库
    sql2 = "UPDATE ImExPort SET Flag =1 WHERE Kind=1 AND Flag=0"
    
    If RunSql(sql1) And RunSql(sql2) Then
        MsgBox getResource("resMsgF0001007"), vbInformation + vbOKOnly
    Else
        MsgBox getResource("resMsgF0001008"), vbInformation + vbOKOnly
    End If
    
    Call RefreshForm
End Sub

Private Sub Form_Load()
'    Me.Top = 500
'    Me.Left = 500
  
    myDE.rsrsImPortTotal.Open
    
    Call LoadFormLang
    
    Call RefreshForm
End Sub

Private Sub Form_Unload(Cancel As Integer)
    myDE.rsrsImPortTotal.Close
End Sub

Private Sub lbAddMerchandise_Click()
    frm0201.Show
    frm0201.ZOrder 0
End Sub

Private Sub lbAddMerchandise_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.lbAddMerchandise.BorderStyle = 1
End Sub

Private Sub lbAddMerchandise_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.lbAddMerchandise.BorderStyle = 0
End Sub

Private Sub lbAddProvider_Click()
    frm0202.Show
    frm0202.ZOrder 0
End Sub

Private Sub lbAddProvider_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.lbAddProvider.BorderStyle = 1
End Sub

Private Sub lbAddProvider_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Me.lbAddProvider.BorderStyle = 0
End Sub

Private Sub txSimAmount_Change()
    Call cauSubTotal
End Sub

Private Sub txSimAmount_KeyPress(KeyAscii As Integer)
    KeyAscii = CheckInt(KeyAscii, Me.txSimAmount.Text)
End Sub

Private Sub txSImPrice_Change()
    Call cauSubTotal
End Sub

Private Sub txSImPrice_KeyPress(KeyAscii As Integer)
    KeyAscii = CheckDec(KeyAscii, Me.txSImPrice.Text)
End Sub

Private Sub txSSubtotal_KeyPress(KeyAscii As Integer)
    KeyAscii = CheckDec(KeyAscii, Me.txSSubtotal.Text)
End Sub