mdlpublic.bas

自来水公司的一个管理系统

Attribute VB_Name = "mdlPublic"
Option Explicit

Public Enum PrinterState                    '打印机状态
    Ready                                       '准备好
    Offline                                     '不在线
    NoPaper                                     '缺纸
    AnotherState                                '其它状态
End Enum
Public Enum CountPrecisionType                  '水费计算的精确度（用于零头操作）类型
    Yuan                                        '精确到元---水费的角、分记入零头
    Jiao                                        '精确到角---水费的分，记入零头
    Fen                                         '精确到分---不计算零头
End Enum

Public Enum InVoiceType                     '发票类型
    TogetherPrint = 0                                 '公司统一打印
    SalesDepartmentCash = 1                       '营业厅现金
    BankCash = 2                                  '银行现金
    BankTransfer = 3                              '营业厅划帐
    SalesDepartmentCheck = 4                      '营业厅支票
End Enum


Public gblnLoginSucceeded As Boolean        '用户成功登录系统标志
Public gMainFormRefer As Form               '主窗口的一个"引用"
Public gConnect As ADODB.Connection         '提供本系统的全局数据库连接
Public gTitleHeight As Integer              '定义子窗口上部的按扭区(或信息显示区)的高度
Public gstrCurOperatorID As String          '当前的操作员编号
Public gstrCurOperatorName As String        '当前的操作员姓名
Public gCountPrecision As CountPrecisionType '本系统水费计算精度


Public Const intBottomBoxHeight = 600       '底端按扭区域的高度
Public Const gMaxLen = 60                   '定义了数据库中大部分Varchar类型字段的最大标准长度,该常量要和数据库中的设计长度一致
Public Const gConnent = 100
Public Const gDecipher = "123456"           '固定的密码明文,加密过程就是用用户输入的口令password,对该明文进行加密,存入数据库
Public Const gUIDLen = 5                    '定义了用户档案中用户顺序号的长度，该数值应和表中相应字段长度对应
Public Const gEIDLen = 3                    '定义了业务员表中业务员工号的长度，该数值应和表中相应字段长度对应
Public Const gWmIDLen = 6                   '定义了用户水表编号的长度，该数值应和表中相应字段长度对应
Public Const gMWmIDLen = 6                  '定义了总水表编号的长度，该数值应和表中相应字段长度对应
Public Const gConstructIDLen = 7            '定义了施工单(用户接水卡)编号的长度，该数值应和表中相应字段长度对应
Public Const gSwIDLen = 6                   '定义了停水单编号的长度，该数值应和表中相应字段长度对应
Public Const gPlIDLen = 6                   '定义了管网维修单编号的长度，该数值应和表中相应字段长度对应
Public Const gFixIDLen = 7                  '定义了用户水表维修（更换）单编号的长度，该数值应和表中相应字段长度对应
Public Const gIIDLen = 8                    '定义了水费发票内部流水号（非印制的号，是程序自动生成再打到发票上的）的长度，该数值应和表中相应字段长度对应
'---------------------------------
Public Const gPumpRoomIDLen = 2             '定义了机房编制中机房编号的长度
Public Const gFileNameLen = 200             '定义了文件名称(全路径)的长度
Public Const gDescribeLen = 100             '定义了技术资料档案描述的长度



Public Const gWaterRateNotify = "#WaterRateNotify"      '定义了水费通知单临时表的表名--私人表
Public Const gWaterRate = "#WaterRateCount"             '定义了水费计算表的表名--私人表（该临时表的结构和库中的WaterRate表一样）


Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long


'------------------
'公共函数部分
'------------------
Public Sub ResizeDG(ByVal ParentHeight As Single, ByVal ParentWidth As Single, ByRef DG As DataGrid)
   '-------------------------
   '功能：  用于当父窗体尺寸改变时调整DataGrid控件充满窗体下部
   '参数：  ParentHeight:所在窗体的客户区高度
   '        ParentWidth :所在窗体的客户区宽度
   '        DG          :DataGrid控件的引用
   '返回值:
   '用法:   ResizeDG Me.ScaleHeight,Me.ScaleWidth,DataGrid控件
   '建立:   2001/3/25   pc
   '修改:
   '修改内容:
   '-------------------------
   On Error Resume Next
   
   DG.Height = ParentHeight - gTitleHeight
   DG.Width = ParentWidth
   On Error GoTo 0  '清除错误陷阱
