frmsaleform.frm

前台POS系统,VB源码.程序没有调试,

            Grid1.TextMatrix(Grid1.Row, 2) = GetProduct.Name
            Grid1.TextMatrix(Grid1.Row, 3) = GetProduct.Unit
            For X = 1 To CodeQua
                Grid1.TextMatrix(Grid1.Row, 3 + X) = 0
            Next
            Grid1.TextMatrix(Grid1.Row, 4 + CodeQua) = GetProduct.Price
            Grid1.TextMatrix(Grid1.Row, 5 + CodeQua) = 0
        End If
        Grid1.Col = 4   'Return price cell
        Grid1.RowSel = Grid1.Row
        Grid1.ColSel = 4
     End If
  End If
  
End Sub

Private Sub txtFK_Change()

 If txtFK.Enabled = False Then Exit Sub

   If txtFK.Text = "" Then
      txtFK.Text = 0
   End If
   If lbAmo.Caption = "" Then
      lbAmo.Caption = 0
   End If
   
   lbZL.Caption = CCur(txtFK.Text) - CCur(lbAmo.Caption)
   
End Sub

Private Sub txtFK_GotFocus()

 If txtFK.Enabled = False Then Exit Sub
   Grid1.Col = 1
   Grid1.ColSel = 1
   txtFK.Text = lbAmo.Caption
   txtFK.SetFocus
   
End Sub

Private Sub txtSearch_Change()

    If Trim(txtSearch.Text) <> "" Then
       Command1.Enabled = True
     Else
       Command1.Enabled = False
    End If
     
End Sub

Private Sub ProductSearch(sU As String, sTable As String)

 '该供应商、与客户是否存在
 'sTable区分供应商还是客户
  sU = Trim(sU)
  
  If sU = "" Then Exit Sub
  If InStr(1, sU, "'", vbTextCompare) Then Exit Sub
  
  'dim Con as Database
  Dim rRecord As Recordset
  Dim sSQL As String
  
   '
   '   set con=opendatabase(condata,0,0,constr)
   Dim Con As Database
   Set Con = OpenDatabase(ConData, 0, 0, ConStr)
      sSQL = "Select  * From " & sTable & " Where GoodsID='" & sU & "'"
      Set rRecord = Con.OpenRecordset(sSQL, dbOpenDynaset)
      'rRecord.Open sSql, Con, adOpenStatic, adLockPessimistic, adCmdText
      
   If rRecord.EOF Then
      '没有查找到时
       GetProduct.Exsite = False
       MsgBox "产品编号没有找到，请重新输入...    " & vbCrLf & vbCrLf & "如果忘记了产品编号，请按按钮选择。", vbInformation
    Else
       GetProduct.Exsite = True
       GetProduct.ID = sU
       GetProduct.Name = rRecord.Fields("GoodsName")
       GetProduct.Price = rRecord.Fields("Price1")
       GetProduct.Unit = rRecord.Fields("Unit")
   End If
      rRecord.Close
      Con.Close
      Set rRecord = Nothing
      Set Con = Nothing
End Sub

Private Sub Reserved(KeyCode As Integer)

  Dim lRow As Integer
  Dim lCol As Integer
  
 Select Case KeyCode
 
  Case 37   '左
     Grid1.Text = txtEdit.Text
     lRow = Grid1.Row
     lCol = Grid1.Col
    If lCol = 1 Then '第一列时
       If lRow = 1 Then
          Exit Sub
         ' lRow = Grid1.Rows - 1
        Else
          lRow = Grid1.Row - 1
       End If
       If Trim(Grid1.TextMatrix(Grid1.Row, 2)) = "" Then
        Exit Sub
       End If
       lCol = Grid1.Cols - 1
     Else
       lCol = Grid1.Col - 1
    End If
    Grid1.Row = lRow
    Grid1.Col = lCol
    Grid1.ColSel = lCol
    txtEdit.Text = Grid1.Text
  Case 38  '上
    Grid1.Text = txtEdit.Text
    lRow = Grid1.Row
    lCol = Grid1.Col
    If lRow = 1 Then '最后一行
       Exit Sub
    '   lRow = Grid1.Rows - 1
     Else
       lRow = Grid1.Row - 1
    End If
    Grid1.Row = lRow
    Grid1.Col = lCol
    Grid1.ColSel = lCol
  Case 39  '右
     'If Grid1.Col = 1 And Grid1.Row >= 1 And Trim(txtEdit.Text) <> "" Then
     '   Call txtEdit_KeyPress(13)
     '   Exit Sub
     'End If
     Grid1.Text = txtEdit.Text
     lRow = Grid1.Row
     lCol = Grid1.Col
    If lCol = Grid1.Cols - 1 Then '最后一列时
          lRow = Grid1.Row + 1
       If Trim(Grid1.TextMatrix(Grid1.Row, 2)) = "" Then
          Exit Sub
       End If
       If lRow > Grid1.Rows - 1 Then
          lRow = 1
       End If
          lCol = 1
     Else
      lCol = Grid1.Col + 1
    End If
    Grid1.Row = lRow
    Grid1.Col = lCol
    Grid1.ColSel = lCol
    txtEdit.Text = Grid1.Text
  Case 40  '下
    If Trim(Grid1.TextMatrix(Grid1.Row, 2)) = "" Then
       Exit Sub
    End If
    Grid1.Text = txtEdit.Text
    lRow = Grid1.Row
    lCol = Grid1.Col
    If lRow = Grid1.Rows - 1 Then '最后一行
       lRow = 1
     Else
       lRow = Grid1.Row + 1
    End If
    Grid1.Row = lRow
    Grid1.Col = lCol
    Grid1.ColSel = lCol
  End Select
