百货/超市行业

开发平台：
Visual Basic

frm_CFM.frm：源码内容
							VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form frm_CFM 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "采购单"
   ClientHeight    =   5610
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9405
   Icon            =   "frm_CFM.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5610
   ScaleWidth      =   9405
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   300
      Left            =   8160
      TabIndex        =   9
      Top             =   5160
      Width           =   975
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "确定"
      Height          =   300
      Left            =   7080
      TabIndex        =   8
      Top             =   5160
      Width           =   975
   End
   Begin VB.ComboBox cboClerk 
      Height          =   300
      ItemData        =   "frm_CFM.frx":000C
      Left            =   4560
      List            =   "frm_CFM.frx":000E
      Style           =   2  'Dropdown List
      TabIndex        =   5
      Top             =   120
      Width           =   1335
   End
   Begin VB.TextBox txtNum 
      BackColor       =   &H8000000F&
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      Height          =   225
      Left            =   1080
      Locked          =   -1  'True
      TabIndex        =   11
      Text            =   "0"
      Top             =   5160
      Width           =   1215
   End
   Begin VB.TextBox txtM 
      BackColor       =   &H8000000F&
      BorderStyle     =   0  'None
      Enabled         =   0   'False
      Height          =   225
      Left            =   3360
      Locked          =   -1  'True
      TabIndex        =   10
      Text            =   "0"
      Top             =   5160
      Width           =   1215
   End
   Begin VB.TextBox txtDATA 
      BorderStyle     =   0  'None
      Height          =   270
      Left            =   8640
      TabIndex        =   6
      Top             =   600
      Visible         =   0   'False
      Width           =   495
   End
   Begin MSComCtl2.DTPicker DTP 
      Height          =   300
      Index           =   0
      Left            =   600
      TabIndex        =   1
      Top             =   135
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   529
      _Version        =   393216
      CustomFormat    =   "yyyy-MM-dd"
      Format          =   25559043
      CurrentDate     =   38718
   End
   Begin MSFlexGridLib.MSFlexGrid GD1 
      Height          =   4530
      Left            =   120
      TabIndex        =   7
      Top             =   480
      Width           =   9195
      _ExtentX        =   16219
      _ExtentY        =   7990
      _Version        =   393216
      Rows            =   16
      Cols            =   9
      RowHeightMin    =   275
      AllowBigSelection=   0   'False
      HighLight       =   0
      AllowUserResizing=   1
      FormatString    =   "序|配件名称|规格型号|ID|单位|数量|单价|金额|备注"
   End
   Begin MSComCtl2.DTPicker DTP 
      Height          =   300
      Index           =   1
      Left            =   2520
      TabIndex        =   3
      Top             =   120
      Width           =   1335
      _ExtentX        =   2355
      _ExtentY        =   529
      _Version        =   393216
      CustomFormat    =   "HH:mm:ss"
      Format          =   25559042
      CurrentDate     =   38718
   End
   Begin VB.Label Label1 
      Caption         =   "数量合计"
      Height          =   195
      Left            =   240
      TabIndex        =   13
      Top             =   5160
      Width           =   735
   End
   Begin VB.Label Label2 
      Caption         =   "金额合计"
      Height          =   195
      Left            =   2520
      TabIndex        =   12
      Top             =   5160
      Width           =   735
   End
   Begin VB.Label lblxcd 
      Caption         =   "时间"
      Height          =   195
      Index           =   5
      Left            =   2040
      TabIndex        =   2
      Top             =   195
      Visible         =   0   'False
      Width           =   375
   End
   Begin VB.Label lblxcd 
      Caption         =   "经手人"
      Height          =   195
      Index           =   2
      Left            =   3960
      TabIndex        =   4
      Top             =   195
      Width           =   615
   End
   Begin VB.Label lblxcd 
      Caption         =   "日期"
      Height          =   195
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   195
      Width           =   375
   End
