frmioorder.frm

这个是VB环境开发的,我也是转载的把原来的Access数据库改成了SQl Server数据库.希望大家可以借鉴

            fiocmbPT = FIO!Flg & ""
            lblprod = FIO!eleid
         Else
            txtcompname = FioP!Memo & ""
            txtProd = FioP!pname
            txtPrice = FioP!price
            txtamount = FioP!amount
            fiocmbPT = FioP!Flg & ""
            lblprod = FioP!PID
         End If
    End If
    Exit Sub
l:   MsgBox err.Description
End Sub


Private Sub dtgrd_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    dtgrd_Click
End Sub





 

Private Sub dtptime_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub

Private Sub Form_Load()
On Error GoTo errl
    Screen.MousePointer = 11
    Dim Str As String
    frmioorder.Top = 0
    frmioorder.Left = 0
    IoDtl.Open "select * from iotbldetail", cn, adOpenKeyset, adLockBatchOptimistic
    RsIO.Open "select * from iotbl", cn, adOpenKeyset, adLockBatchOptimistic
    RSman.Open "select * from usertable", cn, adOpenKeyset, adLockBatchOptimistic
    Str = "SELECT distinct IOTbldetail.ID, EleStock.Ename,EleStock.Etype, IOTbl.Price, IOTbl.Amount, IOTbl.Flg, EleStock.ID AS Eleid, IOTbl.ID AS ioID, IOTbl.memo  " & _
      " FROM  IOTbldetail INNER JOIN (EleStock INNER JOIN IOTbl ON EleStock.ID = IOTbl.Bh) ON IOTbldetail.ID = IOTbl.ioid ORDER BY IOTbl.ID;"
    FIO.Open Str, cn, adOpenKeyset, adLockBatchOptimistic
    RsE.Open "select * from elestock", cn, adOpenKeyset, adLockBatchOptimistic
    IoPrnt.Open "select * from PrintReprt", cn, adOpenKeyset, adLockBatchOptimistic
    IoPrnt1.Open "select * from printreprt1", cn, adOpenKeyset, adLockBatchOptimistic
    'Company.Open "select * from companydepart", cn, adOpenKeyset, adLockBatchOptimistic
    FioP.Open "select * from Pfinstock", cn, adOpenKeyset, adLockBatchOptimistic
    RsP.Open "select * from ProStock", cn, adOpenKeyset, adLockBatchOptimistic
    Toolbar1.Buttons(2).Enabled = False
    Set dtcmb.RowSource = RSman
    Set dtcmb.DataSource = RSman
    dtcmb.BoundColumn = "id"
    dtcmb.ListField = "username"
    dtcmb.Text = UsrName
    cmbPT.Clear
    cmbPT.AddItem "元件"
    cmbPT.AddItem "半成品"
    cmbPT.AddItem "成品"
    cmbPT.Text = "元件"
    'Set dtgrd.DataSource = FIO
    dtgrd.Refresh
    Toolbar1.Buttons(2).Enabled = False
    Toolbar1.Buttons(6).Enabled = False
    If UsrName = RSman.Fields!UserName Then
        Toolbar1.Buttons(3).Enabled = True
    Else
        Toolbar1.Buttons(3).Enabled = False
    End If
    dtptime.Value = Format(Now, "yy-mm-dd")
    Screen.MousePointer = vbDefault
    Exit Sub
errl: MsgBox err.Description
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Dim Str As String
    If Toolbar1.Buttons(2).Enabled = True Then
       Str = MsgBox("你修改或添加的数据将不会被保存,你确定要退出吗？", vbYesNo, "提示信息")
       If Str = vbYes Then
         Unload Me
         IoDtl.Delete adAffectCurrent
         IoDtl.UpdateBatch adAffectCurrent
         IoDtl.MoveNext
       Else
         Cancel = 1
       End If
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    RsIO.Close
    RSman.Close
    RsE.Close
    FIO.Close
    IoDtl.Close
    IoPrnt.Close
    'Company.Close
    IoPrnt1.Close
    FioP.Close
    RsP.Close
End Sub



Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error GoTo gl
   Dim cmd As New ADODB.Command
   Dim Re As String
   Dim Ioadd As Integer
   Dim txtDate As String
   Dim It As Integer
   Dim Flg As String
   Select Case Trim(Button.Key)
         Case "new"
         On Error GoTo newerr
            frmio.Enabled = True
            Command4.Enabled = True
            Frame1.Enabled = True
            ccmdinput.Enabled = True
            Toolbar1.Buttons(1).Enabled = False
            Toolbar1.Buttons(2).Enabled = True
            Toolbar1.Buttons(3).Enabled = False
            IoDtl.Filter = ""
            Ioadd = IoDtl.RecordCount
            IoDtl.AddNew
            IoDtl!ID = Ioadd + 1
            IoDtl!Date = dtptime
            IoDtl!HandleManid = dtcmb.BoundText
            If frmioorder.Caption = "入 库 单" Then
                IoDtl!ioflg = True
            Else
                IoDtl!ioflg = False
            End If
            IoDtl.UpdateBatch adAffectCurrent
            txtid = IoDtl!ID
            If txtProd <> "" Then
                dtgrd.Refresh
                txtPrice = ""
                txtcompname = ""
                txtamount = ""
                txtProd = ""
            End If
        Exit Sub
