addproduct.frm

用VB做的一个数据库管理系统

VERSION 5.00
Begin VB.Form AddProduct 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   ClientHeight    =   2325
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5520
   Icon            =   "AddProduct.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2325
   ScaleWidth      =   5520
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.Frame Frame1 
      Caption         =   "新产品添加"
      ForeColor       =   &H00808000&
      Height          =   1815
      Left            =   330
      TabIndex        =   5
      Top             =   225
      Width           =   4815
      Begin VB.CommandButton Command2 
         Cancel          =   -1  'True
         Caption         =   "取消(&C)"
         Height          =   390
         Left            =   3435
         TabIndex        =   4
         Top             =   1275
         Width           =   1170
      End
      Begin VB.CommandButton Command1 
         Caption         =   "保存(&S)"
         Enabled         =   0   'False
         Height          =   405
         Left            =   3435
         TabIndex        =   3
         Top             =   870
         Width           =   1170
      End
      Begin VB.TextBox Text3 
         Height          =   270
         Left            =   1350
         MaxLength       =   8
         TabIndex        =   2
         Top             =   1260
         Width           =   1380
      End
      Begin VB.TextBox Text2 
         Height          =   270
         Left            =   1350
         MaxLength       =   8
         TabIndex        =   1
         ToolTipText     =   "双击选择单位"
         Top             =   855
         Width           =   1380
      End
      Begin VB.TextBox Text1 
         Height          =   270
         Left            =   1350
         MaxLength       =   25
         TabIndex        =   0
         Top             =   450
         Width           =   3240
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "单价："
         Height          =   180
         Left            =   705
         TabIndex        =   8
         Top             =   1275
         Width           =   540
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "单位："
         Height          =   180
         Left            =   705
         TabIndex        =   7
         Top             =   885
         Width           =   540
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "产品名称："
         Height          =   180
         Left            =   345
         TabIndex        =   6
         Top             =   495
         Width           =   900
      End
   End
   Begin VB.Menu MnuDangWei 
      Caption         =   "单位"
      Visible         =   0   'False
      Begin VB.Menu MnuGJ 
         Caption         =   "公斤"
      End
      Begin VB.Menu step1 
         Caption         =   "-"
      End
      Begin VB.Menu MnuD 
         Caption         =   "吨"
      End
      Begin VB.Menu step2 
         Caption         =   "-"
      End
      Begin VB.Menu MnuG 
         Caption         =   "个"
      End
      Begin VB.Menu step3 
         Caption         =   "-"
      End
      Begin VB.Menu MnuS 
         Caption         =   "双"
      End
      Begin VB.Menu step4 
         Caption         =   "-"
      End
      Begin VB.Menu MnuJ 
         Caption         =   "件"
      End
      Begin VB.Menu step5 
         Caption         =   "-"
      End
      Begin VB.Menu MnuT 
         Caption         =   "条"
      End
      Begin VB.Menu step6 
         Caption         =   "-"
      End
      Begin VB.Menu MnuH 
         Caption         =   "盒"
      End
      Begin VB.Menu step7 
         Caption         =   "-"
      End
      Begin VB.Menu MnuB 
         Caption         =   "把"
      End
   End
End
Attribute VB_Name = "AddProduct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Changed As Boolean
Private Sub Command1_Click()
'保存记录
  Dim DB As Database, RecStr As String, Ef As Recordset
  Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
  Set Ef = DB.OpenRecordset("CPK", dbOpenDynaset)
      RecStr = "产品类型='" & CpTypeName & "' and 产品名称='" & Trim(Text1.Text) & "'"
      Ef.FindFirst RecStr
   If Ef.NoMatch Then
      RecStr = "Insert Into CpK (产品类型,产品名称,单位,单价) Values('" & CpTypeName & "','" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "'," & Val(Text3.Text) & ")"
      DB.Execute RecStr
      DB.Close
      Changed = True
       Else
      DB.Close
      MsgBox "该产品已经存在,请更换!", vbOKOnly + 64, "重复产品"
   End If
   Text1.Text = ""
   Text3.Text = ""
   Text1.SetFocus
End Sub

Private Sub Command2_Click()
If Changed = False Then
   Unload Me
   Exit Sub
