frmrkd.frm

........... 开发进销存（VB6源码）

         Size            =   15.75
         Charset         =   134
         Weight          =   700
         Underline       =   -1  'True
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   315
      Left            =   5040
      TabIndex        =   2
      Top             =   450
      Width           =   1710
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "入库仓库："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   240
      TabIndex        =   1
      Top             =   1020
      Width           =   1125
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "入库类型："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   240
      TabIndex        =   0
      Top             =   660
      Width           =   1125
   End
End
Attribute VB_Name = "FrmRKD"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim gRow As Integer
Dim gCol As Integer
Dim CKID As String
Dim Number As Integer

Private Sub Combo2_click()
    Dim Rst As ADODB.Recordset
    
    Set Rst = New ADODB.Recordset
        SQL = "select ckid from ck where ckmc='" & Combo2.Text & "'"
        Rst.Open SQL, db, 1, 3, adCmdText
        
        If Rst.EOF Then Exit Sub
        
        CKID = Rst.Fields(0).Value
        
End Sub

Private Sub Form_Load()
Dim Rst, CKRst As ADODB.Recordset
Dim SQL As String

    DTPicker1.Value = Date$
    Text1.Visible = False
    Set IDlist = New Collection
    Call ReSet
    
    SQL = "select max(RKDBH) from RKD_ZB where RKDBH like '" & Format(Date$, "yyyymmdd") & "%'"
    Set Rst = New ADODB.Recordset
    Rst.CursorLocation = adUseClient
    
    Rst.Open SQL, db, adOpenDynamic, adLockReadOnly, adCmdText
    If IsNull(Rst.Fields(0)) Then
      Number = 1
    Else
      Number = Val(Mid(Rst.Fields(0), 10)) + 1
    End If
    Rst.Close
    Set Rst = Nothing
    
    LblBH.Caption = Format(Date$, "yyyymmdd") & Format(CStr(Number), "000")
    
    Combo1.AddItem "进货入库"
    Combo1.AddItem "退货入库"
    
    Set CKRst = New ADODB.Recordset
        SQL = "select ckid,ckmc from ck"
        CKRst.CursorLocation = adUseClient
        CKRst.Open SQL, db, adOpenDynamic, adLockReadOnly, adCmdText
        If CKRst.EOF Then Exit Sub
        Do While Not CKRst.EOF
            Combo2.AddItem CKRst.Fields("ckmc")
            CKRst.MoveNext
        Loop
        
End Sub
Private Sub ReSet()
  Grid.Clear
  Grid.Rows = 1
  Grid.FormatString = "序号|^   商   品   名   称    |^  货   号  |^  规   格   |^  单   位  |^  数   量  |^  单   价  |^  金    额   "
  Grid.ColWidth(8) = 0
  lblSL.Caption = "0"
  lblJE.Caption = "0.00"
  
 Set IDlist = New Collection
  
  Grid.Enabled = True
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set IDlist = Nothing
    Unload Me
End Sub

Private Sub Grid_DblClick()
    If Grid.Rows = 1 Then Exit Sub

    Text1.Top = Grid.CellTop + Grid.Top
    Text1.Left = Grid.CellLeft + Grid.Left
    
    gRow = Grid.Row
    gCol = Grid.Col
    
    If gCol <> 5 And gCol <> 6 Then Exit Sub
    
    Text1.Width = Grid.CellWidth '- 2 * Screen.TwipsPerPixelX
    Text1.Height = Grid.CellHeight ' - 2 * Screen.TwipsPerPixelY
     
    Text1.Text = Grid.Text
    ' Show the text box:
    Text1.Visible = True
    Text1.ZOrder 0 ' 把 Text1 放到最前面！
    Text1.SetFocus
    ' Redirect this KeyPress event to the text box:
    If KeyAscii <> 13 Then
        SendKeys Chr$(KeyAscii)
    End If
        
