form1.frm

一套简单的销售管理系统

Attribute VB_Exposed = False
Dim i, j, n As Integer
Dim sql As String
Private Declare Function GetKeyState Lib "user32" _
   (ByVal nVirtKey As Long) As Integer
Public je As Integer '记忆菜单上次数值，实现数据传送
Private Sub asPopup1_Click(Cancel As Boolean)
gridsave = True
gridedit = False
griddelete = False
yuzhi = True
nnum = 0 '翻页数据洗清
num = 0
Grid1.Visible = False
Grid2.Visible = True
Grid2.Rows = 1 '清除所有记录
Grid2.Rows = 30 '默认为30行
jnumber = 10
nnumber = nnumber + 1
nconn
xstj
Set qy1 = cnn.Execute("select * from 销售记录")
Grid2.Cols = jnumber '必须+1,因为实际上为11行,但第一行是隐藏的
For i = 0 To jnumber - 2 '显示数据的字段名
Grid2.Cell(0, i + 1).Text = qy1.Fields(i).Name
Next
Grid2.Cell(1, 1).SetFocus
Set s1 = cnn.Execute("select * from 商品类型")
Grid2.ComboBox(1).Clear
Do While s1.EOF = False
Grid2.ComboBox(1).AddItem s1.Fields(0)
s1.MoveNext
Loop
End Sub
Private Sub xstj()
    Grid1.Visible = False
    Grid2.Top = Grid1.Top
    Grid2.Width = Grid1.Width
    Grid2.Left = Grid1.Left
    Grid2.Height = 4860
    Grid2.Cols = 11
    Grid2.Column(0).Width = 0
    Grid2.Column(1).Width = 80
    Grid2.Column(2).Width = 80
    Grid2.Column(3).Width = 80
    Grid2.Column(4).Width = 40
    Grid2.Column(5).Width = 70
    Grid2.Column(6).Width = 70
    Grid2.Column(7).Width = 70
    Grid2.Column(8).Width = 70
    Grid2.Column(9).Width = 70
    Grid2.Column(1).CellType = cellComboBox
    Grid2.Column(2).CellType = cellComboBox
    Grid2.Column(3).CellType = cellComboBox
    Grid2.Column(5).CellType = cellComboBox
    Grid2.Column(8).CellType = cellComboBox
    Grid2.Column(9).CellType = cellCheckBox
    Grid2.ReadOnly = False
    Dim dh As Integer
    Dim strdh As String
    Dim bdh As Boolean
    bdh = False
    dh = 1
    Do While bdh = False
    strdh = dh
    Do While Len(strdh) < 6
    strdh = "0" & strdh
    Loop
    Grid3.Cell(1, 1).Text = Year(Date) & Month(Date) & Day(Date) & strdh
    Set qy1 = cnn.Execute("select * from 销售单据 where 单号='" & Grid3.Cell(1, 1).Text & "'")
    If qy1.EOF = False Then
     dh = dh + 1
     Else
     bdh = True
     End If
    Loop
    Grid3.Cell(1, 4).Text = Grid3.Cell(1, 1).Text
    Grid3.Cell(1, 3).Text = Date
    Grid3.Cell(1, 6).Text = loginname
Set qy2 = cnn.Execute("select * from 合作单位")
Grid3.ComboBox(2).Clear
Do While qy2.EOF = False
Grid3.ComboBox(2).AddItem qy2.Fields(0)
qy2.MoveNext
Loop
End Sub
Private Sub asPopup2_Click(Cancel As Boolean)
yuzhi = False
Grid1.Cell(0, 0).SetFocus '防止数据被覆盖
jsql = "select * from 销售单据 order by 序号 desc"
sellnote
nnumber = nnumber + 1
nconn
gridsave = False '允许保存
griddelete = True
gridedit = True
End Sub
Private Sub sellnote() '销售指令
xsjl '执行销售表格的处理
 If qy1.State = adStateOpen Then
  qy1.Close
 End If