End
Attribute VB_Name = "frm_CFM"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2008/01/21
'描    述：汽车维修管理系统SQL2000版
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：Mndsoft@163.com
'e-mail  ：Mndsoft@126.com
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit
Const Bpname = 1
Const Bguige = 2
Const Bppcd = 3
Const Bdw = 4
Const Bnum = 5
Const Bprice = 6
Const Bje = 7
Const Bbak = 8
Public mvarViewType As gxcViewType
Public mvarID As String
Public OK As Boolean
Private Sub CancelButton_Click()
OK = False
Unload Me
End Sub
Public Sub AllClerksToCombo(ByRef cbo As ComboBox)
  Dim i As Long
  Dim objTypes As New Recordset
  cbo.Clear '清除当前的列表内容
  Set objTypes = g_Conn.Execute("Select clkID,clkName from Clerk")
  For i = 1 To objTypes.RecordCount
    Call cbo.AddItem(objTypes(1), i - 1)
    cbo.ItemData(i - 1) = objTypes(0)
    objTypes.MoveNext
  Next i
End Sub
Private Sub DTP_Change(Index As Integer)
If Index = 0 Then DTP(1).Value = DTP(0).Value Else DTP(0).Value = DTP(1).Value
End Sub
Private Sub Form_Load()
    With GD1
        .ColWidth(0) = 300
        .ColWidth(Bpname) = 1400
        .ColWidth(Bguige) = 1400
        .ColWidth(Bppcd) = 0
        .ColWidth(Bdw) = 600
        .ColWidth(Bnum) = 600
        .ColWidth(Bprice) = 600
        .ColWidth(Bje) = 800
        .ColWidth(Bbak) = 2500
    Dim i As Integer
        .TextMatrix(0, 0) = "序"
    For i = 1 To .Rows - 1
        .TextMatrix(i, 0) = i
        .Row = i
        .Col = Bje
        .CellBackColor = &HFFF800
        .Col = Bguige
        .CellBackColor = &HFFF800
        .Col = Bppcd
        .CellBackColor = &HFFF800
        .Col = Bdw
        .CellBackColor = &HFFF800
    Next i
        .Row = 1
        .Col = 1
    End With
AllClerksToCombo cboClerk
Select Case mvarViewType
    Case vtadd
        DTP(0).Value = Now()
        DTP(1).Value = Now()
    Case vtModify
        SetDefaultValue GetID(mvarID)
    Case vtinfo
        SetDefaultValue GetID(mvarID)
        SetStatus
End Select
End Sub
Function SetDefaultValue(IdnStr As String)
Dim RSmain, RSsub As Recordset
Dim i, ii As Integer
Set RSmain = g_Conn.Execute("select * from Store where ID = " & IdnStr)
DTP(0) = RSmain("Fdate")
DTP(1) = RSmain("Fdate")
  For i = 0 To cboClerk.ListCount - 1
    If cboClerk.ItemData(i) = RSmain("cID") Then
      cboClerk.ListIndex = i         '客户类型Id
      Exit For
    End If
  Next i
Set RSmain = Nothing
Set RSsub = g_Conn.Execute("SELECT * FROM SubStore WHERE sID = " & IdnStr)
With GD1
For i = 1 To GD1.Rows - 1
    For ii = 1 To GD1.Cols - 1
    .TextMatrix(i, ii) = ""
    Next
Next
ii = RSsub.RecordCount
For i = 1 To ii
    .TextMatrix(Val(RSsub("Line")), Bpname) = GetValueByID("PeiJian", "ID", RSsub("pID"), "pName")
    .TextMatrix(Val(RSsub("Line")), Bguige) = GetValueByID("PeiJian", "ID", RSsub("pID"), "pType")
    .TextMatrix(Val(RSsub("Line")), Bppcd) = IdnStr
    .TextMatrix(Val(RSsub("Line")), Bdw) = GetValueByID("PeiJian", "ID", RSsub("pID"), "pUnit")
    .TextMatrix(Val(RSsub("Line")), Bnum) = RSsub("pNum")
    .TextMatrix(Val(RSsub("Line")), Bprice) = RSsub("pPrice")
    .TextMatrix(Val(RSsub("Line")), Bbak) = RSsub("pDemo")
    RSsub.MoveNext
Next
Set RSsub = Nothing
End With
GD1_RowColChange
End Function
Private Sub SetStatus()
  Dim ctl As Control
  Dim intBorderStyle As Integer
  Dim lngbkColor As Long
  Dim boolLocked As Boolean
  
    intBorderStyle = 0  '3D
    lngbkColor = &H8000000F
    boolLocked = True
  
  For Each ctl In Controls
    If (TypeOf ctl Is TextBox) Then
      ctl.BorderStyle = intBorderStyle
      ctl.BackColor = lngbkColor
      ctl.Locked = boolLocked
    ElseIf (TypeOf ctl Is ComboBox) Or _
            (TypeOf ctl Is DTPicker) Or _
            (TypeOf ctl Is CheckBox) Or _
            (TypeOf ctl Is MSFlexGrid) Then
      ctl.Enabled = Not boolLocked
    End If
  Next
