frmfk.frm

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

               NumButtonMenus  =   2
               BeginProperty ButtonMenu1 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                  Key             =   "set"
                  Text            =   "(&C) 打印设置..."
               EndProperty
               BeginProperty ButtonMenu2 {66833FEE-8583-11D1-B16A-00C0F0283628} 
                  Key             =   "print"
                  Text            =   "(&P) 打印..."
               EndProperty
            EndProperty
         EndProperty
         BeginProperty Button7 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button8 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Enabled         =   0   'False
            Caption         =   "单据生效"
            Key             =   "check"
            Object.ToolTipText     =   "单据生效"
            ImageIndex      =   7
         EndProperty
         BeginProperty Button9 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button10 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "关闭返回"
            Key             =   "return"
            Object.ToolTipText     =   "关闭返回"
            ImageIndex      =   11
         EndProperty
      EndProperty
      Begin VB.Timer TimeDate 
         Interval        =   1000
         Left            =   6000
         Top             =   330
      End
      Begin Threed.SSPanel lbStatus 
         Height          =   630
         Left            =   7995
         TabIndex        =   5
         Top             =   150
         Width           =   2160
         _Version        =   65536
         _ExtentX        =   3810
         _ExtentY        =   1111
         _StockProps     =   15
         Caption         =   "全球通商务管理系统"
         ForeColor       =   255
         BackColor       =   12632256
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "Fixedsys"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         BorderWidth     =   1
         BevelOuter      =   0
         RoundedCorners  =   0   'False
         FloodColor      =   16776960
         FloodShowPct    =   0   'False
         Alignment       =   0
         Autosize        =   1
         Begin VB.Label lbDate 
            AutoSize        =   -1  'True
            Caption         =   "00:00:00"
            ForeColor       =   &H00404040&
            Height          =   180
            Left            =   1020
            TabIndex        =   7
            Top             =   330
            Width           =   720
         End
         Begin VB.Label Label4 
            Caption         =   "现在时间："
            ForeColor       =   &H00404040&
            Height          =   240
            Left            =   120
            TabIndex        =   6
            Top             =   345
            Width           =   975
         End
      End
   End
End
Attribute VB_Name = "frmFK"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim New_AniCur As New AniCursor
Dim New_AniCur1 As New AniCursor  '动画光标

Dim UnitID_old As String
Dim ProductID_old As String
Dim Grid_old As GridCoord
Dim EnterType As Integer
Dim GetProduct As ProductRef
Dim GuestLay As Integer
Dim ProductLay As Integer
Dim SheetChange As Boolean
Dim sType As Integer  '当前类型

Private Sub cmdDisplayorder_Click()

  ConfigAcount "Select * From Account Where Type='付款单' Order By ID"

End Sub

Private Sub cmdExit_Click()
  
  MovePic picSelectSuppler, False, Me, txtUnitID, Grid2
  
End Sub

Private Sub cmdReturn_Click()

    If picBrowser.left >= 0 Then
        If txtUnitID.Enabled = True Then
           tbOrder.Buttons(6).Enabled = True
           tbOrder.Buttons(8).Enabled = True
           tbOrder.Buttons(2).Enabled = True
           Else
           tbOrder.Buttons(6).Enabled = False
        End If
           tbOrder.Buttons(4).Enabled = True
        MovePic picBrowser, False, Me, txtUnitID, Grid4
        tbOrder.Buttons(1).Enabled = True
        Exit Sub
     End If

End Sub

Private Sub cmdSearchOrder_Click()
 
  Dim sSQL As String
  If optStatus(0).Value = True Then
     sSQL = " And IsAcc=0 Order By ID"
  End If
  If optStatus(1).Value = True Then
     sSQL = " And IsAcc=1 Order By ID"
  End If
  If optStatus(2).Value = True Then
     sSQL = " Order By ID"
  End If
   If Trim(txtSupplerName.Text) = "" Then
      ConfigAcount "Select * From Account Where  (Type='付款单' And Date>=#" & dtStartDate.Value & "# And Date<=#" & dtEndDate.Value & "#)" & sSQL
    Else
      ConfigAcount "Select * From Account Where  (Type='付款单' And Date>=#" & dtStartDate.Value & "# And Date<=#" & dtEndDate.Value & "#) And (UnitName Like '*" & Trim(txtSupplerName.Text) & "*' or UnitID Like '*" & Trim(txtSupplerName.Text) & "*')" & sSQL
   End If
    
End Sub

Private Sub cmdSelectGuest_Click()

   On Error Resume Next
   MovePic picSelectSuppler, True, Me, txtUnitID, Grid2
   
