sproduct.frm

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

      Width           =   540
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "数量："
      ForeColor       =   &H00808000&
      Height          =   180
      Left            =   3660
      TabIndex        =   8
      Top             =   1440
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "单位："
      ForeColor       =   &H00808000&
      Height          =   180
      Left            =   3660
      TabIndex        =   7
      Top             =   945
      Width           =   540
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "产品名称："
      ForeColor       =   &H00808000&
      Height          =   180
      Left            =   3315
      TabIndex        =   6
      Top             =   375
      Width           =   900
   End
End
Attribute VB_Name = "SProduct"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Danjia As Currency
Private Sub ADDproduct_Click()
    SProduct.MousePointer = 11
        RKCancel = False
        SelectStore.Show 1
    If RKCancel = False Then
       SProduct.MousePointer = 0
       Exit Sub
    End If
    Dim DB As Database, KcStr As String, Ef As Recordset
    Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
    Set Ef = DB.OpenRecordset("KCK", dbOpenDynaset)
        KcStr = "仓库类型='" & CkTypeName & "' and 产品类型='" & CpTypeName & "' and 产品名称='" & Combo1.Text & "'"
        Ef.FindFirst KcStr
     If Ef.NoMatch Then
        KcStr = "insert into kck(仓库类型,产品类型,产品名称,单位,数量) values('" & CkTypeName & "','" & CpTypeName & "','" & Trim(Combo1.Text) & "','" & Trim(DanWei.Text) & "'," & Val(ShuLiang.Text) & ")"
      Else
        KcStr = "update kck set 数量=数量+" & Val(ShuLiang.Text) & "  where 仓库类型='" & CkTypeName & "' and 产品类型='" & CpTypeName & "' and 产品名称='" & Combo1.Text & "'"
     End If
        DB.Execute KcStr
     Dim DjNo As String
        Set Ef = DB.OpenRecordset("DjK", dbOpenDynaset)
            On Error GoTo NoRecordset
            Ef.MoveLast
        If Not IsNull(Ef.Fields(0).Value) Then
           DjNo = Ef.Fields(0).Value
           DjNo = Val(DjNo) + 1
        End If
        GoTo HaveRecordset
NoRecordset:
        DjNo = "1999000000"
HaveRecordset:
        KcStr = "insert into DjK(单据编号,仓库类型,产品类型,产品名称,单位,数量,日期,经手人,单价,金额,单据类型) values('" & DjNo & "','" & CkTypeName & "','" & CpTypeName & "','" & Trim(Combo1.Text) & "','" & Trim(DanWei.Text) & "'," & Val(ShuLiang.Text) & ",#" & Trim(RQtxt.Text) & "#,'" & Trim(JSRtxt.Text) & "'," & Danjia & "," & Danjia * Val(ShuLiang.Text) & ",'入库单')"
        DB.Execute KcStr
        KcStr = "insert into DayRK(单据编号,仓库类型,产品类型,产品名称,单位,数量,日期,经手人) values('" & DjNo & "','" & CkTypeName & "','" & CpTypeName & "','" & Trim(Combo1.Text) & "','" & Trim(DanWei.Text) & "'," & Val(ShuLiang.Text) & ",#" & Trim(RQtxt.Text) & "#,'" & Trim(JSRtxt.Text) & "')"
        DB.Execute KcStr
        DB.Close
 '配置网格
Grid2.Visible = False
Grid2.Clear
Grid2.Cols = 3
Grid2.FormatString = "^序号|^ 产品名称 | 数量"
Grid2.ColWidth(0) = 430
Grid2.ColWidth(1) = 1500
Grid2.ColWidth(2) = 1000
    Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
    Set Ef = DB.OpenRecordset("DAYRK", dbOpenTable)
        Grid2.Rows = Ef.RecordCount + 15
    Set Ef = DB.OpenRecordset("Select 产品名称,数量 From DAYRK", dbOpenDynaset)
        HH = 1
        Do While Not Ef.EOF()
           Grid2.Row = HH
           Grid2.Col = 1
           Grid2.CellAlignment = 1
        If Not IsNull(Ef.Fields(0).Value) Then
           Grid2.Text = Ef.Fields(0).Value
        End If
           Grid2.Row = HH
           Grid2.Col = 2
           Grid2.CellAlignment = 1
        If Not IsNull(Ef.Fields(1).Value) Then
           Grid2.Text = Ef.Fields(1).Value
        End If
          Ef.MoveNext
          HH = HH + 1
        Loop
        DB.Close