End Sub
Private Sub GD1_Click()
Select Case GD1.Col
Case Bje, Bguige, Bppcd, Bdw
Case Else
    txtDATA = GD1
    Modi
End Select
End Sub
Private Sub GD1_KeyPress(KeyAscii As Integer)
Select Case GD1.Col
Case Bje, Bguige, Bppcd, Bdw
Case Else
    Select Case KeyAscii
        Case 0 To 32
            KeyAscii = 0
            txtDATA = GD1
            txtDATA.Move GD1.CellLeft + GD1.Left + 20, GD1.CellTop + GD1.Top + 20, GD1.CellWidth - 8, GD1.CellHeight - 8
            txtDATA.Visible = True
            txtDATA.SetFocus
            txtDATA.SelStart = Len(txtDATA.Text)
        Case Else
            txtDATA = Chr(KeyAscii)
            txtDATA.Move GD1.CellLeft + GD1.Left + 20, GD1.CellTop + GD1.Top + 20, GD1.CellWidth - 8, GD1.CellHeight - 8
            txtDATA.Visible = True
            txtDATA.SetFocus
            txtDATA.SelStart = Len(txtDATA.Text)
    End Select
End Select
End Sub
Private Sub GD1_LeaveCell()
If txtDATA.Visible Then
Select Case GD1.Col
    Case Bnum, Bprice
        If Val(txtDATA) <> 0 Then GD1 = Val(txtDATA) Else GD1 = ""
        txtDATA = ""
    Case Bbak
        GD1 = txtDATA
        txtDATA.Text = ""
    Case Bpname
        If txtDATA = "" Then
            Dim i As Integer
            For i = 1 To 100
                GD1.TextMatrix(GD1.Row, 1) = ""
            Next
        End If
    Case Else
    End Select
    txtDATA.Visible = False
End If
End Sub
Private Sub GD1_RowColChange()
    Dim cs, cc As Double
    Dim i As Integer
    cs = 0
    cc = 0
    For i = 1 To GD1.Rows - 1
        If Val(GD1.TextMatrix(i, Bnum)) <> 0 Or Val(GD1.TextMatrix(i, Bprice)) <> 0 Then
            GD1.TextMatrix(i, Bje) = Val(GD1.TextMatrix(i, Bprice)) * Val(GD1.TextMatrix(i, Bnum))
        End If
        cs = cs + Val(GD1.TextMatrix(i, Bnum))
        cc = cc + Val(GD1.TextMatrix(i, Bje))
    Next i
    txtNum = cs
    txtM = cc
End Sub
Private Sub OKButton_Click()
Dim ErrMsg As String
Dim i, newID As Integer
On Error Resume Next
  Select Case mvarViewType
  Case vtadd    '添加客户
If Not Chk Then Exit Sub
    g_Conn.BeginTrans
    newID = NextID("Store", "ID")
        g_Conn.Execute ("insert into Store(ID,Type,Fdate,cID) " & _
                "Values('" & newID & "','1','" & DTP(1).Value & _
                "','" & cboClerk.ItemData(cboClerk.ListIndex) & "')")
        For i = 1 To GD1.Rows - 1
        If GD1.TextMatrix(i, 1) <> "" Then g_Conn.Execute ("insert into SubStore(sID,Line,pID,pNum,pPrice,pDemo) " & _
                "Values('" & newID & "','" & i & "','" & GD1.TextMatrix(i, Bppcd) & _
                "'," & Val(GD1.TextMatrix(i, Bnum)) & "," & Val(GD1.TextMatrix(i, Bprice)) & ",'" & GD1.TextMatrix(i, Bbak) & "')")
        Next
        If Err.Number = 0 Then g_Conn.CommitTrans Else g_Conn.RollbackTrans: MsgBox Err.Description
  Case vtModify '修改客户信息
