frmsaleform.frm

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

   On Error Resume Next
   FormID = "PD100"
   MovePic picSelectP, True, frmSaleForm, txtEdit, Grid3

End Sub

Private Sub Command3_Click()
  
  FormID = "SL100"
  MovePic picSelectP, False, frmOrder, txtEdit, Grid3

End Sub

Private Sub Command4_Click()

  Me.MousePointer = 11
  If Trim(FocusText1.Text) <> "" Then
     If InStr(1, FocusText1.Text, "'", vbTextCompare) Then
        MsgBox "对不起，查询的产品名称或编号不能有《'》号？    ", vbInformation
        Exit Sub
      Else
        ConfigProduct "Select  * From Goods Where GoodsID Like '*" & Trim(FocusText1.Text) & "*' Or GoodsName Like '*" & Trim(FocusText1.Text) & "*'", False
     End If
  End If
  Me.MousePointer = 0

End Sub

Private Sub Command5_Click()

  If ProductLay = 2 Then
     ConfigProduct "Select  * From ProductType", True
  End If

End Sub

Private Sub dtEndDate_Change()

   If dtStartDate.Value > dtEndDate Then
      dtStartDate.Value = dtEndDate.Value
   End If

End Sub

Private Sub dtStartDate_Change()
   
   If dtStartDate.Value > dtEndDate Then
      dtEndDate.Value = dtStartDate.Value
   End If

End Sub

Private Sub FocusText1_Change()

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

Private Sub FocusText1_KeyPress(KeyAscii As Integer)
   
   If KeyAscii = 13 And Trim(FocusText1.Text) <> "" Then
     If Command4.Enabled = True Then Call Command4_Click
   End If
   
End Sub


Private Sub Form_Load()

   FormID = "SL100"
   Screen.MousePointer = 11
   '安装项目
    StartLoad
   '配置网格
    ConfigData
    
   New_AniCur.AniFileName = App.Path & "\sys\2.ani"
   New_AniCur.SetAniCursor tbOrder.hwnd
   Screen.MousePointer = 0
   
End Sub

Private Sub Form_Resize()

 If Me.WindowState = 1 Then Exit Sub
 
 On Error Resume Next
 
 lbStatus.Left = tbOrder.Width - lbStatus.Width - 300
 lbStatus.Top = 150

 picOperator.Left = 20
 picOperator.Top = tbOrder.Height + 40
 picOperator.Width = Me.ScaleWidth - 40
 picOperator.Height = Me.ScaleHeight - tbOrder.Height - 60
 
 With picSelectP
      .Width = Me.ScaleWidth
      .Left = 0 - .Width
      .Top = tbOrder.Height + 40
      .Height = Me.ScaleHeight - tbOrder.Height - 40
 End With
 
End Sub

Private Sub Form_Unload(Cancel As Integer)

 '御载选择供应商窗体
  If SupplerForm = True Then
     Unload frmSuppler
  End If
  
  New_AniCur.RelaseAniCursor tbOrder.hwnd
  Set New_AniCur = Nothing
  
End Sub



Private Sub Grid3_KeyPress(KeyAscii As Integer)

  If Grid3.Text = "" Then
      Exit Sub
    End If
    
  If KeyAscii = 13 Then
     KeyAscii = 0
   If ProductLay = 2 Then
    frmOrder.txtEdit.Text = Grid3.TextMatrix(Grid3.Row, 1)
    MovePic picSelectP, False, frmOrder, txtEdit, Grid3
    Exit Sub
   End If
   If ProductLay = 1 Then
      ConfigProduct "Select * From Goods Where Class='" & Grid3.Text & "'", False
   End If
  End If

End Sub

Private Sub picOperator_Resize()

   On Error Resume Next
   Grid1.Left = 120
   Grid1.Top = 1800
   Grid1.Width = picOperator.Width - 300
   Grid1.Height = picOperator.Height - 2400
   Frame1.Top = picOperator.Height - 650
   Frame1.Left = 120
   Frame1.Width = Grid1.Width
   