End Sub

Private Sub Command1_Click()

  Me.MousePointer = 11
  If Trim(txtSearch.Text) <> "" Then
     If InStr(1, txtSearch.Text, "'", vbTextCompare) Then
        MsgBox "对不起，查询的供应商名称中不能有《'》号？    ", vbInformation
        Exit Sub
      Else
        ConfigSuppler "Select  * From Suppler Where UnitID Like '*" & Trim(txtSearch.Text) & "*' Or UnitName Like '*" & Trim(txtSearch.Text) & "*'", False
     End If
  End If
  Me.MousePointer = 0

End Sub

Private Sub Command2_Click()
   
  If GuestLay = 2 Then
     ConfigSuppler "Select  * From SupplerType", True
  End If
  
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 = "FK200"
    Screen.MousePointer = 11
   '安装项目
    GuestLay = 1
    StartLoad
    New_AniCur.AniFileName = App.Path & "\sys\2.ani"
    New_AniCur.SetAniCursor cmdSelectGuest.hwnd
    Screen.MousePointer = 0
   
End Sub

Private Sub Form_Resize()

 If Me.WindowState = 1 Then Exit Sub
 On Error Resume Next
 lbStatus.left = Me.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 picSelectSuppler
      .Width = Me.ScaleWidth
      .left = 0 - .Width
      .tOp = tbOrder.Height + 40
      .Height = Me.ScaleHeight - tbOrder.Height - 40
 End With
 With picBrowser
      .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)
 
  New_AniCur.RelaseAniCursor cmdSelectGuest.hwnd
  Set New_AniCur = Nothing
  
End Sub



Private Sub Grid2_DblClick()
   
   On Error Resume Next
   If Grid2.Text = "" Then
      Exit Sub
   End If
   If GuestLay = 2 Then
     MovePic picSelectSuppler, False, Me, txtUnitID, Grid2
     txtUnitID.Text = Grid2.TextMatrix(Grid2.Row, 1)
     lbUnit = Grid2.TextMatrix(Grid2.Row, 2)
     txtFK.Text = Grid2.TextMatrix(Grid2.Row, 6)
     txtFK.SetFocus
    Exit Sub
   End If
   If GuestLay = 1 Then
      ConfigSuppler "Select * From Suppler Where Class='" & Grid2.Text & "'", False
   End If
   
End Sub

Private Sub Grid2_KeyPress(KeyAscii As Integer)

  If Grid2.Text = "" Then
      Exit Sub
    End If
    
  If KeyAscii = 13 Then
     KeyAscii = 0
   If GuestLay = 2 Then
    Me.txtUnitID.Text = Grid2.TextMatrix(Grid2.Row, 1)
    Me.lbUnit = Grid2.TextMatrix(Grid2.Row, 2)
    MovePic picSelectSuppler, False, Me, txtUnitID, Grid2
    Exit Sub
   End If
   If GuestLay = 1 Then
      ConfigSuppler "Select * From Suppler Where Class='" & Grid2.Text & "'", False
   End If
  End If
  
End Sub

Private Sub Grid4_DblClick()

  If Trim(Grid4.Text) = "" Then Exit Sub
     ShowOrder Grid4.Text
     If txtUnitID.Enabled = True Then
        tbOrder.Buttons(6).Enabled = True
        tbOrder.Buttons(8).Enabled = True
        tbOrder.Buttons(2).Enabled = True
     End If
        tbOrder.Buttons(4).Enabled = True
        tbOrder.Buttons(1).Enabled = True
        MovePic picBrowser, False, Me, txtUnitID, Grid4
        
End Sub

Private Sub picBrowser_Resize()
 
  On Error Resume Next
  Grid4.left = 0
  Grid4.tOp = 0
  Grid4.Width = picBrowser.ScaleWidth
  Grid4.Height = picBrowser.ScaleHeight - picTool1.Height - 100
  picTool1.left = 0
  picTool1.tOp = Grid4.Height + 50
  picTool1.Width = Grid4.Width

End Sub

Private Sub picSelectSuppler_Resize()
 
  On Error Resume Next
  Grid2.left = 0
  Grid2.tOp = 0
  Grid2.Width = picSelectSuppler.ScaleWidth
  Grid2.Height = picSelectSuppler.ScaleHeight - picTool.Height - 100
  picTool.left = 0
  picTool.tOp = Grid2.Height + 50
  picTool.Width = Grid2.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"
     If txtUnitID.Enabled = True Then   '编辑时，保存当前改变的记录
        SaveRecord False
     End If
     CreateOrder
     txtUnitID.SetFocus