pub_memo.bas

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

Attribute VB_Name = "pub_memo"
Option Explicit

'系统常量

'HOTEL.RES中定义的系统常量
Public Const SYS_YH = 18
Public Const SYS_GW_ZW = 2
Public Const SYS_GW_KFG = 3
Public Const SYS_START = 4
Public Const SYS_TDQZ = 6
Public Const SYS_SKQZ = 7
Public Const SYS_CBQZ = 8
Public Const SYS_SKLX = 9
Public Const SYS_SKMC = 10
Public Const SYS_TDLX = 11
Public Const SYS_TDMC = 12
Public Const SYS_CBLX = 13
Public Const SYS_CBMC = 14
Public Const SYS_NBLX = 15
Public Const SYS_NBMC = 16
Public Const SYS_CTXF = 17
Public Const SYS_LOCALBASE = "C:\HDXT\hotel.mdb"
Public Const SYS_UID = "db2user"
Public Const SYS_PWD = "db2user"

'系统全局变量
Global SYS_SK As String, SYS_TD As String, SYS_TZYSK As String, SYS_TSNB As String, SYS_NB As String, SYS_XZJ As String, SYS_LXS As String, SYS_GR As String, SYS_DW As String

Global SYS_HIGH As String
Global SYS_TIME As Integer
Global SYS_ZWMZY As Integer
Global SYS_WLMZY As Integer
Global SYS_BBSJ As String
Global SYS_PWGG As Integer
Global SYS_YHQBZ As Integer
Global SYS_FWF_KF As Single
Global SYS_FWF_CT As Single
Global SYS_FWF_XY As Single
Global SYS_KXFL As Single
Global SYS_SJFL As Single
Global SYS_JGTJJJ As Single
Global SYS_LCS As Integer
Global SYS_LCE As Integer
Global SYS_FHS As Integer
Global SYS_FHE As Integer
Global SYS_LXN As Integer
Global SYS_LXC As Variant
Global SYS_CBYD As Variant
Global SYS_Yl As Variant
Global SYS_TIM As Integer
Global pub_code As String
Global LoginSucceeded As Boolean
Global MY_RUN As String
Global SYS_USER As String, SYS_GWMC As String, SYS_NAME As String, SYS_GWDM As String, SYS_RIGHT As String
Global WRK As Workspace
Global KF_data As Database, PUB_data As Database, JF_data As Database, YX_data As Database, ZW_data As Database, LOCAL_data As Database, CTG_data As Database, XSC_data As Database

Global STY As String, Pass_hello As Boolean


Public Sub Flex_full(t_win1 As MSFlexGrid, t_bt As String, t_rec As Recordset, t_fields As Variant, t_col As Integer, t_func As Variant)
'*******************
't_win1   msflexgrid 名称
't_bt     中文列头
't_rec    要显示的记录集
'
'
'******************
Dim i As Integer
Dim t_row As Integer
Dim ls_var As String
Dim LS_ROW As Integer
LS_ROW = t_win1.Row

t_win1.Visible = False
't_win1.Row = 0
t_win1.Clear
t_win1.SelectionMode = flexSelectionByRow
t_win1.FocusRect = flexFocusNone
t_win1.BackColorSel = &HFFC0C0   ' RGB(250, 250, 200)
t_win1.FillStyle = 1
t_win1.AllowBigSelection = False
t_rec.Requery
If Not t_rec.BOF Then
  t_rec.MoveLast
  t_win1.Rows = t_rec.RecordCount + 1
  t_rec.MoveFirst
Else
  t_win1.Rows = 1
