form_product.frm

来自「仓库扫描管理系统」· FRM 代码 · 共 552 行 · 第 1/2 页

FRM
552
字号
         Index           =   3
         Left            =   360
         TabIndex        =   22
         Top             =   1095
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "规    格:"
         Height          =   255
         Index           =   4
         Left            =   4200
         TabIndex        =   21
         Top             =   1065
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "单    位:"
         Height          =   255
         Index           =   5
         Left            =   360
         TabIndex        =   20
         Top             =   1740
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "皮    重:"
         Height          =   255
         Index           =   6
         Left            =   4200
         TabIndex        =   19
         Top             =   1815
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "标    准:"
         Height          =   255
         Index           =   7
         Left            =   360
         TabIndex        =   18
         Top             =   2385
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "产    地:"
         Height          =   255
         Index           =   8
         Left            =   4200
         TabIndex        =   17
         Top             =   2460
         Width           =   1095
      End
      Begin VB.Label lblLabels 
         Caption         =   "备注:"
         Height          =   255
         Index           =   9
         Left            =   360
         TabIndex        =   16
         Top             =   3015
         Visible         =   0   'False
         Width           =   1095
      End
   End
   Begin VB.Data Data1 
      Align           =   2  'Align Bottom
      Connect         =   "Access"
      DatabaseName    =   "E:\datum\应用软件\物流管理\warehouse\DB-Access\hunterPOS.mdb"
      DefaultCursorType=   0  'DefaultCursor
      DefaultType     =   2  'UseODBC
      Exclusive       =   0   'False
      Height          =   345
      Left            =   0
      Options         =   0
      ReadOnly        =   0   'False
      RecordsetType   =   1  'Dynaset
      RecordSource    =   "select * from hpos_products"
      Top             =   6660
      Width           =   10905
   End
End
Attribute VB_Name = "form_product"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private sqlData As String
Private isAdd As Boolean

Private Sub cmdAdd_Click()
    isAdd = True
    Data1.Recordset.AddNew
    SSTab1.Tab = 1
    txtFieldGetFocus (1)
End Sub

Private Sub cmdDelete_Click()
  If Data1.Recordset.RecordCount = 0 Then
    MsgBox "没有记录可删除!", vbCritical, "警告"
    Exit Sub
  End If
  
  Dim productId As Integer
  productId = Data1.Recordset.Fields("productId")
  Dim rsTmp As Recordset
  Dim sql As String
  sql = "SELECT * FROM hpos_StockIncomeBill_Dtl WHERE productId=" + CStr(productId) _
    & " union all SELECT * FROM hpos_StockOutBill_Dtl WHERE productId=" + CStr(productId)
  Set rsTmp = g_db.OpenRecordset(sql)
  If Not rsTmp.EOF Then
     MsgBox "入库单或者出库单中已经引用该物料,不能删除!", vbCritical, "警告"
     Exit Sub
  End If
  
  If MsgBox("真的要删除吗?", vbYesNo + vbDefaultButton2, "提示") = vbYes Then
    Data1.Recordset.Delete
    Data1.Recordset.MoveNext
    SSTab1.Tab = 0
  End If
End Sub

Private Sub cmdEdit_Click()
  If Data1.Recordset.RecordCount = 0 Then
    MsgBox "没有记录可修改,请先新增!", vbCritical, "警告"
    Exit Sub
  End If
    SSTab1.Tab = 1
    txtFieldGetFocus (1)
End Sub

Private Sub cmdQuery_Click()
Dim fldName As String
If (cmbField.Text = "编号") Then
  fldName = "productCode"
End If
If (cmbField.Text = "名称") Then
  fldName = "productName"
End If

Data1.RecordSource = sqlData & " and ( " + fldName + " like " + Chr(34) + "*" + txtConditon.Text + "*" + Chr(34) + ")"
Data1.Refresh
End Sub

Private Sub cmdRefresh_Click()
  isAdd = False
  txtConditon.Text = "*"
  SSTab1.Tab = 0
  Data1.RecordSource = sqlData
  Data1.Refresh
End Sub

Private Sub cmdClose_Click()
  Unload Me
End Sub

Private Sub cmdSave_Click()
  If isAdd = False And Data1.Recordset.RecordCount = 0 Then
    MsgBox "没有记录可保存,请先新增!", vbCritical, "警告"
    Exit Sub
  End If
  Data1.UpdateRecord
  Data1.Recordset.Bookmark = Data1.Recordset.LastModified
  MsgBox "保存成功!", vbInformation, "提示"
  SSTab1.Tab = 0
  isAdd = False
End Sub

Private Sub Data1_Error(DataErr As Integer, Response As Integer)
  'This is where you would put error handling code
  'If you want to ignore errors, comment out the next line
  'If you want to trap them, add code here to handle them
  MsgBox "Data error event hit err:" & Error$(DataErr)
  Response = 0  'throw away the error
End Sub

Private Sub Data1_Reposition()
  Screen.MousePointer = vbDefault
  On Error Resume Next
  'This will display the current record position
  'for dynasets and snapshots
'  Data1.Caption = "Record: " & (Data1.Recordset.AbsolutePosition + 1)
  Data1.Caption = "第 " & (Data1.Recordset.AbsolutePosition + 1) & " 条记录!"
  'for the table object you must set the index property when
  'the recordset gets created and use the following line
  'Data1.Caption = "Record: " & (Data1.Recordset.RecordCount * (Data1.Recordset.PercentPosition * 0.01)) + 1
End Sub

Private Sub Data1_Validate(Action As Integer, Save As Integer)
  'This is where you put validation code
  'This event gets called when the following actions occur
  Select Case Action
    Case vbDataActionMoveFirst
    Case vbDataActionMovePrevious
    Case vbDataActionMoveNext
    Case vbDataActionMoveLast
    Case vbDataActionAddNew
    Case vbDataActionUpdate
    Case vbDataActionDelete
    Case vbDataActionFind
    Case vbDataActionBookmark
    Case vbDataActionClose
  End Select
  Screen.MousePointer = vbHourglass
End Sub

Private Sub DBGrid1_DblClick()
  SSTab1.Tab = 1
End Sub

Private Sub DBGrid1_KeyUp(KeyCode As Integer, Shift As Integer)
  If (DBGrid1.col = 16 And KeyCode = vbKeyReturn And DBGrid1.row < Data1.Recordset.RecordCount - 1) Then
    DBGrid1.row = DBGrid1.row + 1
    DBGrid1.col = 0
  End If
End Sub

Private Sub Form_Load()
    isAdd = False
  Data1.DatabaseName = g_dbPath
  sqlData = "select * from hpos_products where 1=1 "
  Data1.RecordSource = sqlData
  Me.Left = (Screen.Width - Me.Width) / 2
  Me.Top = (Screen.Height - Me.Height) / 2
  
  DBGrid1.AllowAddNew = False
  DBGrid1.AllowUpdate = False
  DBGrid1.AllowDelete = False

   cmbField.AddItem "编号", 0
   cmbField.AddItem "名称", 1
   cmbField.Text = "编号"
  
  SSTab1.Tab = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
  frm_main.Enabled = True
  Screen.MousePointer = vbDefault
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
    If PreviousTab = 0 Then
        If isAdd = False And Data1.Recordset.RecordCount = 0 Then
          SSTab1.Tab = 0
          MsgBox "没有详细数据可看,请先新增!", vbCritical, "警告"
          Exit Sub
        End If
        txtFieldGetFocus (1)
    End If
End Sub

Private Sub txtFields_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
 Dim maxIndex As Integer
 maxIndex = 8
 If KeyCode = vbKeyReturn Then     '按回车键
   If (Index < maxIndex) Then
      txtFieldGetFocus (Index + 1)
    End If
    If (Index = maxIndex) Then
      cmdSave.SetFocus
    End If
 End If
End Sub

Private Sub txtFieldGetFocus(i As Integer)
        txtFields(i).SelStart = 0
        txtFields(i).SelLength = Len(txtFields(i).Text)
        txtFields(i).SetFocus
End Sub

Private Sub txtFields_LostFocus(Index As Integer)
    If Index = 6 And Not IsNumeric(txtFields(6).Text) Then
        txtFields(6).Text = "0.00"
    End If
End Sub

⌨️ 快捷键说明

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