pub_memo.bas

该系统为酒店日常管理提供了很大的方便

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, CT_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"  '&&& 解除预订
   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
   t_m = Pub_wx_nb(t_rec, "WX", new_lx)
   Pub_kftj = t_m
'
Case "C1500"  '&&& 办公房建立+1/解除-1
   t_m = Pub_wx_nb(t_rec, "NB", new_lx)
   Pub_kftj = t_m
'
Case "B0400", "B0410" '&&& 不同类型换房 &  长包房换房"
   If kftj_cbf = LoadResString(SYS_CBLX) Then
      kf_cb = True
   Else
      kf_cb = False