End If
t_win1.Cols = t_col + 1
t_win1.FormatString = t_bt
t_row = 0
Do While Not t_rec.EOF
   t_row = t_row + 1
   For i = 0 To t_col
     If t_func(i) = 0 Then
        If Not IsNull(t_rec.Fields(t_fields(i))) Then
             t_win1.TextArray(t_row * (t_col + 1) + i) = Trim(CStr(t_rec.Fields(t_fields(i))))
        Else
           t_win1.TextArray(t_row * (t_col + 1) + i) = " "
        End If
     Else
        If t_func(i) = 2 Then
           t_win1.TextArray(t_row * (t_col + 1) + i) = Format(Trim(CStr(t_rec.Fields(t_fields(i)))), "#,##0.00")
        Else
           t_win1.TextArray(t_row * (t_col + 1) + i) = Pub_trans(t_rec, t_rec.Fields(t_fields(i)).Name, t_fields(i))
        End If
     End If
   Next
     If t_row Mod 5 = 0 Then
        t_win1.Row = t_row
        t_win1.RowSel = t_row
        t_win1.ColSel = t_col
        t_win1.CellBackColor = &HFAFCEB
     End If
   t_rec.MoveNext
Loop
t_win1.Visible = True
t_win1.Col = 0
If t_win1.Rows > 0 And LS_ROW = 0 Then
    t_win1.Row = 0
Else
    If LS_ROW < t_win1.Rows Then
       t_win1.Row = LS_ROW
    Else
       t_win1.Row = t_win1.Rows - 1
    End If
End If
End Sub

Public Function Pub_trans(t_rec As Recordset, T_NAME As String, T_FIELD As Variant) As String
T_NAME = Trim(T_NAME)
Select Case T_NAME
       Case "KF_LXN", "kf_lxn"
        Pub_trans = SYS_LXC(t_rec.Fields(T_FIELD))
       Case "KF_ZF", "kf_zf"
           If t_rec.Fields(T_FIELD) = "1" Then
              Pub_trans = "脏房"
           Else
              Pub_trans = "非脏房"
           End If
       Case "KF_DS", "kf_ds"
           If t_rec.Fields(T_FIELD) = "1" Then
              Pub_trans = "已打扫房"
           Else
              Pub_trans = "未打扫房"
           End If
      Case "KF_NB", "kf_nb"
          If t_rec.Fields(T_FIELD) = "1" Then
               Pub_trans = "办公用房"
          Else
               Pub_trans = "非办公用房"
          End If
       
       
End Select


End Function


Public Function Pub_czls(T_DATA As Database, czls_mod As String, czls_in As String, t_code As String) As String
Dim t_rec As Recordset
Dim t_count As Integer
If Len(Trim(t_code)) = 0 Then
   t_code = "00000"
End If
Pub_czls = CStr(Date) & SYS_USER
Set t_rec = T_DATA.OpenRecordset("select * from CZ" & year(Date) & "  where czy='" & SYS_USER & "' and cstr(fsrq)='" & CStr(Date) & "'", 2, 0, 2)
If Not t_rec.BOF Then
   t_rec.MoveLast
   t_count = t_rec.RecordCount + 1
End If
Pub_czls = Pub_czls & Right(String(7, "0") & CStr(t_count), 7)
t_rec.AddNew
t_rec!GN_NAME = UCase(czls_mod)
t_rec!IN_SJ = czls_in
t_rec!FSRQ = Date
t_rec!MOD_CODE = t_code
t_rec!CZY = SYS_USER
t_rec!mod_count = Pub_czls
t_rec!OUT_SJ = "*"
t_rec!CZBZ = "*"
t_rec.Update
t_rec.Close
End Function
Public Sub Pub_czle(T_DATA As Database, t_count As String, czls_bz As String, czls_out As String, t_code As String)
Dim t_rec As Recordset
Dim t_date As String
t_date = CDate(Left(t_count, Len(t_count) - 10))
Set t_rec = T_DATA.OpenRecordset("select * from CZ" & year(t_date) & " where czy='" & SYS_USER & "'  and mod_count='" & t_count & "'", 2, 0, 2)
If Not t_rec.BOF Then
   t_rec.MoveLast
   t_rec.Edit
   t_rec!OUT_SJ = czls_out
   t_rec!CZBZ = czls_bz
   t_rec.Update
Else
   Dim t_cou As String
   t_cou = Pub_czls(T_DATA, "error", Time(), "*")
   Call Pub_czle(T_DATA, t_cou, czls_bz, Time(), "*")
End If
t_rec.Close
End Sub

