moinvoice.frm

delphi 和ASP BS模式的程序

            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Index           =   14
         Left            =   4200
         TabIndex        =   17
         Top             =   1185
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Unitprice:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Index           =   15
         Left            =   4200
         TabIndex        =   16
         Top             =   795
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "ProductName:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Index           =   16
         Left            =   4200
         TabIndex        =   15
         Top             =   390
         Width           =   1695
      End
      Begin VB.Label Label1 
         Caption         =   "Remarks:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Index           =   18
         Left            =   200
         TabIndex        =   14
         Top             =   1950
         Width           =   1700
      End
      Begin VB.Label Label1 
         Caption         =   "Dept:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Index           =   19
         Left            =   200
         TabIndex        =   13
         Top             =   1550
         Width           =   1700
      End
      Begin VB.Label Label1 
         Caption         =   "Quantity:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Index           =   20
         Left            =   200
         TabIndex        =   12
         Top             =   1150
         Width           =   1700
      End
      Begin VB.Label Label1 
         Caption         =   "ProductID:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Index           =   21
         Left            =   200
         TabIndex        =   11
         Top             =   750
         Width           =   1700
      End
      Begin VB.Label Label1 
         Caption         =   "InputType:"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   300
         Index           =   22
         Left            =   200
         TabIndex        =   10
         Top             =   350
         Width           =   1700
      End
   End
   Begin MSComctlLib.Toolbar Toolbar1 
      Height          =   780
      Left            =   240
      TabIndex        =   27
      Top             =   6720
      Width           =   5100
      _ExtentX        =   8996
      _ExtentY        =   1376
      ButtonWidth     =   1032
      ButtonHeight    =   1376
      Style           =   1
      ImageList       =   "ImageList1"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   5
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "Save"
            Key             =   "Save"
            ImageIndex      =   1
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "Cancel"
            Key             =   "Cancel"
            ImageIndex      =   2
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "Quit"
            Key             =   "Quit"
            ImageIndex      =   3
         EndProperty
      EndProperty
      Begin MSComctlLib.ImageList ImageList1 
         Left            =   4200
         Top             =   120
         _ExtentX        =   1005
         _ExtentY        =   1005
         BackColor       =   -2147483643
         ImageWidth      =   32
         ImageHeight     =   32
         MaskColor       =   12632256
         _Version        =   393216
         BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
            NumListImages   =   3
            BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "moinvoice.frx":0781
               Key             =   "save"
            EndProperty
            BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "moinvoice.frx":0A9B
               Key             =   "Cancel"
            EndProperty
            BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
               Picture         =   "moinvoice.frx":0EED
               Key             =   "quit"
            EndProperty
         EndProperty
      End
   End
End
Attribute VB_Name = "frmpaii"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
 Dim db As ADODB.Connection
 Set db = New ADODB.Connection
 Select Case Button.Key
       Case "Save"
            db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                    "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
            db.Execute "insert into PIC select * from PICt where InputID=" & _
            "'" & Trim(Adodc1.Recordset.Fields(0)) & "'"
            db.Close
            db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                    "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
            db.Execute "insert into PID select InputID,InputDate,InputType,Warehouse,Department," & _
            "ProductID,ProductName,Quantity,UnitPrice,Total,Status,Remarks from PIDt " & _
            "where InputID='" & Trim(Adodc1.Recordset.Fields(0)) & "'"
            db.Close
            db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                    "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
            db.Execute "update PIDt set Isexamed='1' where InputID=" & _
            "'" & Trim(Adodc1.Recordset.Fields(0)) & "'"
            db.Close
            '以下是产品库存随之增加
            db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                    "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
            db.Execute "update PI set Total = Total+" & Trim(Text1(4).Text) & ",Quantity=Quantity+" & Trim(Text1(8).Text) & "where ProductID=" & _
            "'" & Trim(Adodc1.Recordset.Fields(5)) & "'"
            db.Close
        Case "Cancel"
            db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                    "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
            db.Execute "delete from PIC where InputID='" & Trim(Adodc1.Recordset.Fields(0)) & "'"
            db.Close
            db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                    "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
            db.Execute "delete from PId where InputID='" & Trim(Adodc1.Recordset.Fields(0)) & "'"
            db.Close
        Case "Quit"
            db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                    "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
            db.Execute "delete from pict"
            db.Close
            db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                    "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
            db.Execute "delete from pidt"
            db.Close
            frmpinput.Adodc_pic.Refresh
            frmpinput.Adodc_pid.Refresh
            Unload Me
  End Select
  Adodc1.Refresh