If Not Chk Then Exit Sub
    g_Conn.BeginTrans
    newID = NextID("Store", "ID")
        g_Conn.Execute ("Update Store set Fdate='" & DTP(1).Value & _
                "',cID='" & cboClerk.ItemData(cboClerk.ListIndex) & "' Where ID='" & GetID(mvarID) & "'")
        For i = 1 To GD1.Rows - 1
        If GD1.TextMatrix(i, 1) <> "" Then g_Conn.Execute ("Update SubStore Set pID='" & GD1.TextMatrix(i, Bppcd) & _
                "',pNum=" & Val(GD1.TextMatrix(i, Bnum)) & ",pPrice=" & Val(GD1.TextMatrix(i, Bprice)) & ",pDemo='" & GD1.TextMatrix(i, Bbak) & _
                "' Where sID='" & GetID(mvarID) & "' and Line='" & i & "'")
        Next
        If Err.Number = 0 Then g_Conn.CommitTrans Else g_Conn.RollbackTrans: MsgBox Err.Description
  Case Else
  End Select
  OK = True
  Unload Me
End Sub
Private Sub txtDATA_DblClick()
Dim obj As New CpName
If frmFindSP.Rel("select pName,pType,ID,pUnit,pNum from PeiJian where pName like '%" & txtDATA.Text & "%'", obj) = True Then
txtDATA.Text = obj.pName
GD1.TextMatrix(GD1.Row, 1) = txtDATA.Text
GD1.TextMatrix(GD1.Row, 2) = obj.pType
GD1.TextMatrix(GD1.Row, 3) = obj.pid
GD1.TextMatrix(GD1.Row, 4) = obj.pUnit
GD1.TextMatrix(GD1.Row, 5) = obj.pNum
txtDATA.Visible = False
GD1.SetFocus
GD1.Col = 5
End If
End Sub
Private Sub txtdata_GotFocus()
txtDATA.Visible = True
End Sub
Private Sub txtDATA_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
    Case 38 'UP
        If GD1.Row > 1 Then
            GD1.Row = GD1.Row - 1
            MovIn
        End If
    Case 40 'DOWN
        If GD1.Row < GD1.Rows - 1 Then
            GD1.Row = GD1.Row + 1
            MovIn
        End If
    Case 37 'LEFT
        If GD1.Col > 1 Then
            If txtDATA.SelStart = 0 Then
                GD1.Col = GD1.Col - 1
                MovIn
            End If
        End If
    Case 39 'RIGHT
        If txtDATA.SelStart = Len(txtDATA.Text) Then
            If GD1.Col < GD1.Cols - 1 Then
                GD1.Col = GD1.Col + 1
                MovIn
            Else
                If GD1.Col = GD1.Cols - 1 And GD1.Row < GD1.Rows - 1 Then
                    GD1.Row = GD1.Row + 1
                    GD1.Col = 1
                    MovIn
                End If
            End If
        End If
    Case 13 'ENTER
        txtDATA_DblClick
End Select
End Sub
Private Sub MovIn()
txtDATA.Visible = False
GD1.SetFocus
End Sub
Private Sub Modi()
txtDATA = GD1
txtDATA.Move GD1.CellLeft + GD1.Left + 20, GD1.CellTop + GD1.Top + 20, GD1.CellWidth - 8, GD1.CellHeight - 8
txtDATA.Visible = True
txtDATA.SetFocus
txtDATA.SelStart = Len(txtDATA.Text)
End Sub
Function Chk() As Boolean
Dim i As Integer
Dim ii As Integer
ii = 0
If cboClerk.Text = "" Then
    MsgBox "错误，经手人不能为空!"
    Chk = False
    Exit Function
End If
With GD1
For i = 1 To 15
    If .TextMatrix(i, Bpname) <> "" Then
    ii = ii + 1
        If Val(.TextMatrix(i, Bnum)) = 0 Then
            MsgBox "第" & i & "行错误，数量不能为零!"
            .Row = i
            Chk = False
            Exit Function
        ElseIf Val(.TextMatrix(i, Bprice)) = 0 Then
            MsgBox "第" & i & "行错误，单价不能为零！"
            .Row = i
            Chk = False
            Exit Function
        ElseIf Len(.TextMatrix(i, Bbak)) > 25 Then
            MsgBox "第" & i & "行错误，备注应小于25个字符！"
            .Row = i
            Chk = False
            Exit Function
        End If
    End If
Next i
End With
If ii > 0 Then
    Chk = True
Else
    MsgBox "没有要保存的数据！"
    Chk = False
End If
End Function

						