End Sub

Public Sub MoveToCenter(ByVal ParentForm As Form, ByRef theForm As Form)
   '-------------------------
   '功能：  将窗体移动到父窗体的中心
   '参数：  ParentForm:父窗体
   '        theForm   :窗口
   '返回值:
   '用法:   MoveToCenter  父窗体,Me
   '建立:   2001/3/25   pc
   '修改:
   '修改内容:
   '-------------------------
   On Error Resume Next
   theForm.Move (ParentForm.ScaleWidth - theForm.Width) / 2, (ParentForm.ScaleHeight - theForm.Height) / 2, theForm.Width, theForm.Height
   On Error GoTo 0  '清除错误陷阱
End Sub

Public Sub LimitFormLeastSize(ByRef theForm As Form, ByVal LimitWidth As Long, ByVal LimitHeight As Long)
   '-------------------------
   '功能：  限制窗体的最小尺寸
   '参数：  theForm :要限制尺寸的窗体
   '        LimitWidth :最小宽度
   '        LimitHeight :最小高度
   '返回值:
   '用法:   LimitFormLeastSize  me,最小宽度,最小高度
   '建立:   2001/3/26   pc
   '修改:
   '修改内容:
   '-------------------------
   If LimitWidth < 0 Or LimitHeight < 0 Then
        MsgBox "出错:LimitFormLeastSize" & Chr(13) & "最小尺寸不能<0", vbOKOnly + vbExclamation, "警告"
        Exit Sub
   End If
   On Error Resume Next
   If theForm.Width < LimitWidth Then
        theForm.Width = LimitWidth
   End If
   If theForm.Height < LimitHeight Then
        theForm.Height = LimitHeight
   End If
   On Error GoTo 0  '清除错误陷阱
End Sub

Public Sub FullOfMainForm(ByRef theSubForm As Form)
   '-------------------------
   '功能：  调整子窗体充满主窗体
   '参数：  theForm :要限制尺寸的窗体
   '返回值:
   '用法:   FullOfMainForm  me
   '建立:   2001/8/15 by   pc
   '修改:
   '修改内容:
   '-------------------------
    theSubForm.Left = 0
    theSubForm.Top = 0
    theSubForm.Height = gMainFormRefer.ScaleHeight
    theSubForm.Width = gMainFormRefer.ScaleWidth
End Sub



Public Function DetectDiskState() As Byte
   '-------------------------
   '功能：  用于检测软磁盘驱动器的当前状态
   '参数：
   '返回值: 0：未准备好，1：写保护，2：正常
   '用法:   DetectDiskState
   '建立:   2001/3/29   pc
   '修改:
   '修改内容:
   '-------------------------
   '
   '
   '
   '
   '
   '暂时模拟
    DetectDiskState = 2
    
End Function

Public Function DetectPrinterState() As PrinterState
   '-------------------------
   '功能：  用于检测打印机的当前状态
   '参数：
   '返回值: 参见PrinterState枚举定义
   '用法:   DetectPrinterState
   '建立:   2001/4/2  by pc
   '修改:
   '修改内容:
   '-------------------------
   '
   '
   '
   '
   '
   '暂时模拟
    DetectPrinterState = Ready
End Function

Public Sub AutoSelectText(ByRef SelObject As Control)
   '-------------------------
   '功能：  用于当焦点进入文本编辑筐时自动选择已经有的文本
   '参数：  SelObject 欲设置的控件
   '返回值:
   '用法:   在控件的GotFocus中 call AutoSelectText(欲设置的控件名)
   '建立:   2001/4/18  by pc
   '修改:
   '修改内容:
   '-------------------------
   
    SelObject.SelStart = 0
    If TypeOf SelObject Is MaskEdBox Then
        SelObject.SelLength = Len(SelObject.FormattedText)
    Else
        If TypeOf SelObject Is TextBox Or TypeOf SelObject Is RichTextBox Then
            SelObject.SelLength = Len(SelObject.Text)
        End If
    End If
End Sub