End If
'配置网格Grid1
CKCPGL.Grid1.Visible = False
CKCPGL.Grid1.Clear
CKCPGL.Grid1.Cols = 4
CKCPGL.Grid1.FormatString = "^ 序号 | 产品名称 |^ 单位 |^ 单价 "
CKCPGL.Grid1.ColWidth(0) = 830
CKCPGL.Grid1.ColWidth(1) = 3300
CKCPGL.Grid1.ColWidth(2) = 2230
CKCPGL.Grid1.ColWidth(3) = 1420
    Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
    Set Ef = DB.OpenRecordset("CPK", dbOpenTable)
        CKCPGL.Grid1.Rows = Ef.RecordCount + 15
    Set Ef = DB.OpenRecordset("Select * From CPK Where 产品类型='" & CpTypeName & "'", dbOpenDynaset)
        HH = 1
        Do While Not Ef.EOF()
           CKCPGL.Grid1.Row = HH
           CKCPGL.Grid1.Col = 1
           CKCPGL.Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(1).Value) Then
           CKCPGL.Grid1.Text = Ef.Fields(1).Value
        End If
           CKCPGL.Grid1.Row = HH
           CKCPGL.Grid1.Col = 2
           CKCPGL.Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(2).Value) Then
           CKCPGL.Grid1.Text = Ef.Fields(2).Value
        End If
           CKCPGL.Grid1.Row = HH
           CKCPGL.Grid1.Col = 3
           CKCPGL.Grid1.CellAlignment = 1
        If Not IsNull(Ef.Fields(3).Value) Then
           CKCPGL.Grid1.Text = Ef.Fields(3).Value
        End If
          Ef.MoveNext
          HH = HH + 1
        Loop
        DB.Close
For HH = 1 To CKCPGL.Grid1.Rows - 1
    CKCPGL.Grid1.Row = HH
    CKCPGL.Grid1.Col = 0
    CKCPGL.Grid1.Text = HH
    If Len(CKCPGL.Grid1.Text) = 1 Then
     CKCPGL.Grid1.Text = "0" + CKCPGL.Grid1.Text
     End If
 Next
 CKCPGL.Grid1.Col = 1
 CKCPGL.Grid1.Row = 1
 CKCPGL.Grid1.ColSel = 3
 CKCPGL.Grid1.Visible = True
 Unload Me
End Sub

Private Sub Form_Load()
ADDproduct.Caption = "[" & CpTypeName & "]的产品添加"
Changed = False
End Sub

Private Sub MnuB_Click()
Text2.Text = "把"
Text3.SetFocus
End Sub

Private Sub MnuD_Click()
Text2.Text = "吨"
Text3.SetFocus
End Sub

Private Sub MnuG_Click()
Text2.Text = "个"
Text3.SetFocus
End Sub

Private Sub MnuGJ_Click()
Text2.Text = "公斤"
Text3.SetFocus
End Sub

Private Sub MnuH_Click()
Text2.Text = "盒"
Text3.SetFocus
End Sub

Private Sub MnuJ_Click()
Text2.Text = "件"
Text3.SetFocus
End Sub

Private Sub MnuS_Click()
Text2.Text = "双"
Text3.SetFocus
End Sub

Private Sub MnuT_Click()
Text2.Text = "条"
Text3.SetFocus
End Sub

Private Sub Text1_Change()
If Trim(Text1.Text) <> "" And Val(Text3.Text) > 0 Then
   Command1.Enabled = True
   Else
   Command1.Enabled = False
End If
End Sub

Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   SendKeys "{tab}"
End If
End Sub

Private Sub Text2_DblClick()
PopupMenu MnuDangWei
End Sub

Function NumberTrue(keyNumber As Integer, NumberStr As TextBox) As Boolean
   '转入退格键时
   If keyNumber = 8 Then
      If Len(Trim(NumberStr.Text)) > 0 Then
      Dim Tstr As String
       Tstr = Left(NumberStr.Text, Len(NumberStr.Text) - 1)
      NumberStr.SelLength = 0
      NumberStr.SelStart = Len(Trim(Tstr)) + 1
      NumberTrue = True
      Exit Function
      End If
      End If
   If keyNumber >= 46 And keyNumber <= 57 And keyNumber <> 47 Then
       NumberTrue = True
        Else
       NumberTrue = False
   End If
End Function

Private Sub Text2_GotFocus()
Text2.SelStart = 0
Text2.SelLength = Len(Text2.Text)
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   SendKeys "{tab}"
End If
End Sub

Private Sub Text3_Change()
If Trim(Text1.Text) <> "" And Val(Text3.Text) > 0 Then
   Command1.Enabled = True
   Else
   Command1.Enabled = False
End If
End Sub

Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3.Text)
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
   SendKeys "{tab}"
   Exit Sub
End If
If NumberTrue(KeyAscii, Text3) = False Then
   KeyAscii = 0
End If

End Sub