End Sub

Private Sub picSelectP_Resize()
 
  On Error Resume Next
  Grid3.Left = 0
  Grid3.Top = 0
  Grid3.Width = picSelectP.ScaleWidth
  Grid3.Height = picSelectP.ScaleHeight - Picture1.Height - 100
  Picture1.Left = 0
  Picture1.Top = Grid3.Height + 50
  Picture1.Width = Grid3.Width

End Sub

Private Sub picTool_Resize()

   On Error Resume Next
   cmdExit.Left = picTool.Width - cmdExit.Width - 200

End Sub

Private Sub picTool1_Resize()

   On Error Resume Next
   cmdReturn.Left = picTool1.Width - cmdReturn.Width - 200

End Sub

Private Sub Picture1_Resize()
  
   On Error Resume Next
   Command3.Left = Picture1.Width - Command3.Width - 200

End Sub

Private Sub tbOrder_ButtonClick(ByVal Button As MSComctlLib.Button)

 Select Case Button.Key
 
   Case "new"
     FormID = "SL100"
     If txtFK.Enabled = True Then
        SaveRecord True
     End If
     CreateOrder
   Case "del"  'Delete
        DelDialog.Show 1
     If bDelSelect = 1 Then
        If Trim(Grid1.TextMatrix(Grid1.Row, 1)) = "" Then Exit Sub
        Grid1.RemoveItem Grid1.Row
        Grid1.AddItem bb
        'Refresh Acount
        AcountThis
        txtEdit.Text = Grid1.Text
        Grid1.Row = 1
        Grid1.Col = 1
        Grid1.ColSel = 1
      ElseIf bDelSelect = 2 Then
        'Delete Sheet
         If lbSheetID.Caption = "" Then Exit Sub
         DelRecord lbSheetID.Caption
         MaskAll True
     End If
   Case "check"
     SaveRecord True
   Case "return"
     If picSelectP.Left >= 0 Then
        FormID = "SL100"
        MovePic picSelectP, False, frmOrder, txtEdit, Grid3
        Exit Sub
     End If
     Unload Me
 End Select
 
End Sub
Private Sub tbOrder_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)

          '打印时给表头三部分+表名+行高++++++++++++++++++++++++++++++++++++++++++++++++++
             'On Error GoTo Print_Err
        Select Case FormID
          Case "SL100"
                Start_print.N_TiTle = "销售单"
                Start_print.N_Head10 = "单位：零售" & "   " & "ID：" & lbSheetID.Caption
                Start_print.N_Head11 = "制单：" & sUserName & "   " & "时间：" & dpDate.Value
                Start_print.N_Head2 = "数量：" & lbQua.Caption & "   " & "金额：" & lbAmo.Caption
                Set Start_print.N_Grid = Grid1
          Case "PD100"
                Start_print.N_TiTle = "产品报表"
                Start_print.N_Head10 = "制单人：" & sUserName
                Start_print.N_Head11 = ""
                Start_print.N_Head2 = "时间：" & Format(Now, "Long Date")
                Set Start_print.N_Grid = Grid3
        End Select
         Select Case ButtonMenu.Key
           Case "set"
                  '如果值改变，将保存新的记录
                  SavePrintSet Start_print, "Get", FormID '给出该ID配置
                  frmPrintSet.Show 1
                   If PrintSetChange = True Then
                      SavePrintSet Start_print, "Save", FormID
                   End If
           Case "print"
                 Start_print.PrintPage
         End Select
         
           '释放内存
          '打印结束++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
          Exit Sub
Print_Err:
          MsgBox "对不起，打印设置或打印错误，请与供应商联系！    " & vbCrLf & vbCrLf & " 电话：[phone] 8269007 [e-mail]   ", vbInformation
          Exit Sub
End Sub