For HH = 1 To Grid2.Rows - 1
    Grid2.Row = HH
    Grid2.Col = 0
    Grid2.Text = HH
    If Len(Grid2.Text) = 1 Then
     Grid2.Text = "0" + Grid2.Text
     End If
 Next
 Grid2.Col = 1
 Grid2.Row = 1
 Grid2.ColSel = 2
 Grid2.Visible = True
 PrintRK.Enabled = True
 ShuLiang.Text = ""
 SProduct.MousePointer = 0
 End Sub

Private Sub CloseForm_Click()
RKCancel = False
Unload Me
End Sub

Private Sub Combo1_Click()
 ShuLiang.Text = ""
If Trim(Combo1.Text) = "" Then
    Exit Sub
End If
   Dim DB As Database, Ef As Recordset, FindStrs As String
     Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
     Set Ef = DB.OpenRecordset("CPK", dbOpenDynaset)
         FindStrs = "产品类型='" & CpTypeName & "' AND 产品名称='" & Combo1.Text & "'"
         Ef.FindFirst FindStrs
     If IsNull(Ef.Fields(2).Value) Then
        DanWei.Text = "无"
     Else
        DanWei.Text = Ef.Fields(2).Value
     End If
     If Not IsNull(Ef.Fields(3)) Then
        Danjia = Ef.Fields(3).Value
        Else
        Danjia = 0
     End If
        DB.Close
        SendKeys "{tab}"
End Sub

Private Sub Form_Activate()
CKCancel = False
End Sub

Private Sub Form_Load()
SProduct.Left = (MDIForm1.Width - SProduct.Width) / 2
SProduct.Top = (MDIForm1.Height - SProduct.Height) / 2 - 1000
SProduct.Caption = CpTypeName + "入库单"
Label5.Caption = CpTypeName
RQtxt.Text = Date
JSRtxt.Text = UserText
Dim DB As Database, Ef As Recordset, TempStr As String, IA As Integer
'配置产品类型
    Set DB = OpenDatabase(App.Path & "\Sys\Store.mdb", 0, 0, Constr)
    Set Ef = DB.OpenRecordset("SELECT * FROM CPK WHERE 产品类型='" & CpTypeName & "'", dbOpenDynaset)
    IA = 0
    Do Until Ef.EOF()
     If Not IsNull(Ef.Fields(1)) Then
        TempStr = Ef.Fields(1).Value
        Combo1.AddItem TempStr, IA
        IA = IA + 1
     End If
     Ef.MoveNext
     If Ef.EOF = True Then Exit Do
    Loop
    TempStr = "Delete * From DayRk"
    DB.Execute TempStr
    DB.Close
If IA > 0 Then
   Combo1.ListIndex = 0
End If
 '配置网格
Grid2.Cols = 3
Grid2.FormatString = "^序号|^ 产品名称 | 数量"
Grid2.ColWidth(0) = 430
Grid2.ColWidth(1) = 1500
Grid2.ColWidth(2) = 1000
Grid2.Rows = 16
PrintRK.Enabled = False
If Trim(Combo1.Text) = "" Then
   ADDproduct.Enabled = False
   Combo1.Enabled = False
   ShuLiang.Enabled = False
   MsgBox "您没有定义产品数据，不能进行入库操作。" & Chr(10) & Chr(13) & "请在配置产品种类中，配置产品名称。", vbOKOnly + 16, "警告！"
   Exit Sub
End If
End Sub

Private Sub PrintRK_Click()
SProduct.MousePointer = 11
Report1.ReportFileName = Browser + "report\DayRK.rpt"
Report1.DataFiles(0) = ConData2
Report1.DataFiles(1) = ConData3
On Error Resume Next
Report1.WindowState = crptNormal
Report1.PrintReport
SProduct.MousePointer = 0
End Sub

Private Sub ShuLiang_Change()
 If Val(ShuLiang.Text) > 0 Then
    ADDproduct.Enabled = True
    Else
    ADDproduct.Enabled = False
    End If
End Sub

Private Sub ShuLiang_KeyPress(KeyAscii As Integer)
 If KeyAscii = 13 Then
  SendKeys "{tab}"
  Exit Sub
  End If
If KeyAscii = 8 Then
   If Len(Trim(ShuLiang.Text)) = 0 Then
        KeyAscii = 0
      Else
        ShuLiang.Text = Left(Trim(ShuLiang.Text), (Len(Trim(ShuLiang.Text)) - 1))
        ShuLiang.SelStart = Len(ShuLiang.Text)
        ShuLiang.SelLength = 0
      End If
      End If
If KeyAscii < 46 Or KeyAscii > 57 Or KeyAscii = 47 Then
      KeyAscii = 0
      End If

End Sub