module1.bas

餐饮企业的管理系统主要包括前台管理、后台管理、财务管理、报表打印等功能

Attribute VB_Name = "Module1"
Option Explicit '限制变量必须先声明后使用
Public cn As ADODB.Connection '定义公用ADO连接变量
Public Sql, sqlStr As String '定义公用字符串变量
Public Bkm, FormNumber As Integer '用于记录ADO指针位置的整形变量
Dim myform As Form '定义窗体类型变量

Sub Main()
On Error GoTo err1                          '启动错误转向错误处理
     Bkm = 1 '设置Bkm的初值为1
    Set cn = New ADODB.Connection          '声明一个数据连接对象
    cn.ConnectionString = "Provider=SQLOLEDB.1;Persist Security Info=False;" & _
                            "User ID=sa;Initial Catalog=CYGLXT;Data Source=."
                                            '给数据连接字符串赋值
    cn.Open                                '打开数据连接
    main_Startup.Show vbModal               '打开欢迎窗体
    Exit Sub                                '结束启动程序
err1:
    ErrMessageBox "Main()启动过程出错" '出错信息显示
End Sub

Public Function cnn() As String    '定义函数
  '返回一个数据库连接
  cnn = "Provider=MSDASQL.1;Persist Security Info=False;" & _
        "User ID=sa;Data Source=CYGLXT;Initial Catalog=CYGLXT" ' 定义一个数据连接
End Function
Public Sub Enter(KeyCode As Integer)
 'VbKeyReturn常数为键盘上的"回车键"
  If KeyCode = vbKeyReturn Then '如果是回车键
     SendKeys "{Tab}" '发送Tab键的ASSII码值
  End If '结束If语句
End Sub

Public Sub ErrMessageBox(ByVal sPrompt As String)
    Dim msg As String                               '变量msg用于记录要在弹出对话框中显示的信息
    Dim ErrMsg As String                            'ErrMsg记录错误信息代码以及描述
    ErrMsg = "错误#" & CStr(Err.Number) & "：" & Err.Description    '错误信息代码以及描述
    msg = sPrompt & vbCrLf & ErrMsg                 '弹出对话框中显示的错误信息
    MsgBox msg, vbOKOnly + vbInformation   '显示弹出对话框
End Sub
Public Function FunAdo(ByVal ado As Adodc, ByVal Str As String) '构造连接ADO的连接执行函数
On Error GoTo err1           '执行过程中如果发生错误转向错误处理
    With ado               '使用With结构
        .Visible = False       'Ado不可见
        .ConnectionString = cn.ConnectionString    '设置Ado的连接字符串
        .CommandType = adCmdText    '设置Ado的命令类型
        .RecordSource = Str     '设置Ado的记录源
        .Refresh        '刷新Ado的记录集
    End With        '结束With结构
    Exit Function   '结束函数
err1:
    ErrMessageBox "与数据库连接失败！" '显示错误信息
End Function
'文本框仅接受数字
Public Function AcceptNumber(ByVal KeyAscii As Integer) As Integer
    Select Case KeyAscii                            '用Select Case限制输入的字符
        Case vbKey0, vbKey1, vbKey2, vbKey3, vbKey4, vbKey5, vbKey6, vbKey7, vbKey8, vbKey9, 8
            AcceptNumber = KeyAscii                 '当输入的字符是0～9或Backspce时输入值即为返回值
        Case Else
            AcceptNumber = 0                        '输入的字符不是0～9时返回NULL的ASCII值
    End Select                                      '结束Select语句