Public Function Pub_getcode(T_DATA As Database, T_NAME As String) As String
Dim t_rec As Recordset
Set t_rec = T_DATA.OpenRecordset("select * from PRO_CODE where gn_name='" & T_NAME & "'", 4)
If Not t_rec.BOF Then
   t_rec.MoveLast
   t_rec.MoveFirst
   Pub_getcode = Trim(t_rec!gn_code)
Else
   Pub_getcode = String(6, "0")
   MsgBox T_NAME & "没有定义"
End If
t_rec.Close

End Function


Public Function Pub_kftj(new_s_day As Date, new_e_ddd As Date, new_lx As Variant, old_s_day As Date, old_e_ddd As Date, old_lx As Variant, kftj_cbf As Integer, pub_code As String) As Boolean
'Dim old_lx, new_lx, SYS_CBYD
'***   NEW_S_DAY:D:8    入住日期
'***   NEW_E_DDD:D:8    离店日期
'***   NEW_LX   :N:     各类型订房数
'***   OLD_S_DAY:D:8    原入住日期
'***   OLD_E_DDD:D:8    原离店日期
'***   OLD_LX   :N      原各类型订房数
'***   PUB_CODE :C:5    功能代码
Dim t_rec As Recordset
Dim i As Integer
Dim new_e_day As Date, old_e_day As Date
'On Error GoTo err1
Dim fy_str As String, yd_str As String, zr_str As String, cb_str As String, wx_str As String, nb_str As String, sy_str As String
Dim FIEL_STR As String
Dim LOCK_REC As Recordset
Dim t As New HOTEL_TOOLS, e As Boolean
e = False
Set LOCK_REC = PUB_data.OpenRecordset("select * from SYS_LOCK", 2, 0, 2)
If Not LOCK_REC.BOF Then
   LOCK_REC.MoveLast
   LOCK_REC.MoveFirst
End If
LOCK_REC.FindFirst "TRIM(TABLENAME)='KF_KFLY'"
Do While LOCK_REC!CZY <> SYS_USER
   If LOCK_REC!CZY = "***" Then
      LOCK_REC.Edit
        LOCK_REC!CZY = SYS_USER
      LOCK_REC.Update
      e = True
   Else
      Call t.pub_msg("客房利用情况表正被其他人使用，请稍后")
      LOCK_REC.Requery
      If Not LOCK_REC.BOF Then
           LOCK_REC.MoveLast
           LOCK_REC.MoveFirst
      End If
      LOCK_REC.FindFirst "TRIM(TABLENAME)='KF_KFLY'"
   End If
Loop
For i = 1 To SYS_LXN
    fy_str = fy_str + "fy_lx" + CStr(i) + ","              ' t_rec.Fields(0*sys_lxn+i-1)
    yd_str = yd_str + "yd_lx" + CStr(i) + ","              ' t_rec.Fields(1*sys_lxn+i-1)
    zr_str = zr_str + "zr_lx" + CStr(i) + ","              ' t_rec.Fields(2*sys_lxn+i-1)
    cb_str = cb_str + "cb_lx" + CStr(i) + ","              ' t_rec.Fields(3*sys_lxn+i-1)
    wx_str = wx_str + "wx_lx" + CStr(i) + ","              ' t_rec.Fields(4*sys_lxn+i-1)
    nb_str = nb_str + "nb_lx" + CStr(i) + ","              ' t_rec.Fields(5*sys_lxn+i-1)
    sy_str = sy_str + "sy_lx" + CStr(i) + ","              ' t_rec.Fields(6*sys_lxn+i-1)
 
Next
FIEL_STR = fy_str + yd_str + zr_str + cb_str + wx_str + nb_str + sy_str + "rq,lock_no"

'On Error GoTo ERR1
Set t_rec = PUB_data.OpenRecordset("select " & FIEL_STR & " from KF_KFLY order by rq", 2, 0, 2)
If Not t_rec.BOF Then
   t_rec.MoveLast
   t_rec.MoveFirst
End If
new_e_day = new_e_ddd
old_e_day = old_e_ddd
If kftj_cbf = LoadResString(SYS_CBLX) Then
   new_e_day = Date
   old_e_day = Date
End If
If t_rec.BOF Then
   MsgBox "系统没有初始化 !"
   t_rec.Close
   Pub_kftj = False
    If e Then
       LOCK_REC.Edit
         LOCK_REC!CZY = "***"
       LOCK_REC.Update
    End If
   
   Exit Function