qy1.Open jsql, cnn, adOpenStatic, adLockReadOnly, adCmdText
qy1.PageSize = 10
nnum = qy1.PageCount
If qy1.PageCount = 0 Then
nnum = 1
End If
numpage = 1
Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
Grid1.Rows = 11
jnumber = 7
Grid1.Cols = jnumber '必须+2,因为实际上为11行,但第一行是隐藏的
For i = 1 To jnumber - 2
Grid1.Cell(0, i).Text = qy1.Fields(i).Name
Next
Grid1.Rows = 1
Grid1.Rows = 11
If qy1.RecordCount = 0 Then
Exit Sub
End If
qy1.AbsolutePage = numpage
 For i = 1 To 10 '设定读取行
 For j = 1 To jnumber - 2 '设定读取列
  If qy1.EOF = True Then
  Exit Sub
  End If
 If qy1.Fields(j) = noNull Then '空值的处理
  Grid1.Cell(i, j).Text = ""
 Else
  Grid1.Cell(i, j).Text = qy1.Fields(j)
 End If
 Next
 If qy1.EOF = False Then
 qy1.MoveNext '读取下一记录
 Else
 Exit Sub
 End If
 Next
End Sub
Private Sub xsjl()
    Grid1.Visible = True
    Grid2.Visible = True
    Grid2.Top = 5730
    Grid2.Width = 10125
    Grid2.Left = 1875
    Grid2.Height = 1920
    Grid2.Cols = 10
    Grid2.Rows = 1
    Grid2.Rows = 6
    'Grid2.ReadOnly = True
    If qy1.State = adStateOpen Then '表状态
    qy1.Close
    End If
    qy1.Open "select * from 销售记录", cnn, adOpenKeyset, adLockReadOnly, adCmdText
    i = 9
    Grid2.Cols = i + 1 '必须+1,因为实际上为11行,但第一行是隐藏的
    For i = 0 To 8 '显示数据的字段名
    Grid2.Cell(0, i + 1).Text = qy1.Fields(i).Name
    Next
    Grid2.Column(0).Width = 0
    Grid2.Column(1).Width = 80
    Grid2.Column(2).Width = 80
    Grid2.Column(3).Width = 80
    Grid2.Column(4).Width = 40
    Grid2.Column(5).Width = 70
    Grid2.Column(6).Width = 70
    Grid2.Column(7).Width = 70
    Grid2.Column(8).Width = 70
    Grid2.Column(1).CellType = cellComboBox
    Grid2.Column(2).CellType = cellComboBox
    Grid2.Column(3).CellType = cellComboBox
    Grid2.Column(5).CellType = cellComboBox
    Grid2.Column(8).CellType = cellComboBox
    Grid2.Column(9).CellType = cellCheckBox
    Grid1.Column(0).Width = 0
    Grid1.Column(1).Width = 120
    Grid1.Column(2).Width = 100
    Grid1.Column(3).Width = 80
    Grid1.Column(4).Width = 100
    Grid1.Column(5).Width = 120
    Grid1.Column(5).Width = 100
    Grid1.ReadOnly = True
End Sub

Private Sub asPopup3_Click(Cancel As Boolean)
XPFrame3.Visible = True
XPFrame3.Left = (Me.Width / 2) - (XPFrame3.Width / 2)
XPFrame3.Top = (Me.Height / 2) - (XPFrame3.Height / 2)
Set s1 = cnn.Execute("select * from 合作单位")
nnumber = nnumber + 1
nconn
FCombo2.Clear
Do While s1.EOF = False
FCombo2.AddItem s1.Fields(0)
s1.MoveNext
Loop
End Sub

Private Sub asPopup4_Click(Cancel As Boolean)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hwnd = Form3.hwnd
fo2.Alpha = 85 / 100 * 255
Load Form3
Form3.Show 1
End Sub

Private Sub asPopup5_Click(Cancel As Boolean)
XPFrame2.Visible = True
XPFrame2.Left = (Me.Width / 2) - (XPFrame2.Width / 2)
XPFrame2.Top = (Me.Height / 2) - (XPFrame2.Height / 2)
Set s1 = cnn.Execute("select * from 合作单位")
nnumber = nnumber + 1
nconn
FCombo1.Clear
Do While s1.EOF = False
FCombo1.AddItem s1.Fields(0)
s1.MoveNext
Loop
End Sub

Private Sub asPopup6_Click(Cancel As Boolean)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hwnd = Form4.hwnd
fo2.Alpha = 90 / 100 * 255
Me.WindowState = vbMinimized
nnumber = nnumber + 1
nconn
Load Form4
Form4.Show 1
End Sub

Private Sub asPopup9_Click(Cancel As Boolean)
End
End Sub

