module1.bas

vb酒店管理系统的原码下载

Attribute VB_Name = "Module1"
'星级酒店管理系统最初功能演示版,提供所有星级酒店管理中的客房管理,
'房态管理,客史管理,客人资料管理,帐务管理,报表管理,餐饮收费管理
'菜谱管理,夜审处理,数据库备份等功能.所有功能皆可以运行,(但有一些BUG未处理)
'此代码完全可以完成星级酒店上述管理功能.(提供者:帅)
'--------------------------------------------------------------
'代码编写于:2001.12  系统分析:帅   代码编写:帅    版权所有:帅
'--------------------------------------------------------------
'本份代码仅提供给程序太平洋的所有朋友学习,研究之用.
'其它网站一律不得转载,否则为侵权行为,本人保留法律追诉权力.
'这也是本人最早的VB版程序,代码质量不好.望笑纳.:)
'--------------------------------------------------------------
'提供日期:2003-05-31    提供者:帅
'--------------------------------------------------------------
'系统提从与ACCESS或SQL相接,在登录时,选择全局数据库,就与SQL数据库
'连接,字符串存放在SERVER.DAT文本文件中;选择本地数据库,与本地ACCESS
'数据库相连,连接字符串存放在LOCAT.DAT文件中.(当前存放为e:\hotel2\room.mdb)
'---------------------------------------------------------------
'将ACCESS中所有表导入SQL中,并将有的表中的ID字段改为自动编码,就可以使用.
'---------------------------------------------------------------------
'
'
Public DWMC As String
Public PianQu As String
Public TongZhi As String
Public SoftVerSion As String

Public BKPicPath As String
Public USER_ID As String
Public PIC_load As Boolean
Public RoomForm_Type As String
Public RoomNO As String
Public Room_Rate As Currency
Public Room_Statu As String
Public Room_Type As String
Public Room_SaleType As String
Public Room_Update As Boolean
Public Room_Share_Type As String
Public Room_Use_Type As String
Public Half_time As String
Public Half_times As String
Public Table_Name As String
Public Table_SetType As String
Public Report_Type As String


Public PRN_Name As String
Public PRN_Sex As String
Public PRN_Room As String
Public PRN_EnglishName As String
Public PRN_Date1 As String
Public PRN_Date2 As String
Public PRN_CusType As String
Public PRN_AccountRec As String
Public PRN_Days As String
Public PRN_STR(147) As String
Public PRN_SUM(12) As String


'LOAD_STATU房态图装入是“使用”&“显示”
Public Load_Statu As String
Public FB_table2 As String
Public FB_SumTable As String

Public US_Field As String
Public System_Date As String
Public System_Statu As String



Public Account_ID As String
Public QAccount_ID As String
Public Query_Type As String
Public Query_Type2 As String
Public Registration_Type As String
Public Registration_Type2 As String

Public Paper_W As Single
Public Paper_H As Single
Public BB_title As String
Public DATA_SERVER As String
Public BB_type As String

Public NET_pass As Boolean
Public FP_ZDLX As String

Public CKD As String

Public My_USERID As String
Public My_PASSWORD As String
Public My_DATASOURCE As String
Public My_INITIALCATALOG As String
Public My_PROVIDER As String
Public BK_PROVIDER As String
Public BQ_lb As String

Public TableName(22) As String


Public PASSed1 As Boolean
Public CzyName As String
Public CzyType As String
Public CzyPassWord As String



Public Const FO_MOVE As Long = &H1
Public Const FO_COPY As Long = &H2
Public Const FO_DELETE As Long = &H3
Public Const FO_RENAME As Long = &H4
Public Const FOF_MULTIDESTFILES As Long = &H1
Public Const FOF_CONFIRMMOUSE As Long = &H2
Public Const FOF_SILENT As Long = &H4
Public Const FOF_RENAMEONCOLLISION As Long = &H8
Public Const FOF_NOCONFIRMATION As Long = &H10
Public Const FOF_WANTMAPPINGHANDLE As Long = &H20
Public Const FOF_CREATEPROGRESSDLG As Long = &H0
Public Const FOF_ALLOWUNDO As Long = &H40
Public Const FOF_FILESONLY As Long = &H80
Public Const FOF_SIMPLEPROGRESS As Long = &H100
Public Const FOF_NOCONFIRMMKDIR As Long = &H200

Type SHFILEOPSTRUCT
     hwnd As Long
     wFunc As Long
     pFrom As String
     pTo As String
     fFlags As Long
     fAnyOperationsAborted As Long
     hNameMappings As Long
     lpszProgressTitle As String
End Type

Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long



Public Function sysquit()
    If Not PASSed1 Then
        
        End
        
    End If

End Function