End If
Call Pub_ordr(new_s_day, new_e_day, pub_code)   '&&& 理顺日期顺序


'*******finish
Dim t_m As Boolean, t_f As Boolean, kf_cb As Boolean, KFTJ_I As Integer
Pub_kftj = True
Select Case pub_code
Case "A0100" ' &&& 建立预订
   t_m = Pub_yd(t_rec, new_s_day, new_e_day, new_lx, "1")
   If t_m And kftj_cbf = LoadResString(SYS_CBLX) Then
      For KFTJ_I = 1 To SYS_LXN
         SYS_CBYD(KFTJ_I) = SYS_CBYD(KFTJ_I) + new_lx(KFTJ_I)
      Next
      Call Sys_save
   End If
   Pub_kftj = t_m
Case "A0300", "A0310" '&&& 解除预订,预订转等待
   t_m = Pub_yd(t_rec, new_s_day, new_e_day, new_lx, "0")
   If t_m And kftj_cbf = LoadResString(SYS_CBLX) Then
      For KFTJ_I = 1 To SYS_LXN
         SYS_CBYD(KFTJ_I) = SYS_CBYD(KFTJ_I) - new_lx(KFTJ_I)
      Next
      Call Sys_save
   End If
   Pub_kftj = t_m

Case "A0200"  '&&& 预订修改
   t_m = Pub_yd(t_rec, old_s_day, old_e_day, old_lx, "0")
   t_f = Pub_free(new_s_day, new_e_day, new_lx, kftj_cbf, pub_code)
   If t_f Then
      t_m = Pub_yd(t_rec, new_s_day, new_e_day, new_lx, "1")
      If t_m And kftj_cbf = LoadResString(SYS_CBLX) Then
         For KFTJ_I = 1 To SYS_LXN
            SYS_CBYD(KFTJ_I) = SYS_CBYD(KFTJ_I) - old_lx(KFTJ_I) + new_lx(KFTJ_I)
         Next
         Call Sys_save
      End If
      Pub_kftj = True
   Else
      Dim t_sykf As New HOTEL_TOOL.HOTEL_TOOLS
      t_sykf.PUB_SYKF PUB_data, new_s_day, new_s_day, new_lx, SYS_LXN, SYS_LXC, SYS_Yl, pub_code
      t_m = Pub_yd(t_rec, old_s_day, old_e_day, old_lx, "1")
      Pub_kftj = False
      
   End If
'
Case "B0110" ' &&& 有预订散客/长包房入住
   If kftj_cbf = LoadResString(SYS_CBLX) Then
      kf_cb = True
   Else
      kf_cb = False
   End If
   t_m = Pub_rz(t_rec, new_s_day, new_e_day, new_lx, old_s_day, old_e_day, old_lx, kf_cb, 1)
   If t_m And kf_cb Then
      For KFTJ_I = 1 To SYS_LXN
         SYS_CBYD(KFTJ_I) = SYS_CBYD(KFTJ_I) - new_lx(KFTJ_I)
      Next
      Call Sys_save
   End If
   Pub_kftj = t_m
Case "B0120"
   If kftj_cbf <> LoadResString(SYS_CBLX) Then   '  &&& 无预订散客入住
      t_m = Pub_rz(t_rec, new_s_day, new_e_day, new_lx, old_s_day, old_e_day, old_lx, False, 0)
   Else
      '&&& 无预订长包房入住
      t_m = Pub_wx_nb(t_rec, "CB", new_lx)
   End If
   Pub_kftj = t_m
Case "B0130"  '&&& 有预订团队入住
   t_m = Pub_rz(t_rec, new_s_day, new_e_day, new_lx, old_s_day, old_e_day, old_lx, False, 1)
   Pub_kftj = t_m
'
Case "B0140"  '&&& 无预订团队入住
   t_m = Pub_rz(t_rec, new_s_day, new_e_day, new_lx, old_s_day, old_e_day, old_lx, False, 0)
   Pub_kftj = t_m
'
Case "C1400"  '&&& 维修房建立+1/解除-1