End Sub
Private Sub Text1_GotFocus()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Grid.SetFocus ' Set focus back to grid, see Text_LostFocus.
        KeyAscii = 0 ' Ignore this KeyPress.
    End If
    If KeyAscii <> 8 And KeyAscii <> 45 And KeyAscii <> 46 And KeyAscii < 48 Or KeyAscii > 57 Then
           ' 'Beep
        KeyAscii = 0
    End If
End Sub
Private Sub Text1_LostFocus()
On Error GoTo Errorhandler
    Dim tmpRow As Integer
    Dim tmpCol As Integer
    ' Save current settings of Grid Row and col. This is needed only if
    ' the focus is set somewhere else in the Grid.
    tmpRow = Grid.Row
    tmpCol = Grid.Col
    ' Set Row and Col back to what they were before Text1_LostFocus:
    Grid.Row = gRow
    Grid.Col = gCol
    If gCol = 5 Then
        Grid.Text = Val(Text1.Text)
    ElseIf gCol = 6 Then
        Grid.Text = Format(Val(Text1.Text), "###0.00") ' Transfer text back to grid.
    End If
    Text1.SelStart = 0 ' Return caret to beginning.
    Text1.Visible = False ' Disable text box.
    ' Return row and Col contents:
    Grid.TextMatrix(gRow, 7) = Format(Val(Grid.TextMatrix(gRow, 5)) * Val(Grid.TextMatrix(gRow, 6)), "###0.00")
    
    For I = 1 To Grid.Rows - 1
        SumSL = SumSL + Val(Grid.TextMatrix(I, 5))
        SumJE = SumJE + Val(Grid.TextMatrix(I, 7))
    Next
    
    lblJE.Caption = Format(CStr(SumJE), ".00")
    lblSL.Caption = SumSL
          
    Grid.Row = tmpRow
    Grid.Col = tmpCol
    Exit Sub
Errorhandler:
    Exit Sub
End Sub
Private Sub Grid_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Call Grid_DblClick
    End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case Is = "Exit"
            Unload Me
        Case Is = "Addline"
            Call Grid_KeyUp(vbKeyF2, 0)
        Case Is = "Delline"
            Call Grid_KeyUp(vbKeyDelete, 0)
        Case Is = "Save"
            Call Grid_KeyUp(vbKeyF8, 0)
        Case Is = "Print"
            Call Grid_KeyUp(vbKeyF10, 0)
    End Select
    