End Function
'MS1为 MSFlexGrid 控件的名称
Public Sub entercell()     '定义text1在MS1表中的位置函数
  If FormNumber = 1 Then Set myform = main_htgl_jhgl      '将调用函数的窗体名称设置为 myform
  If FormNumber = 2 Then Set myform = main_qtgl_ktgl_ktfw '将调用函数的窗体名称设置为 myform
  If FormNumber = 3 Then Set myform = main_qtgl_ktgl_jcfw '将调用函数的窗体名称设置为 myform
  Dim X, y, p As String '定义字符串变量
  If myform.MS1.CellWidth <= 0 Or myform.MS1.CellHeight <= 0 Then '如果MS1的列宽或行高不大于0
    Exit Sub '跳出Sub过程
  End If
  X = myform.MS1.TextMatrix(myform.MS1.FixedRows, myform.MS1.Col) '取得活动单元格的文本
  y = myform.MS1.TextMatrix(myform.MS1.Row, 0) '取得第一列某一单元格的内容
  If y <> "" Then '如果y值不为空
     '最左边可见的单元格
     If myform.MS1.Col - myform.MS1.LeftCol <= 3 Then myform.MS1.LeftCol = myform.MS1.LeftCol + 1
      If myform.MS1.CellWidth > 0 And myform.MS1.CellHeight > 0 Then '当前单元格存在
        myform.Text1.Width = myform.MS1.CellWidth '设置文本框的宽度
        myform.Text1.Height = myform.MS1.CellHeight '设置文本框的高度
        myform.Text1.Left = myform.MS1.CellLeft + myform.MS1.Left '设置文本框的位置
        myform.Text1.Top = myform.MS1.CellTop + myform.MS1.Top '设置文本框的位置
     End If '结束If语句
     X = myform.MS1.TextMatrix(myform.MS1.FixedRows, myform.MS1.Col) '重新为变量X赋值
     y = myform.MS1.TextMatrix(myform.MS1.Row, 0) '重新为变量y赋值
     p = myform.MS1.TextMatrix(myform.MS1.Row, myform.MS1.Col) '取得活动单元格的文本
     myform.Text1.text = myform.MS1.text '把控件中的文本赋给Text1
     myform.Text1.SelStart = 0 '设定Text1文本框的起始位置为0
     myform.Text1.SelLength = Len(myform.Text1.text) '设定Text1文本框字符数
  End If
End Sub
Public Sub moveright()     '定义text1向右移动函数
  If FormNumber = 1 Then Set myform = main_htgl_jhgl '将调用函数的窗体名称设置为 myform
  If FormNumber = 2 Then Set myform = main_qtgl_ktgl_ktfw '将调用函数的窗体名称设置为 myform
  If FormNumber = 3 Then Set myform = main_qtgl_ktgl_jcfw '将调用函数的窗体名称设置为 myform
  If myform.Text1.text <> "" Then '如果输入的内容为空
     myform.Text1.SelStart = 0 '设定Text1文本框的起始位置为0
     myform.Text1.SelLength = Len(myform.Text1.text) '设定Text1文本框字符数
  End If '结束If语句
  If myform.MS1.Col + 1 <= myform.MS1.Cols - 1 Then '如果不是最右边的单元格
     myform.MS1.Col = myform.MS1.Col + 1 '向右移动一个单元格
  Else '如果是最右边的单元格
     If myform.MS1.Row + 1 <= myform.MS1.Rows - 1 Then '如果不是最后一行
        myform.MS1.Row = myform.MS1.Row + 1 '移动到下一行
        myform.MS1.Col = 1 '移动到第一个单元格
     End If '结束If语句
  End If '结束If语句
End Sub

'MS1为 MSFlexGrid 控件的名称
Public Sub moveleft()     '定义text1向左移动函数
 If FormNumber = 2 Then Set myform = main_qtgl_ktgl_ktfw '将调用函数的窗体名称设置为 myform
 If FormNumber = 3 Then Set myform = main_qtgl_ktgl_jcfw '将调用函数的窗体名称设置为 myform
 If myform.Text1.text <> "" Then '如果输入文本框不为空
    myform.Text1.SelStart = 0 '设定Text1文本框的起始位置为0
    myform.Text1.SelLength = Len(myform.Text1.text) '设定Text1文本框字符数
 End If '结束If语句
 If myform.MS1.Col - 8 <= myform.MS1.Cols + 1 Then '如果不是最左边的单元格
    myform.MS1.Col = myform.MS1.Col - 1 '向右移动一个单元格
    If myform.MS1.Col = 0 Then myform.MS1.Col = 1 '如果是序号列，单元格移动到第一列
 Else '如果是最左边的单元格
    If myform.MS1.Row + 1 <= myform.MS1.Row - 1 Then '如果不是第一行
       myform.MS1.Row = myform.MS1.Row + 1 '向上移动一行
       myform.MS1.Col = 1 '焦点移动到第一列
    End If '结束If语句
 End If '结束If语句
End Sub
Public Sub movereturn()     '定义text1回车移动函数
  If FormNumber = "2" Then Set myform = main_qtgl_ktgl_ktfw
  If FormNumber = "3" Then Set myform = main_qtgl_ktgl_jcfw
  If myform.MS1.Col = 8 Then
     myform.MS1.Row = myform.MS1.Row + 1
     myform.MS1.Col = 1
   Else
     If myform.MS1.Col + 1 <= myform.MS1.Cols - 1 Then
        myform.MS1.Col = myform.MS1.Col + 1
     Else
        If myform.MS1.Row + 1 <= myform.MS1.Rows - 1 Then
           myform.MS1.Row = myform.MS1.Row + 1
           myform.MS1.Col = 1
        End If
     End If
  End If
End Sub