⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 module1.bas

📁 酒店管理系统实现了员工管理
💻 BAS
字号:
Attribute VB_Name = "Module1"

'
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



⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -