pub_memo.bas

学生信息管理系统(VB+sql)+毕业论文2万字 (338 回复) 排课管理系统vb (278 回复) 求vb+acess做的超市销售管理...毕业设计(酒店管理系统+报告(分析==)) (306 回

'* 功    能 : 用系统变量sys_lxc 给Combobox控件赋值
'* 参数说明:  m_com     : 控件的名称
'*            C_sysvar  :字符型系统变量名
'             n_sysvar  :数字型系统变量名
'******************************************************************

Public Sub pub_combox(m_com As Control, n_sysvar As Integer, c_sysvar As Variant)
    Dim i As Integer

    m_com.Clear
        For i = 1 To n_sysvar
            m_com.AddItem
            m_com.List(i - 1, 0) = i
            m_com.List(i - 1, 1) = c_sysvar(i)
        Next i
End Sub


'****************************************************************
'* 功    能 : 用窄打纸打印,每页50条记录
'* 参数说明:  DY_REC    :包含全部打印信息的记录集
'*            DY_BT     :表头
'*            FIEL_NAME :列名
'*            FIEL_LONG :列的最大打印长度
'*            X_FIRST   :表的起始位置,0-14000之间
'****************************************************************
Public Function print_table(dy_rec As Recordset, dy_bt As String, fiel_name As Variant, fiel_long As Variant, x_first As Integer)
Dim m As Integer, n As Integer, j As Integer, k As Integer, m_long As Integer, i As Integer
Dim dx As Integer, y_first As Integer, dy As Integer, pot_pot As Integer, line_high As Integer
    m_long = 0
    For i = 1 To dy_rec.Fields.Count
        m_long = m_long + fiel_long(i - 1)
    Next
    y_first = 1400
    pot_pot = 100
    line_high = 220
    dy_rec.MoveLast
    k = dy_rec.RecordCount
    m = Int(k / 50)             '页数
    n = k Mod 50                '剩余记录数
    Printer.PaperSize = vbPRPSUser
    Printer.Width = 14000
    Printer.Height = 16000
    
    dy_rec.MoveFirst
    For i = 1 To m
            
        Printer.FontSize = 16
        Printer.FontBold = True
        Printer.CurrentX = x_first
        Printer.CurrentY = 500
        Printer.Print dy_bt
        Printer.FontSize = 10
        dx = x_first
        Printer.CurrentX = dx
        For j = 1 To dy_rec.Fields.Count
                Printer.CurrentY = 1000
                Printer.Print Trim(fiel_name(j - 1)) '打印表头
                dx = dx + fiel_long(j - 1) * pot_pot
                Printer.CurrentX = dx
        Next
        Printer.Line (x_first, 1300)-(x_first + m_long * pot_pot, 1300) 'PRINT ------------
        Printer.FontBold = False
        
        dy = y_first
        For k = 1 To 50
                dx = x_first
                For j = 1 To dy_rec.Fields.Count
                        Printer.CurrentX = dx
                        Printer.CurrentY = dy
                        Dim a As String
                        If Len(Trim(dy_rec.Fields(j - 1))) <> 0 Then
                            Printer.Print LeftB$(CStr(dy_rec.Fields(j - 1)) + Space(fiel_long(j - 1)), 2 * fiel_long(j - 1))
                        Else
                            Printer.Print " "
                        End If
                        dx = dx + fiel_long(j - 1) * pot_pot
                       
                Next
                dy = dy + line_high
                Printer.CurrentY = dy
                dy_rec.MoveNext
        Next
        Printer.Line (x_first, 13300)-(x_first + m_long * pot_pot, 13300)
        Printer.CurrentX = x_first
        Printer.CurrentY = 13500
        Printer.Print "第"; i; "  页,共"; m + 1; " 页        打印时间:"; Date; "    制表人:"; SYS_NAME
        Printer.NewPage
    Next
    
    Printer.FontSize = 16
    Printer.FontBold = True
    Printer.CurrentX = x_first
    Printer.CurrentY = 500
    Printer.Print dy_bt
    Printer.FontSize = 10
                
    dx = x_first
    Printer.CurrentX = dx
    For j = 1 To dy_rec.Fields.Count
            Printer.CurrentY = 1000
            Printer.Print Trim(fiel_name(j - 1)) '打印表头
            dx = dx + fiel_long(j - 1) * pot_pot
            Printer.CurrentX = dx
    Next
    Printer.Line (x_first, 1300)-(x_first + m_long * pot_pot, 1300) 'PRINT ------------
    Printer.FontBold = False
                
    dy = y_first
    For k = 1 To n
            dx = x_first
            For j = 1 To dy_rec.Fields.Count
                    Printer.CurrentX = dx
                    Printer.CurrentY = dy
                    If Len(Trim(dy_rec.Fields(j - 1))) <> 0 Then
                        Printer.Print LeftB$(CStr(dy_rec.Fields(j - 1)) + Space(fiel_long(j - 1)), 2 * fiel_long(j - 1))
                    Else
                        Printer.Print " "
                    End If
                    dx = dx + fiel_long(j - 1) * pot_pot
            Next
            dy = dy + line_high
            Printer.CurrentY = dy
            dy_rec.MoveNext
    Next
    Printer.Line (x_first, 13300)-(x_first + m_long * pot_pot, 13300)
    Printer.CurrentX = x_first
    Printer.CurrentY = 13500
    Printer.Print "第"; m + 1; "  页,共"; m + 1; " 页        打印时间:"; Date; "    制表人:"; SYS_NAME
    
    Printer.EndDoc
End Function


'**************************************************************************************************
'*  功    能 : 从串中将客人,团陪,地陪房类数/房价转存到对应的数组中
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.25
'*  修改日期 : 1999.03.25
'*  参数说明 : t_hj     -- 存放各种房类数的数组(返回值)
'*             t_stfls  -- 存放各种房类数的字符串
'*             t_ws     -- 字符串分割的位数
'*             t_code   -- 功能代码
'*  返 回 值 : t_hj
'**************************************************************************************************
Public Sub PUB_FJFL(t_hj As Variant, t_stfls As String, t_ws As Integer, t_code As String)
    Dim i As Integer
    Dim temp_s As Integer
    Dim t_fj As String
    
    ReDim t_hj(SYS_LXN + 1)
    
    temp_s = 1
    For i = 1 To SYS_LXN
        t_fj = Mid(t_stfls, temp_s, t_ws)
        t_hj(i) = CInt(t_fj)
        temp_s = temp_s + t_ws
    Next

End Sub

'**************************************************************************************************
'*  功    能 : 将客人,团陪,地陪房类数/房价转存到对应串中
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.25
'*  修改日期 : 1999.03.25
'*  参数说明 : t_hj     -- 存放各种房类数的数组
'*             t_ws     -- 字符串分割的位数
'*             t_code -- 功能代码
'*  返 回 值 : pub_join
'**************************************************************************************************
Public Function PUB_JOIN(t_hj As Variant, t_ws As Integer, t_code As String)
    Dim i As Integer
    
    PUB_JOIN = ""
    For i = 1 To SYS_LXN
        PUB_JOIN = PUB_JOIN + Trim(Right("0000000000" & Trim(Str(t_hj(i))), t_ws))
    Next
    PUB_JOIN = PUB_JOIN & String(t_ws * 2, "0")
End Function

Public Function Pub_lock(t_km As String, t_table As String, t_rec As Recordset) As String
'/ pub_lock=0 没锁住 1 锁住 2 记录不存在
Dim LOCK_REC As Recordset
Dim t As HOTEL_TOOLS
If Not t_rec.BOF Then
   t_rec.MoveLast
End If
t_rec.Requery
If Not t_rec.BOF Then
   t_rec.MoveLast
   t_rec.MoveFirst
      If IsNull(t_rec!LOCK_NO) Then
            t_rec.Edit
                  t_rec!LOCK_NO = CDec(SYS_USER)
            t_rec.Update
            Pub_lock = "1"
      Else
            If t_rec!LOCK_NO = 0 Then
                  t_rec.Edit
                        t_rec!LOCK_NO = CDec(SYS_USER)
                  t_rec.Update
                  Pub_lock = "1"
            Else
                  If t_rec!LOCK_NO = CDec(SYS_USER) Then
                     Pub_lock = "1"
                  Else
                     Pub_lock = "0"
                  End If
            End If
      End If
Else
   Pub_lock = "2"
   Exit Function
End If
Set LOCK_REC = PUB_data.OpenRecordset("select * from SYS_LOCK WHERE TRIM(TABLENAME)='" & Trim(t_table) & "'", 2, 0, 2)
If Not LOCK_REC.BOF Then
   LOCK_REC.MoveLast
   If LOCK_REC!CZY = "***" Or LOCK_REC!CZY = SYS_USER Or LOCK_REC!CZY = "!!!" Then
      If LOCK_REC!CZY = "***" Then
            LOCK_REC.Edit
               LOCK_REC!CZY = "!!!"
            LOCK_REC.Update
      End If
   Else
      Set t = New HOTEL_TOOLS
      Call t.pub_msg(t_table & "正被其他人独占打开，请稍后")
      t_rec.Edit
          t_rec!LOCK_NO = 0
      t_rec.Update
      Pub_lock = "0"
   End If
End If
If Pub_lock = "1" Then
    Dim LOCK_ERR As Recordset
    Dim m_xh As Integer
    m_xh = 0
    Set LOCK_ERR = PUB_data.OpenRecordset("select * from LOCK_ERR WHERE TRIM(TABLENAME)='" & Trim(t_table) & "' AND TRIM(CZY)='" & SYS_USER & "' ORDER BY XH", 2, 0, 2)
    If Not LOCK_ERR.BOF Then
        LOCK_ERR.MoveLast
        LOCK_ERR.Edit
    Else
       
        LOCK_ERR.AddNew
        LOCK_ERR!XH = 1
    End If
        LOCK_ERR!TABLENAME = t_table
        LOCK_ERR!km = t_km
        LOCK_ERR!CZY = SYS_USER
    LOCK_ERR.Update
Else
   If Pub_lock = "0" Then
      Call t.pub_msg(t_table & "正被其他人使用，请稍后")
   Else
      Call t.pub_msg(t_table & "记录被删除")
   End If
End If
End Function
Public Sub Pub_UNlock(t_table As String, t_rec As Recordset)
t_rec.Requery
If Not t_rec.BOF Then
    t_rec.MoveLast
    t_rec.Edit
          t_rec!LOCK_NO = 0
    t_rec.Update
End If
Dim LOCK_ERR As Recordset, LOCK_REC As Recordset
Dim m_xh As Integer
Set LOCK_ERR = PUB_data.OpenRecordset("select * from LOCK_ERR WHERE TRIM(TABLENAME)='" & Trim(t_table) & "' AND TRIM(CZY)='" & SYS_USER & "' ORDER BY XH", 2, 0, 2)
If Not LOCK_ERR.BOF Then
   LOCK_ERR.MoveLast
   LOCK_ERR.Delete
End If
Set LOCK_ERR = PUB_data.OpenRecordset("select * from LOCK_ERR WHERE TRIM(TABLENAME)='" & Trim(t_table) & "' ORDER BY XH", 2, 0, 2)
If Not LOCK_ERR.BOF Then
   LOCK_ERR.MoveLast
Else
   Set LOCK_REC = PUB_data.OpenRecordset("select * from SYS_LOCK WHERE TRIM(TABLENAME)='" & Trim(t_table) & "'", 2, 0, 2)
   If Not LOCK_REC.BOF Then
      LOCK_REC.MoveLast
      If LOCK_REC!CZY = "!!!" Then
           LOCK_REC.Edit
              LOCK_REC!CZY = "***"
           LOCK_REC.Update
      End If
   End If
End If
End Sub

Public Sub Open_lock(t_czy As String)
Dim LOCK_REC As Recordset, LOCK_REC1 As Recordset
Dim T_DATA As Database
Set LOCK_REC = PUB_data.OpenRecordset("select * from SYS_LOCK WHERE TRIM(czy)='" & Trim(t_czy) & "'", 2, 0, 2)
If Not LOCK_REC.BOF Then
   LOCK_REC.MoveLast
   LOCK_REC.MoveFirst
   Do While Not LOCK_REC.EOF
           LOCK_REC.Edit
               LOCK_REC!CZY = "***"
           LOCK_REC.Update
           LOCK_REC.MoveNext
    Loop
End If
Set LOCK_REC = PUB_data.OpenRecordset("select * from LOCK_ERR WHERE TRIM(CZY)='" & t_czy & "' ORDER BY XH", 2, 0, 2)
If Not LOCK_REC.BOF Then
   LOCK_REC.MoveLast
   LOCK_REC.MoveFirst
   Do While Not LOCK_REC.EOF
        Set T_DATA = WRK.OpenDatabase(Trim(LOCK_REC!km), dbDriverNoPrompt, False, "odbc;UID=" & SYS_UID & ";pwd=" & SYS_PWD)
        T_DATA.Execute "UPDATE " & Trim(LOCK_REC!TABLENAME) & " SET LOCK_NO=0 WHERE LOCK_NO=" & t_czy
        Set LOCK_REC1 = PUB_data.OpenRecordset("select * from SYS_LOCK WHERE TRIM(TABLENAME)='" & Trim(LOCK_REC!TABLENAME) & "'", 2, 0, 2)
        If Not LOCK_REC1.BOF Then
           LOCK_REC1.MoveLast
           If LOCK_REC1!CZY = "!!!" Then
                LOCK_REC1.Edit
                   LOCK_REC1!CZY = "***"
                LOCK_REC1.Update
           End If
        End If
        LOCK_REC.MoveNext
   Loop
End If

End Sub

Public Function Pub_error(pro_name As String, err_no As Integer) As String
Dim LOCK_REC As Recordset, m_xh As Integer
Set LOCK_REC = PUB_data.OpenRecordset("select * from SYSERROR ORDER BY XH", 2, 0, 2)
m_xh = 0
If Not LOCK_REC.BOF Then
   LOCK_REC.MoveLast
   m_xh = LOCK_REC!XH + 1
End If
LOCK_REC.AddNew
  LOCK_REC!XH = m_xh
  LOCK_REC!pro_name = pro_name
  LOCK_REC!err_no = err_no
  LOCK_REC!CZY = SYS_USER
  LOCK_REC!FSRQ = Date
  LOCK_REC!SJ = Time
LOCK_REC.Update
Call Open_lock(SYS_USER)
Pub_error = "1"
End Function


'****************************************************************
'* 功    能 : 客房管制:PUB_KFGZ
'* 参数说明 : fh     :房号
'*            gz_ft  :1---管制   0--- 解除管制
'* 数据库   : kf_ftk(public)
'*          : 成功，返回 TRUE
'****************************************************************
Public Function pub_kfgz(fh As String, gz_ft As String) As Boolean
Dim t_rec As Recordset
pub_kfgz = False
Set t_rec = PUB_data.OpenRecordset("select kf_gz,kf_zr,kf_nb,kf_wx from KF_FTK where kf_fh='" & fh & "'", 2, 0, 2)
If Not t_rec.BOF Then
    t_rec.MoveLast
    If gz_ft = "0" Then
        t_rec.Edit
        t_rec!KF_GZ = "0"
        t_rec.Update
        pub_kfgz = True
    End If
    If gz_ft = "1" Then
        If Not (t_rec!KF_ZR = "1" Or t_rec!KF_WX = "1" Or t_rec!KF_NB = "1") Then '不住人,不维修,不是内部用房
            t_rec.Edit
            t_rec!KF_GZ = "1"
            t_rec.Update
        pub_kfgz = True
        End If
    End If
End If
t_rec.Close
End Function