Private Sub c1_Click(Index As Integer) '提交内容到函数执行，4为当前菜单（0-4），index是按钮数组名称
cmove 3, Index
End Sub
Private Sub cmove(s As Integer, i As Integer) '菜单智能移动函数代码
Dim j As Integer
Dim X, Y, z, x1, y1 As Integer
X = s
Y = s
z = s
x1 = s
j = 0
nnumber = nnumber + 1
nconn
Do While s > 0
   If je > i Then
    Do While X > i
      Do While Y >= X
      j = j + 360
      Y = Y - 1
      Loop
      c1(X).Top = Fre1.Height - j
      X = X - 1
    Loop
    Else
    '-----------------向上代码
     For X = 0 To i
       For Y = 0 To X
       j = j + 360
       Next
       c1(X).Top = j - 360
       j = 0
     Next
    End If
  s = s - 1
        For y1 = 0 To x1
      If y1 = i Then
       Fre2(y1).Visible = True
       Fre2(y1).Top = c1(y1).Top + c1(y1).Height
       If y1 <> z Then
       Fre2(y1).Height = c1(y1 + 1).Top - Fre2(y1).Top
       Else
       Fre2(y1).Height = Fre1.Height - c1(y1).Top - c1(y1).Height
       End If
      Else
       Fre2(y1).Visible = False
      End If
    Next
Loop
je = i
End Sub

Private Sub Grid1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If gridsave = True Then
  tjsave.Enabled = True
Else
  tjsave.Enabled = False
End If
If gridedit = True Then
  tjedit.Enabled = True
Else
  tjedit.Enabled = False
End If
If griddelete = True Then
  tjdelete.Enabled = True
Else
  tjdelete.Enabled = False
End If
PopupMenu ZT
End If
End Sub

Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
    hang1 = Row
    Set qy1save = cnn.Execute("select * from 销售记录 where 批号='" & Grid1.Cell(Row, 4).Text & "' order by 内部编号 asc")
    Grid2.Rows = 1
    i = 0
    Do While Not qy1save.EOF
       i = i + 1
       Grid2.Rows = Grid2.Rows + 1
       For j = 1 To Grid2.Cols - 1 '设定读取列
        If qy1save.Fields(j - 1) = Null Then '空值的处理
          Grid2.Cell(i, j).Text = ""
        Else
          Grid2.Cell(i, j).Text = qy1save.Fields(j - 1)
        End If
       Next
       qy1save.MoveNext '读取下一记录
    Loop
End Sub

Private Sub Grid1_Validate(Cancel As Boolean) '设定TAB键切换
    Dim nActiveRow As Long, nActiveCol As Long
    Const VK_TAB = 9

    If GetKeyState(VK_TAB) < 0 Then
        nActiveRow = Grid1.ActiveCell.Row
        nActiveCol = Grid1.ActiveCell.Col
        If nActiveCol < Grid1.Cols - 1 Then
            Grid1.Range(nActiveRow, nActiveCol + 1, _
                        nActiveRow, nActiveCol + 1).Selected
        End If
        Cancel = True
    End If
End Sub
Private Sub Form_Load()
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
Grid2.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
Grid3.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
Label2.Caption = "今天是" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日,欢迎您进入!"
XPFrame1.BackColor = RGB(100, 98, 160)
form1.BackColor = RGB(100, 98, 160)
With Grid1
    .AllowUserResizing = True
    .DisplayFocusRect = False
    .ExtendLastCol = True
    .Appearance = Flat
    .FixedRowColStyle = Flat
    .ScrollBarStyle = Flat
    
    .DefaultFont.Name = "Tahoma"
    .DefaultFont.SIZE = 8
    .BackColorFixed = RGB(100, 98, 160) 'RGB(84, 201, 134)
    .BackColorFixedSel = RGB(100, 98, 160) 'RGB(84, 201, 134)
    .BackColorBkg = RGB(198, 229, 211)
    .BackColorScrollBar = RGB(198, 229, 211)
    .BackColor1 = RGB(231, 235, 247)
    .BackColor2 = RGB(198, 229, 211)
    .GridColor = RGB(148, 190, 231)
    .Column(0).Width = 0
End With
With Grid2
   .AllowUserResizing = True
   .DisplayFocusRect = False
   .ExtendLastCol = True
   .Appearance = Flat
   .FixedRowColStyle = Flat
   .ScrollBarStyle = Flat
   .AllowUserResizing = True
   .DisplayFocusRect = False