End Sub

Private Sub Toolbar2_ButtonClick(ByVal Button As MSComctlLib.Button)
   On Error GoTo err
   Dim db As ADODB.Connection
   Set db = New ADODB.Connection
   Dim test As String
   Dim id As String

  Select Case Button.Key
         Case "Input"
                test = DTPicker1.Year
                If Len(DTPicker1.Month) = 1 Then
                   test = test & "0" & DTPicker1.Month
                Else
                   test = test & DTPicker1.Month
                End If
                If Len(DTPicker1.Day) = 1 Then
                   test = test & "0" & DTPicker1.Day
                Else
                   test = test & DTPicker1.Day
                End If
                   test = test & "01"
                With Adodc2
                     .RecordSource = "select InputID from PIC"
                     .Refresh
                End With
                If Adodc2.Recordset.EOF = True Or Adodc2.Recordset.BOF = True Then
                db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                        "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
                db.Execute "insert into PICt values('" & Trim(test) & "'," & _
                           "'" & Trim(DTPicker1.Value) & "','" & Trim(Combo2.Text) & "'," & _
                           "'" & Trim(Text1(2).Text) & "','" & Trim(Text1(0).Text) & "'," & _
                           "'" & Trim(Text1(1).Text) & "')"
                db.Close
                db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                        "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
                db.Execute "insert into PIDt values('" & Trim(test) & "'," & _
                           "'" & Trim(DTPicker1.Value) & "','" & Trim(Combo1(2).Text) & "'," & _
                           "'" & Trim(Combo2.Text) & "','" & Trim(Combo1(1)) & "'," & _
                           "'" & Trim(Text1(9).Text) & "','" & Trim(Text1(6).Text) & "'," & _
                           "'" & Trim(Text1(8).Text) & "','" & Trim(Text1(5).Text) & "'," & _
                           "'" & Trim(Text1(4).Text) & "','" & Trim(Text1(3).Text) & "','0'," & _
                           "'" & Trim(Text2.Text) & "')"
                db.Close
               Else
                Let id = Adodc2.Recordset.Fields(0)
                Do Until Adodc2.Recordset.EOF = True
                    If id < Adodc2.Recordset.Fields(0) Then
                        id = Adodc2.Recordset.Fields(0)
                    End If
                    Adodc2.Recordset.MoveNext
                Loop
                If test <= id Then
                   test = Left(id, 8) & (Right(id, 2) + 1)
                   If Len(test) = 9 Then
                      test = Left(test, 8) & "0" & Right(test, 1)
                   End If
                End If
                
                db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                        "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
                db.Execute "insert into PICt values('" & Trim(test) & "'," & _
                           "'" & Trim(DTPicker1.Value) & "','" & Trim(Combo2.Text) & "'," & _
                           "'" & Trim(Text1(2).Text) & "','" & Trim(Text1(0).Text) & "'," & _
                           "'" & Trim(Text1(1).Text) & "')"
                db.Close
                db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                        "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
                db.Execute "insert into PIDt values('" & Trim(test) & "'," & _
                           "'" & Trim(DTPicker1.Value) & "','" & Trim(Combo1(2).Text) & "'," & _
                           "'" & Trim(Combo2.Text) & "','" & Trim(Combo1(1)) & "'," & _
                           "'" & Trim(Text1(9).Text) & "','" & Trim(Text1(6).Text) & "'," & _
                           "'" & Trim(Text1(8).Text) & "','" & Trim(Text1(5).Text) & "'," & _
                           "'" & Trim(Text1(4).Text) & "','" & Trim(Text1(3).Text) & "','0'," & _
                           "'" & Trim(Text2.Text) & "')"
                db.Close
              End If
         Case "Cancel"
                db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                        "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
                db.Execute "delete  from pict where InputId='" & Trim(Adodc1.Recordset.Fields(0)) & "'"
                db.Close
                db.Open "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                        "User ID=sa;Initial Catalog=InventoryDB;Data Source=(local)"
                db.Execute "delete  from pidt where InputId='" & Trim(Adodc1.Recordset.Fields(0)) & "'"
                db.Close
              
  End Select
  Adodc1.Refresh
err:
  Exit Sub
End Sub