frmdist.frm

注释：用VB开发的进销存系统源码

         Left            =   75
         TabIndex        =   21
         Top             =   165
         Width           =   720
      End
      Begin VB.Label Label5 
         AutoSize        =   -1  'True
         Caption         =   "配比"
         Height          =   180
         Left            =   1650
         TabIndex        =   20
         Top             =   150
         Width           =   360
      End
      Begin VB.Label Label7 
         AutoSize        =   -1  'True
         Caption         =   "颜色"
         Height          =   180
         Left            =   3720
         TabIndex        =   19
         Top             =   150
         Visible         =   0   'False
         Width           =   360
      End
   End
   Begin SSDataWidgets_B.SSDBCombo cmbSizename 
      Height          =   315
      Left            =   975
      TabIndex        =   4
      Top             =   1170
      Width           =   1170
      DataFieldList   =   "Column 0"
      AllowInput      =   0   'False
      _Version        =   196614
      DataMode        =   2
      RowHeight       =   423
      Columns(0).Width=   3757
      Columns(0).Caption=   "码段"
      Columns(0).Name =   "码段"
      Columns(0).CaptionAlignment=   2
      Columns(0).DataField=   "Column 0"
      Columns(0).DataType=   8
      Columns(0).FieldLen=   256
      _ExtentX        =   2064
      _ExtentY        =   556
      _StockProps     =   93
      BackColor       =   -2147483643
   End
   Begin VB.Label Label8 
      AutoSize        =   -1  'True
      Caption         =   "码段"
      Height          =   180
      Left            =   540
      TabIndex        =   12
      Top             =   1260
      Width           =   360
   End
End
Attribute VB_Name = "frmDist"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public frm As Form

Public R As String
Public GCode As String


Private Sub cmbColor_Click()
    Dim i As Integer
    For i = 0 To txtColor.Count - 1
        txtColor(i).Text = cmbColor.Text
    Next i
End Sub

Private Sub cmbColor_InitColumnProps()
    On Error Resume Next
    sSQL = "select * from color"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        cmbColor.AddItem RsTemp(0)
        RsTemp.MoveNext
    Wend

End Sub

Private Sub cmbPB_Click()
    Dim i As Integer
    Dim j As Integer
    Dim s As String
    i = 1
    While i < Len(cmbPB.Text)
        While Mid(cmbPB.Text, i, 1) <> "," And i < Len(cmbPB.Text)
            s = s + Mid(cmbPB.Text, i, 1)
            i = i + 1
        Wend
        If j >= txtQty.Count Then Exit Sub
        txtQty(j).Text = s
        i = i + 1
        j = j + 1
        s = ""
    Wend
End Sub

Private Sub cmbPB_InitColumnProps()
    On Error Resume Next
    sSQL = "select * from pb"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    While Not RsTemp.EOF
        cmbPB.AddItem RsTemp(0)
        RsTemp.MoveNext
    Wend

End Sub

Private Sub cmbSizename_Click()
    On Error Resume Next
    Dim i As Integer
    sSQL = "select * from ssize where sizename='" & cmbSizename.Text & "'"
    
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    List1.Clear
    UnloadTxt
    While Not RsTemp.EOF
        List1.AddItem RsTemp(1)
        RsTemp.MoveNext
    Wend
    For i = 1 To List1.ListCount - 1
        Load txtQty(i)
        txtQty(i).Left = txtQty(i - 1).Left
        txtQty(i).Top = txtQty(i - 1).Top + txtQty(i - 1).Height
        txtQty(i).Visible = True
    Next i
    For i = 1 To List1.ListCount - 1
        Load txtColor(i)
        txtColor(i).Left = txtColor(i - 1).Left
        txtColor(i).Top = txtColor(i - 1).Top + txtColor(i - 1).Height
        txtColor(i).Visible = True
    Next i

End Sub

Private Sub cmbSizename_InitColumnProps()
    On Error Resume Next
    Set RsTemp = Nothing
    RsTemp.Open "SELECT * FROM msize", Conn, adOpenStatic, adLockReadOnly
    If RsTemp.EOF Then Exit Sub
    While Not RsTemp.EOF
        cmbSizename.AddItem RsTemp(0)
        RsTemp.MoveNext
    Wend
    Set RsTemp = Nothing
    
End Sub

Private Sub cmbUnit_InitColumnProps()
    cmbUnit.AddItem "箱"
    cmbUnit.AddItem "双"
End Sub

Private Sub Command1_Click()
    On Error Resume Next
    Dim i As Integer
    Dim s As String
    Dim t As Integer

    For i = 0 To txtQty.Count - 1
        t = t + Val(txtQty(i).Text)
    Next i

    If ((Val(txtGQty.Text) Mod t) <> 0) And (cmbUnit.Text = "双") Then
        MsgBox "配比存在问题！", vbInformation, "提示窗口"
        Exit Sub
    End If
'    For i = 0 To txtQty.Count - 1
'        Temp = txtCode.Text & vbTab & _
'            txtName.Text & vbTab & _
'            "双" & vbTab & _
'            CStr(Val(txtQty(i).Text) * t) & vbTab & _
'            txtColor(i).Text & vbTab & _
'            List1.List(i)
'
'        frm.grdDET.AddItem Temp
'
'    Next i

    R = ""
    If cmbUnit.Text = "箱" Then
        t = Val(txtGQty.Text)
    Else
        t = Val(txtGQty.Text) / t
    End If

    For i = 0 To txtQty.Count - 1
        If R <> "" Then
            R = R & "#" & txtColor(i).Text & "@" & List1.List(i) & "$" & CStr(Val(txtQty(i).Text) * t)
        Else
            R = txtColor(i).Text & "@" & List1.List(i) & "$" & CStr(Val(txtQty(i).Text) * t)
        End If
    Next i
    
    Unload Me
End Sub

Private Sub Command3_Click()
    txtCode.Text = ""
    txtName.Text = ""
    txtGQty.Text = ""
    cmbUnit.Text = "箱"
    
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub UnloadTxt()
    On Error Resume Next
    Dim i As Integer
    For i = 1 To txtQty.Count - 1
        Unload txtQty(i)
    Next i
    For i = 1 To txtColor.Count - 1
        Unload txtColor(i)
    Next i
End Sub

Private Sub Command6_Click()
    Dim i
    For i = 1 To txtColor.Count - 1
        txtColor(i).Text = txtColor(0).Text
    Next i
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then SendKeys "{TAB}"
End Sub


Private Sub txtCode_Validate(Cancel As Boolean)
    On Error Resume Next
    sSQL = "select * from 商品主档 WHERE 商品编码='" & Trim(txtCode.Text) & "'"
    Set RsTemp = Nothing
    RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
    If RsTemp.EOF Then
        MsgBox "该商品编码不存在!" & vbCrLf & "请检查输入是否正确或查询商品编码.", vbExclamation, "提示窗口"
        Cancel = 1
    Else
        GCode = txtCode.Text
        txtName.Text = RsTemp("品名")
        
        
        sSQL = "select 颜色 from 商品信息 where 商品编码='" & Trim(txtCode.Text) & "' group by 颜色"
        Set RsTemp = Nothing
        RsTemp.Open sSQL, Conn, adOpenStatic, adLockReadOnly
        If Not RsTemp.EOF Then cmbColor.RemoveAll
        While Not RsTemp.EOF
            cmbColor.AddItem RsTemp(0)
            RsTemp.MoveNext
        Wend

        
        Cancel = 0
    End If
End Sub