Public Function Cmoney(jiner0 As Currency)
 Dim mone0 As String
 Dim mone1 As String
 Dim ii As Integer
 Dim monelen1 As Integer
 Dim rmb As String
 Dim cmone0 As String
 Dim numb0 As String
 
 mone0 = Format(jiner0, "00000.00")
 ii = 1
 mone1 = Mid(mone0, 1, 5) + Mid(mone0, 7, 2)
 mone1 = Trim(mone1)
 monelen1 = Len(mone1)
 Select Case monelen1
      Case 1
           rmb = "分"
      Case 2
           rmb = "角分"
      Case 3
           rmb = "元角分"
      Case 4
           rmb = "拾元角分"
      Case 5
           rmb = "佰拾元角分"
      Case 6
           rmb = "仟佰拾元角分"
      Case 7
           rmb = "万仟佰拾元角分"
 End Select
 cmone0 = ""
 While ii < Len(mone1) + 1
      numb0 = Mid(mone1, ii, 1)
      Select Case numb0
           Case " "
                cmone0 = cmone0 & "零"
           Case "0"
                cmone0 = cmone0 & "零"
           Case "1"
                cmone0 = cmone0 & "壹"
           Case "2"
                cmone0 = cmone0 & "贰"
           Case "3"
                cmone0 = cmone0 & "叁"
           Case "4"
                cmone0 = cmone0 & "肆"
           Case "5"
                cmone0 = cmone0 & "伍"
           Case "6"
                cmone0 = cmone0 & "陆"
           Case "7"
                cmone0 = cmone0 & "柒"
           Case "8"
                cmone0 = cmone0 & "捌"
           Case "9"
                cmone0 = cmone0 & "玖"
      End Select
      cmone0 = cmone0 & Mid(rmb, (ii - 1) * 1 + 1, 1)
      ii = ii + 1
 Wend
 Cmoney = cmone0

End Function


Public Function int_Month(month1, month2) As Integer
    Dim I_year, I_month As Integer
    I_year = CInt(Left(month2, 4)) - CInt(Left(month1, 4))
    I_month = CInt(Right(month2, 2)) - CInt(Right(month1, 2))
    int_Month = I_year * 12 + I_month
End Function
Public Function Js_Month(month1, JS_para As Integer) As String
    Dim I_year, I_month As Long
    
    I_year = CInt(Left(month1, 4))
    I_month = CInt(Right(month1, 2))
    
    If (I_year * 12 + I_month + JS_para) Mod 12 = 0 Then
        Js_Month = CStr(Int((I_year * 12 + I_month + JS_para) / 12) - 1) & ".12"
    Else
        Js_Month = CStr(Int((I_year * 12 + I_month + JS_para) / 12)) & "." & Format((I_year * 12 + I_month + JS_para) Mod 12, "00")
    End If
End Function

Public Sub XG_weidl()
        F_addr.Locked = True
        f_addrno.Locked = True
        f_code.Locked = True
        f_nodeno.Locked = True
        F_tel.Locked = True
        f_grou.Locked = True
End Sub
Sub SetGridColor(GRID As Control, row_col As Boolean, color1 As Long, color2 As Long)
Dim i As Integer
Dim j As Integer
Dim K As Long
 
 GRID.Redraw = False
 
 GRID.BackColorBkg = &H808080
 GRID.BackColorFixed = &HC0C0C0
 

If row_col Then
 For j = GRID.FixedRows To GRID.Rows - 1
     If K = color2 Then
        'K = &HD0FFE0
        K = color1
     Else
        K = color2
     End If
 
    For i = GRID.FixedCols To GRID.Cols - 1
      GRID.Row = j: GRID.Col = i
      GRID.CellBackColor = K
      GRID.CellForeColor = &H80000008
    Next
Next

GRID.Row = 0
For i = 0 To GRID.Cols - 1
 GRID.Col = i
 GRID.CellAlignment = 4
Next
GRID.Redraw = True
Else
'*****
 For j = GRID.FixedCols To GRID.Cols - 1
     If K = color2 Then
'        K = &HD0FFE0
        K = color1
        
     Else
        K = color2
     End If
 
    For i = GRID.FixedRows To GRID.Rows - 1
      GRID.Col = j: GRID.Row = i
      GRID.CellBackColor = K
      GRID.CellForeColor = &H80000008
    Next
Next

GRID.Col = 0
For i = 0 To GRID.Rows - 1
 GRID.Row = i
 GRID.CellAlignment = 4
Next
GRID.Redraw = True
End If
End Sub



'星级酒店管理系统最初功能演示版,提供所有星级酒店管理中的客房管理,
'房态管理,客史管理,客人资料管理,帐务管理,报表管理,餐饮收费管理
'菜谱管理,夜审处理,数据库备份等功能.所有功能皆可以运行,(但有一些BUG未处理)
'此代码完全可以完成星级酒店上述管理功能.(提供者:帅)
'--------------------------------------------------------------
'代码编写于:2001.12  系统分析:帅   代码编写:帅    版权所有:帅
'--------------------------------------------------------------
'本份代码仅提供给程序太平洋的所有朋友学习,研究之用.
'其它网站一律不得转载,否则为侵权行为,本人保留法律追诉权力.
'这也是本人最早的VB版程序,代码质量不好.望笑纳.:)
'--------------------------------------------------------------
'提供日期:2003-05-31    提供者:帅
'--------------------------------------------------------------
'系统提从与ACCESS或SQL相接,在登录时,选择全局数据库,就与SQL数据库
'连接,字符串存放在SERVER.DAT文本文件中;选择本地数据库,与本地ACCESS
'数据库相连,连接字符串存放在LOCAT.DAT文件中.(当前存放为e:\hotel2\room.mdb)
'---------------------------------------------------------------
'将ACCESS中所有表导入SQL中,并将有的表中的ID字段改为自动编码,就可以使用.
'---------------------------------------------------------------------
'
'