End Sub

Private Sub AcountThis()

  Dim X As Integer, Y As Integer
  Dim CQua As Currency
  Dim cAmo As Currency
      CQua = 0: cAmo = 0
     For X = 1 To Grid1.Rows - 1
         For Y = 1 To CodeQua
            If Trim(Grid1.TextMatrix(X, 3 + Y)) <> "" Then
              CQua = CQua + CCur(Grid1.TextMatrix(X, 3 + Y))
            End If
         Next
     Next
     lbQua.Caption = CQua
      For X = 1 To Grid1.Rows - 1
         If Trim(Grid1.TextMatrix(X, 5 + CodeQua)) <> "" Then
            cAmo = cAmo + CCur(Grid1.TextMatrix(X, 5 + CodeQua))
         End If
     Next
     lbAmo.Caption = cAmo
     
End Sub

Private Sub ConfigProduct(sSQL As String, bContent As Boolean)
  
  On Error GoTo Err_S
  'dim Con as Database
  'Dim rRecord As Recordset
  '
  '    set con=opendatabase(condata,0,0,constr)     '打开ODBC数据源
  'Set rRecord = New Recordset
  '    rRecord.Open sSql, Con, adOpenStatic, adLockPessimistic, adCmdText
  Dim Con As Database
  Dim rRecord As Recordset
  Set Con = OpenDatabase(ConData, 0, 0, ConStr)
  Set rRecord = Con.OpenRecordset(sSQL, dbOpenDynaset)
  If bContent = False Then
     ProductLay = 2
  '配置网格
   Grid3.Visible = False
   Grid3.Clear
   Grid3.Cols = 7 + CodeQua
   Dim sFormat As String
   Dim X As Integer
   For X = 1 To CodeQua
       sFormat = sFormat & "|<    " & CodeName(X)
   Next
   Grid3.FormatString = "..|<产品编号|<产品名称|<单位 |<单价 " & sFormat & "|<数量小计|<产品分类"
   Grid3.ColWidth(0) = 200
   Grid3.ColWidth(1) = 1600
   Grid3.ColWidth(2) = 2600
   Grid3.ColWidth(3) = 800
   Grid3.ColWidth(4) = 1000
   For X = 1 To CodeQua
       Grid3.ColWidth(X + 4) = 800
   Next
   Grid3.ColWidth(5 + CodeQua) = 1300
   If rRecord.BOF Or rRecord.EOF Then
      rRecord.Close
      Con.Close
      Set rRecord = Nothing
      Set Con = Nothing
   Else
      Dim GridNO As Long
      Do While Not rRecord.EOF
         GridNO = GridNO + 1
         rRecord.MoveNext
      Loop
         Grid3.BackColorSel = SelectBackColor
         Grid3.ForeColorSel = SelectForeColor
         Grid3.Rows = GridNO + 5
         If Grid3.Rows < 32 Then  '缺省的30行
            Grid3.Rows = 32
         End If
        '定义三种颜色:    红、绿、黑
         Dim fColor As Long, lMax As Long, lMin As Long, lSum As Long
      If rRecord.BOF And rRecord.EOF Then
         Else
         rRecord.MoveFirst
             hh = 1
         Do While Not rRecord.EOF
            Grid3.Row = hh
            Grid3.Col = 5 + CodeQua
            Grid3.CellAlignment = 1
            If Not IsNull(rRecord.Fields("SumQua")) Then
                   lSum = rRecord.Fields("SumQua"): lMin = rRecord.Fields("MinRec"): lMax = rRecord.Fields("MaxRec")
               If (lSum >= lMin) And (lSum <= lMax) Then
                  '黑色
                  bColor = &H0&
                 Else
                  If lSum > lMax Then bColor = &HFF&     '红色
                  If lSum < lMin Then bColor = &HC000& '绿色
               End If
              Grid3.CellForeColor = bColor
              Grid3.Text = lSum
            End If
            Grid3.Col = 1
            Grid3.CellAlignment = 1
            Grid3.CellForeColor = bColor
            If Not IsNull(rRecord.Fields("GoodsID")) Then
               Grid3.Text = rRecord.Fields("GoodsID")
            End If
            Grid3.Col = 2
            Grid3.CellForeColor = bColor
            Grid3.CellAlignment = 1
            If Not IsNull(rRecord.Fields("GoodsName")) Then
               Grid3.Text = rRecord.Fields("GoodsName")
            End If
            Grid3.Col = 3
            Grid3.CellAlignment = 1
            Grid3.CellForeColor = bColor
            If Not IsNull(rRecord.Fields("Unit")) Then
               Grid3.Text = rRecord.Fields("Unit")
            End If
            Grid3.Col = 4
            Grid3.CellAlignment = 1
            Grid3.CellForeColor = bColor
            If Not IsNull(rRecord.Fields("Price1")) Then
               Grid3.Text = rRecord.Fields("Price1")
            End If
            For X = 1 To CodeQua
                Grid3.Col = X + 4
                Grid3.CellAlignment = 1
                Grid3.CellForeColor = bColor
                If Not IsNull(rRecord.Fields(X + 12)) Then
                   Grid3.Text = rRecord.Fields(X + 12)
                End If
            Next
            Grid3.Col = 6 + CodeQua
            Grid3.CellForeColor = bColor
            Grid3.CellAlignment = 1
            If Not IsNull(rRecord.Fields("Class")) Then
               Grid3.Text = rRecord.Fields("Class")
            End If
            rRecord.MoveNext
            hh = hh + 1
         Loop
      End If
    rRecord.Close
    Con.Close
    Set rRecord = Nothing
    Set Con = Nothing
    Grid3.Row = 1
    Grid3.Col = 1
  End If
    Grid3.ColSel = 6 + CodeQua
    Grid3.Visible = True
 Else '配置Content网格
   ProductLay = 1
   Grid3.Visible = False
   Grid3.Clear
   Grid3.Cols = 2
   Grid3.FormatString = "..|^* * * * * * * * * *   产 品 分 类  * * * * * * * * * *"
   Grid3.ColWidth(0) = 200
   Grid3.ColWidth(1) = 11800

   If rRecord.BOF Or rRecord.EOF Then
      rRecord.Close
      Con.Close
      Set rRecord = Nothing
      Set Con = Nothing
   Else
      Do While Not rRecord.EOF
         GridNO = GridNO + 1
         rRecord.MoveNext
      Loop
         Grid3.BackColorSel = SelectBackColor
         Grid3.ForeColorSel = SelectForeColor
         Grid3.Rows = GridNO + 5
         If Grid3.Rows < 32 Then  '缺省的30行
            Grid3.Rows = 32
         End If
      If rRecord.BOF And rRecord.EOF Then
         Else
         rRecord.MoveFirst
             hh = 1
         Do While Not rRecord.EOF
            Grid3.Row = hh
            Grid3.Col = 1
            Grid3.CellAlignment = 4
            If Not IsNull(rRecord.Fields("Class")) Then
               Grid3.Text = rRecord.Fields("Class")
            End If
            rRecord.MoveNext
            hh = hh + 1
         Loop
      End If
    rRecord.Close
    Con.Close
    Set rRecord = Nothing
    Set Con = Nothing
    Grid3.Row = 1
    Grid3.Col = 1
  End If
    Grid3.ColSel = 1
    Grid3.Visible = True
 End If
    
   Exit Sub
Err_S:
  MsgBox "很抱歉，不能正常配置网格（或查询供应商） " & vbCrLf & vbCrLf & "：请 WWW.VB-CODE.NET,网咨询   " & vbCrLf & vbCrLf & Err.Description, vbInformation, "Error for form load."
  Exit Sub

End Sub

Private Sub Grid3_DblClick()
   
   If Grid3.Text = "" Then
      Exit Sub
   End If
   If ProductLay = 2 Then