newerr:         MsgBox err.Description
        Case "save"
            dtgrd.Refresh
            If dtgrd.row = -1 And dtgrd1.row = -1 Then
                MsgBox " 请添加记录！ ", , ginfo
                Exit Sub
            End If
            If Toolbar1.Buttons(1).Enabled = False Then
                'checkdata
              If cmbPT.Text <> "成品" Then
                   If frmioorder.Caption = "入 库 单" Then
                       FIO.Filter = "id=" & txtid
                       If Not (FIO.BOF Or FIO.EOF) Then
                          FIO.MoveFirst
                          Do While Not FIO.EOF
                            RsE.Requery
                            RsE.Filter = "ename='" & FIO!ename & "'and etype='" & FIO!etype & "'"
                            'rsE.Find "etype='" & FIO!etype & "'"
                            If Not RsE.BOF Or Not RsE.EOF Then
                              If RsE!estock <> "" Then
                                 RsE!estock = RsE!estock + Val(FIO!amount)
                                 RsE.UpdateBatch adAffectCurrent
                                 FIO.MoveNext
                              End If
                            End If
                        Loop
                      End If
                  Else
                        FIO.MoveFirst
                        Do While Not FIO.EOF
                            RsE.Requery
                            RsE.Filter = "ename='" & FIO!ename & "'and etype='" & FIO!etype & "'"
                            'rsE.Find "etype='" & FIO!etype & "'"
                            If Not RsE.BOF Or Not RsE.EOF Then
                                 If RsE!estock >= 0 Then
                                    OldEstock = RsE!estock
                                    RsE!estock = RsE!estock - Val(FIO!amount)
                                    If RsE!estock < 0 Then
                                       MsgBox "   库存数量不足，现在库存为: " & OldEstock & "   ", vbInformation, ginfo '
                                       Exit Sub
                                    End If
                                    RsE!estock = RsE!estock - Val(FIO!amount)
                                    RsE.UpdateBatch adAffectCurrent
                                    FIO.MoveNext
                                  Else
                                    Exit Sub
                                 End If
                            End If
                        Loop
                 End If
              Else
                 Call Psave
              End If
                '*****************************************
                If txtmemo <> "" Then
                  IoDtl!Memo = txtmemo
                End If
                If Trim(strcol(3)) <> "" Then
                   IoDtl!Date = strcol(3)
                End If
                IoDtl!Date = dtptime.Value
                IoDtl!HandleManid = dtcmb.BoundText
                IoDtl.UpdateBatch adAffectCurrent
                RsE.UpdateBatch adAffectCurrent
                '**********
                Toolbar1.Buttons(2).Enabled = False
                Toolbar1.Buttons(1).Enabled = True
                Toolbar1.Buttons(6).Enabled = True
                Frame1.Enabled = False
                frmio.Enabled = False
            End If
                txtPrice = ""
                txtcompname = ""
                txtamount = ""
                txtProd = ""
                txtmemo = ""
                RsIO.Close
                RSman.Close
                IoPrnt1.Close
                RsE.Close
                FIO.Close
                RsP.Close
                FioP.Close
                Set FIO = Nothing
                IoDtl.Close
                IoPrnt.Close
                'Company.Close
                Form_Load
                ccmdinput.Enabled = False
                Toolbar1.Buttons(6).Enabled = True
         Case "find"
          Re = InputBox("请输入库单日期：", "查找信息", Default, 2500, 2500)
            
            If Re <> "" Then
                On Error GoTo l
                        If Me.Caption = "入 库 单" Then
                           IoDtl.Filter = "date=" & Trim(Re) & " and ioflg= true "
                           RSman.Find "id=" & IoDtl!HandleManid
                           If Not (RSman.BOF Or RSman.EOF) Then
                              dtcmb.Text = RSman!UserName
                           End If
                        Else
                           IoDtl.Filter = "date=" & Re & " and ioflg= false"
                           RSman.Find "id=" & IoDtl!HandleManid
                           If Not (RSman.BOF Or RSman.EOF) Then
                              dtcmb.Text = RSman!UserName
                           End If
                        End If
                        If IoDtl.BOF Or IoDtl.EOF Then
                            MsgBox " 对不起，没找到该记录!", , ginfo
                            Exit Sub
                        End If
                        txtmemo = IoDtl!Memo & ""
                        dtptime.Value = IoDtl!Date
                        txtid = IoDtl!ID
                        FIO.Filter = "id=" & txtid & ""
                            If FIO!Flg <> "成品" Then
                                If Not (FIO.BOF Or FIO.EOF) Then
                                       FIO.Requery
                                       cmbPT.Text = "元件"
                                 If Not (FIO.BOF Or FIO.EOF) Then
                                    dtgrd.Visible = True
                                    Set dtgrd.DataSource = FIO
                                    dtgrd.Refresh
                                  End If
                               End If
                         Else
                            FioP.Requery
                            FioP.Filter = "id=" & txtid
                            If Not (FIO.EOF Or FIO.BOF) Then
                                cmbPT.Text = "成品"
                                dtgrd.Visible = False
                                Set dtgrd1.DataSource = FioP
                                dtgrd1.Refresh
                            End If
                         End If
                  Toolbar1.Buttons(6).Enabled = True
                  Exit Sub