Private Sub StartLoad()

   On Error Resume Next
   bDelSelect = 0
   lbOperator = sUserName
   dpDate.Value = Date
   txtUnitID.Text = sShopName
   
   ConfigProduct "Select * From ProductType", True
   '装载动画光标
   New_AniCur1.AniFileName = App.Path + "\sys\9.ani"
        
End Sub
Private Sub ConfigData()

  On Error GoTo Err_S
  '配置网格
   Grid1.Clear
   Grid1.Visible = False
   Grid1.Rows = 19
   Dim sFormat As String
   Dim X As Integer
   For X = 1 To CodeQua
       sFormat = sFormat & "|<" & CodeName(X)
   Next
   Grid1.FormatString = "^ |<产品编号|<产品名称|<单位" & sFormat & "|<单价 |<总额   "
   Grid1.ColWidth(0) = 200
   Grid1.ColWidth(1) = 2300
   Grid1.ColWidth(2) = 2660
   Grid1.ColWidth(3) = 1000
   'Code Qua starting ...
   For X = 1 To CodeQua
       Grid1.ColWidth(X + 3) = 800
   Next
   Grid1.ColWidth(4 + CodeQua) = 1200
   Grid1.ColWidth(5 + CodeQua) = 1750

    Grid1.Col = 0
    Grid1.Row = 1
    Grid1.Col = 1
    Grid1.ColSel = 1
    Grid1.Visible = True
    txtEdit = ""
    txtEdit.Left = (Grid1.Left + Grid1.CellLeft) - 10
    txtEdit.Top = Grid1.Top + Grid1.CellTop - 10
    txtEdit.Width = Grid1.CellWidth + 20
    cmdSelect.Top = Grid1.Top + Grid1.CellTop + 8
    cmdSelect.Left = txtEdit.Left + (txtEdit.Width - cmdSelect.Width) - 30

        
   Exit Sub
Err_S:
  MsgBox "很抱歉，不能正常配置网格：请到WWW.VB-CODE.NET网站咨询   " & vbCrLf & vbCrLf & Err.Description, vbInformation, "Error for form load."
  Exit Sub

End Sub

Private Sub TimeDate_Timer()

   lbDate.Caption = Format(Time, "hh:mm:ss AM/PM")
   
End Sub

Private Sub txtEdit_DblClick()

  If Grid1.Col = 1 Then
     Call cmdSelect_Click
  End If
  
End Sub

Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
 
  If Grid1.Col = 1 Then Exit Sub
     Reserved KeyCode
  
End Sub

Private Sub txtEdit_KeyPress(KeyAscii As Integer)


  If Grid1.Row = 0 Or Grid1.Col = 0 Then Exit Sub
  If Grid1.Col = 3 And Grid1.TextMatrix(Grid1.Row, 1) = "" Then
     KeyAscii = 0
     Exit Sub
  End If
  If Grid1.Col > 3 And Grid1.Col < 7 Then
    If Trim(Grid1.TextMatrix(Grid1.Row, 1)) = "" Then
        KeyAscii = 0
        MsgBox "很抱歉，请先输入产品编号之后才能输入！    ", vbInformation
        Exit Sub
    End If
   ElseIf Grid1.Col = 1 And KeyAscii = 13 Then
     If Trim(txtEdit.Text) = "" Then Exit Sub
       'Search UnitID
        ProductSearch Trim(txtEdit.Text), "Goods"
     If GetProduct.Exsite = False Then
        'Clear Data
         txtEdit.Text = Grid1.Text
         txtEdit.SetFocus
        Exit Sub
      ElseIf Grid1.TextMatrix(Grid1.Row, 4) = "" And Grid1.TextMatrix(Grid1.Row, 5) = "" Then
            Grid1.TextMatrix(Grid1.Row, 1) = GetProduct.ID
            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
            Grid1.Col = 4   'Return price cell
            Grid1.RowSel = Grid1.Row
            Grid1.ColSel = 4
        Else
        If Trim(Grid1.Text) <> Trim(txtEdit.Text) Then   'Same recorde
            Grid1.TextMatrix(Grid1.Row, 1) = GetProduct.ID