Public Sub IfEnterKeyMoveNext(ByRef KeyAscii As Integer)
   '-------------------------
   '功能：  主要是用于在控件中按回车键时焦点自动进入下一个控件
   '参数：  KeyAscii 按键的键值,该值直接由控件的KeyPress的参数传来
   '返回值:
   '用法:   在控件的KeyPress中调用IfEnterKeyMoveNext()
   '建立:   2001/4/18  by pc
   '修改:
   '修改内容:
   '-------------------------
    If KeyAscii = 13 Then
        KeyAscii = 0
        SendKeys "{tab}"
    End If
End Sub

Public Sub CheckExist(fm As Form)
   '-------------------------
   '功能：  是程序不能同时运行两份
   '参数：  程序的主表单
   '返回值:
   '用法:   在程序的主表单中     Call CheckExist(Me)
   '建立:   2001/4/18  by pc
   '修改:
   '修改内容:
   '-------------------------
    Dim title As String
    If App.PrevInstance Then
        title = App.title
        Call MsgBox("本程序已经执行！", vbCritical)
        App.title = ""    '如此才不会Avtivate到自己
        fm.Caption = ""
        AppActivate title 'activate先前就已行的程序
    End
    End If
End Sub

Public Function mInputBox(Optional ByVal strTitle As String = "数据输入", Optional ByVal strPrompt As String = "数据输入", Optional ByVal strInputDefa As String = "", Optional ByVal intMaxLen As Integer = 60)
   '-------------------------
   '功能：  代替InputBox的函数(由于InputBox函数在输入中文时显示乱码，因此，做该程序)
   '参数：  strTitle 显示标题， strPrompt 显示提示信息,  strInputDefa 缺省值,intMaxLen 定义用户可输入的最大字符串长度
   '返回值: 输入的字符串
   '用法:   返回值=mInputBox("片区输入","请输入片区名称:","")
   '建立:   2001/4/24  by pc
   '修改:
   '修改内容:
   '注：    该函数调用frmInputBox表单作为输入界面
   '-------------------------
    frmInputBox.strTitle = Trim(strTitle)
    frmInputBox.strPrompt = Trim(strPrompt)
    frmInputBox.strInputDefa = Trim(strInputDefa)
    
    frmInputBox.Show vbModal
    
    mInputBox = frmInputBox.strInputText
End Function

Public Sub Warning(ByVal strInfo As String)
   '-------------------------
   '功能：  显示警告信息框
   '参数：  警告信息字符串
   '返回值:
   '用法:   call Warming("警告信息")
   '建立:   2001/4/26  by pc
   '修改:
   '修改内容:
   '-------------------------
    MsgBox strInfo, vbOKOnly + vbExclamation, "警告"
End Sub

Public Function Cipher(ByVal password As String) As String
   '-------------------------
   '功能：  用给定的口令将固定(全局变量gDecipher)的明文转换为密码
   '参数：  password 口令
   '返回值: 对应的密文
   '用法:   密文=Cipher(口令)
   '建立:   2001/5/07  by pc
   '修改:
   '修改内容:
   '-------------------------
    Const MIN_ASC = 32  ' Space.
    Const MAX_ASC = 126 ' ~.
    Const NUM_ASC = MAX_ASC - MIN_ASC + 1

    Dim offset As Long
    Dim str_len As Integer
    Dim i As Integer
    Dim ch As Integer
    Dim to_text As String   '返回值

    ' 初始化随机数
    offset = NumericPassword(password)
    Rnd -1
    Randomize offset

    ' 加密
    to_text = ""
    str_len = Len(gDecipher)
    For i = 1 To str_len
        ch = Asc(Mid$(gDecipher, i, 1))
        If ch >= MIN_ASC And ch <= MAX_ASC Then
            ch = ch - MIN_ASC
            offset = Int((NUM_ASC + 1) * Rnd)
            ch = ((ch + offset) Mod NUM_ASC)
            ch = ch + MIN_ASC
            to_text = to_text & Chr$(ch)
        End If
    Next i
    Cipher = to_text
End Function

Private Function Decipher(ByVal password As String, ByVal from_text As String) As String
   '-------------------------
   '功能：  用给定的口令将固定的密文用给定的口令转换为明文
   '参数：  password 口令,from_text 密文
   '返回值: 对应的明文
   '用法:   明文=Decipher(口令,密文)
   '建立:   2001/5/07  by pc