l:                MsgBox " 没找到相应记录！  ", , ginfo
            End If
         Case "dele"
          On Error GoTo Lbl
            frmio.Enabled = True
            Toolbar1.Buttons(6).Enabled = False
            If dtgrd.row <> -1 Or dtgrd1.row <> -1 Then
                Re = MsgBox("您确定要删除表格中的记录吗?", vbYesNo + vbQuestion + vbDefaultButton2, ginfo)
                If Re = 6 Then
                   If cmbPT.Text <> "成品" Then
                        RsIO.Find "id=" & dtgrd.Columns(5).Text
                        'txtid = dtgrd.Columns(5).Text
                        RsIO.MoveNext
                        If Not RsIO.BOF Or Not RsIO.EOF Then
                            cmd.ActiveConnection = cn
                            cmd.CommandText = "delete  * from iotbl where id =" & dtgrd.Columns(5).Text
                            cmd.Execute
                            cmd.ActiveConnection = Nothing
                       '     RsIO.MoveNext

'                    If Not (RsIO.EOF Or RsIO.BOF) Then
'                       Do While Not RsIO.EOF
'                             If Val(txtid) <= RsIO.Fields!ID Then
'                                RsIO.Fields!ID = RsIO.Fields!ID - 1
'                                RsIO.UpdateBatch adAffectCurrent
'                                RsIO.MoveNext
'                             Else
'                                  Exit Do
'                             End If
'                             Loop
'                       End If
                             RsIO.Requery
                             FIO.Requery
                             dtgrd.Visible = True
                             dtgrd.Refresh
                        End If
                   Else
                        RsIO.Find "id=" & dtgrd1.Columns(5).Text
                        If Not RsIO.BOF Or Not RsIO.EOF Then
                            cmd.ActiveConnection = cn
                            cmd.CommandText = "delete  * from iotbl where id =" & dtgrd.Columns(5).Text
                            cmd.Execute
                            cmd.ActiveConnection = Nothing
                            RsIO.Requery
                            FioP.Requery
                            dtgrd.Visible = False
                            dtgrd1.Refresh
                       End If
                   End If
                End If
            End If
            Exit Sub
Lbl:                MsgBox err.Description, , ginfo
         Case "print"
                If Trim(txtid) <> "" Then
                       RsIO.Requery
                       IoPrnt.Requery
                       IoPrnt1.Requery
                       IoPrnt.Find "id=" & txtid
                       If Not (IoPrnt.EOF Or IoPrnt.BOF) Then
                          Flg = IoPrnt.Fields!Flg
                        Else
                          IoPrnt1.Find "id=" & txtid
                          If Not (IoPrnt1.EOF Or IoPrnt1.BOF) Then
                             Flg = IoPrnt1.Fields!Flg
                           End If
                       End If
                       IoPrnt.Requery
                       IoPrnt1.Requery
                       If Not (IoPrnt.EOF Or IoPrnt.BOF) Or Not (IoPrnt1.EOF Or IoPrnt1.BOF) Then
                            If Flg <> "成品" Then
                                  If Me.Caption = "入 库 单" Then
                                     IoPrnt.Requery
                                     IoPrnt.Filter = "id=" & txtid & " and ioflg=true"
                                  Else
                                     IoPrnt.Requery
                                     IoPrnt.Filter = "id=" & txtid & " and ioflg=false"
                                  End If
                                 dlg.Orientation = 2
                                 dlg.ShowPrinter
                                 'ioprnt.Requery
                                 Set IORpt.DataSource = IoPrnt