End Sub
Private Sub Grid_KeyUp(KeyCode As Integer, Shift As Integer)
Dim Rst As ADODB.Recordset
Dim Cmd As ADODB.Command
Dim SQL As String
Dim I As Integer
Dim N As Integer

    Select Case KeyCode
        Case vbKeyF2
            SPFlag = 2
            FrmSPZL.Show 1
        Case vbKeyF3
            If MsgBox("请确信要取消此单?", vbOKCancel + vbCritical, "提示") = vbOK Then
                Call ReSet
            End If
        Case vbKeyF8
            If Grid.Rows <= 1 Then Exit Sub
            
            If Combo1.Text = "" Then
                MsgBox "请选择入库方式！", vbOKOnly + vbCritical, "提示"
                Exit Sub
            ElseIf Combo2.Text = "" Then
                MsgBox "请选择仓库！", vbOKOnly + vbCritical, "提示"
                Exit Sub
            End If
            
            For I = 1 To Grid.Rows - 1
                If Grid.TextMatrix(I, 5) = "0" Then
                    MsgBox "第" & I & "行'数量'不能为零！", vbOKOnly + vbExclamation, "警告"
                    Exit Sub
                ElseIf Grid.TextMatrix(I, 6) = "0.00" Then
                    MsgBox "第" & I & "行'单价'不能为零！", vbOKOnly + vbExclamation, "警告"
                    Exit Sub
                End If
            Next I
            
            Dim Rst1, Rst2 As ADODB.Recordset
            Dim NumId, id As Integer
            
            '更新库存总表
            Set Rst = New ADODB.Recordset
                SQL = "insert into RKD_ZB values ('" & LblBH.Caption & "','" _
                  & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Combo1.Text & "','" & _
                  CKID & "','" & Combo2.Text & "','" & Val(lblJE.Caption) & "')"
                Rst.Open SQL, db, 1, 3
            
            '更新库存明细表
            Set Rst1 = New ADODB.Recordset
                SQL = "select max(id) from rkd_mx"
                Rst1.Open SQL, db, 1, 3
                
                If IsNull(Rst1.Fields(0)) Then
                    NumId = 0
                Else
                    NumId = Val(Rst1.Fields(0).Value)
                End If
                
            Set Rst2 = New ADODB.Recordset
            For I = 1 To Grid.Rows - 1
                NumId = NumId + 1
                SQL = "insert into RKD_MX  values('" & NumId & "','" & LblBH.Caption & "','" & Val(Grid.TextMatrix(I, 0)) & "','" _
                  & Grid.TextMatrix(I, 8) & "','" & Grid.TextMatrix(I, 1) & "','" & Grid.TextMatrix(I, 2) & "','" _
                  & Grid.TextMatrix(I, 3) & "','" & Grid.TextMatrix(I, 4) & "','" & Grid.TextMatrix(I, 5) & "','" _
                  & Val(Grid.TextMatrix(I, 6)) & "','" & Val(Grid.TextMatrix(I, 7)) & "')"
                Rst.Open SQL, db, 1, 3
                 
                 '更新库存动态表
                Dim KCRst As ADODB.Recordset
                Dim KCRst1 As ADODB.Recordset
                Dim RstID As ADODB.Recordset
                Dim NumKCID As Integer
                
                Set KCRst = New ADODB.Recordset
                    SQL = "select * from kcdtb where spid=" & Val(Grid.TextMatrix(I, 8))
                    KCRst.Open SQL, db, 1, 3
                    
                    If KCRst.EOF Then
                        Set RstID = New ADODB.Recordset
                            SQL = "select max(id) from KCDTB"
                            RstID.Open SQL, db, 1, 3
                            
                            If IsNull(RstID.Fields(0)) Then
                                NumKCID = 0
                            Else
                                NumKCID = Val(RstID.Fields(0).Value)
                            End If
                            
                            NumKCID = NumKCID + 1
                            
                        Set KCRst1 = New ADODB.Recordset
                      
                            SQL = "insert into kcdtb values('" & NumKCID & "','" & CKID & "','" & Val(Grid.TextMatrix(I, 8)) & _
                            "','" & Grid.TextMatrix(I, 1) & "','" & Val(Grid.TextMatrix(I, 5)) & "')"
                            
                            KCRst1.Open SQL, db, 1, 3
                        
                    Else
                        KCRst.Fields(4).Value = KCRst.Fields(4).Value + Val(Grid.TextMatrix(I, 5))
                        KCRst.Update
                    End If
            Next
            
            If MsgBox("数据保存成功,是否要打印?", vbOKCancel + vbInformation, "提示") = vbOK Then
                'Call FPPrint
            End If
                
            
            Call ReSet
            Number = Number + 1
            LblBH.Caption = Format(Date$, "yyyymmdd") & Format(CStr(Number), "000")
        Case vbKeyF10
            'Call FPPrint
        Case vbKeyDelete, vbKeyBack
          Dim SumJE, SumSE, SumJSHJ As Currency
          Dim SumSL As Integer
          
          If Grid.RowSel = 0 Then Exit Sub
          If Grid.Rows = 2 Then ReSet: Exit Sub
          IDlist.Remove Grid.RowSel
          Grid.RemoveItem Grid.RowSel
          For I = 1 To Grid.Rows - 1
              SumJE = SumJE + Val(Grid.TextMatrix(I, 7))
              SumSL = SumSL + Val(Grid.TextMatrix(I, 5))
          Next
            
          lblJE.Caption = Format(CStr(SumJE), ".00")
          lblSL.Caption = SumSL
          
          For I = 1 To Grid.Rows - 1
            Grid.TextMatrix(I, 0) = CStr(I)
          Next
    End Select
End Sub
Sub KCDTB()

End Sub