Attribute VB_Name = "kqMod"
Public gDataBase As Database
Public gTitle As String
Public gMaxDay  As Integer
Public Const gMAXITEM = 999
Public Const gLATETIME = "07:55"
Public Const gSTRPWD = "wsh2000"

Public gMainDbName As String

Public gLoginGrade As Integer
Public gLoginName As String

Public gPlanTableName As String
Public Const gQRY = "Qry"
Public gPlanQryName As String
Public Const gRELEMPLOYEEPLAN = "EmployeePlan"
Public Const gRELSHIFTPLAN = "ShiftPlan"
Public gRelEmp As String
Public gRelShift As String

Public gOwnName As String
Public gOwnAddress As String
Public gOwnPhone As String
Public gOwnFax As String
Public gOwnPost As String
Public gOwnOwner As String

Public Const GSHIFTRESTID = 1 '休息
Public Const GSHIFTLEAVEID = 2 '請(qǐng)假
Public Const GSHIFTEVECTIONID = 3 '出差
Public Const GSHIFTMONEYID = 4 '有薪假期
Public Const GSHIFTRESTSTR = "休息"
Public Const GSHIFTLEAVESTR = "請(qǐng)假"
Public Const GSHIFTEVECTIONSTR = "出差"
Public Const GSHIFTMONEYSTR = "有薪假期"
Public Const GSHIFTRESTNAME = "*" '休息
Public Const GSHIFTLEAVENAME = "#" '請(qǐng)假
Public Const GSHIFTEVECTIONNAME = "@" '出差
Public Const GSHIFTMONEYNAME = "$" '有薪假期
Public Const gNOSHIFT = 0
Public Const gNOSHIFTNAME = "未排班"
Public Const gNOTINWORK = "曠工"
Public Const gWORKLATE = "遲到"
Public Const gNORMALKQSTR = "正常出勤"

Public Const gALLDEPTNAME = "所有部門(mén)"

Type OwnerShift
    ID As Integer
    ShiftName As String
    Note As String
End Type

Public aInnerShift(1 To 4) As OwnerShift


Type KQTemp
    WorkNo As String
    KqDate As String
    KqTime As String
End Type

'----card status
Public Const gNoCard = 0
Public Const gHasCard = 1
Public Const gMissCard = 2

Public gPosNumber  As Integer
Public gCommPort As Integer

Public Type ItemStruc
    ID As Integer
    Name As String
End Type

Public Const mstrOpenCommErr = "無(wú)法打開(kāi)串口!"

Global aDepartment() As ItemStruc
Global aTitle() As ItemStruc
Global aLeaveType() As ItemStruc

'*****編輯按鈕索引
Public Const gCMDAPPEND = 0
Public Const gCMDSAVE = 1
Public Const gCMDEDIT = 2
Public Const gCMDDELETE = 3
Public Const gCMDQUERY = 4
Public Const gCMDRETURN = 5
'Private Const mRefresh = 6
Public Const gCMDEDITNORMAL = 7 '正常的cmdEdit的狀態(tài)
Public Const gCMDEDITCANCEL = 8 '取消添加后刷新按鈕
'*****編輯按鈕動(dòng)態(tài)更新字串
Public Const gSTRAPPEND = "添加"
Public Const gSTRCANCEL = "取消"
Public Const gSTRMODIFY = "修改"
Public Const gSTRRESET = "還原"

Global gUserID As String
Const mMsg1 = "班次初始化有誤,系統(tǒng)不能正常運(yùn)行!"

'區(qū)分從frmMDI進(jìn)入frmMain常數(shù)
Public Const gMAINCOLLECT = 0
Public Const gMAINLEAVE = 1
Public Const gMAINABSENT = 2

Const modMsg2 = "新的月份已開(kāi)始,本月是否沿用上月的排班表?"
Const modMsg3 = "歡迎您進(jìn)入新月份的排班!"
Public Const gMsg3 = "該名稱已經(jīng)存在,請(qǐng)您換個(gè)名稱!!"
Public Const gMsg4 = "請(qǐng)選擇要?jiǎng)h除的記錄!!"
Public Const gMsg5 = "抱歉,保存未成功!"
Public Const gMsg6 = "抱歉,刪除未成功!"
Public Const gMsg7 = "抱歉,添加未成功!"
Public Const gMsg8 = "數(shù)據(jù)有改動(dòng),要保存嗎?"
Public Const gMsg9 = "恭喜,保存成功!!"
Public Const gMsg10 = "您確定要?jiǎng)h除該條記錄嗎?"
Public Const gMsg11 = "請(qǐng)準(zhǔn)備好打印機(jī),按[確定]開(kāi)始打印..."
Public Const gMsg12 = "抱歉,打印未成功!"

Public Function CreateATable(TableName As String) As Boolean
    Dim Sql As String
    Dim strPrevTableName As String
    Dim strPrevMonth As String
    Dim strPrevYear As String
    Dim blnCreateNew As Boolean
    Dim HasThisTD As Boolean
    
    On Error GoTo CreateErr
    HasThisTD = False
    strPrevYear = Year(Date)
    strPrevMonth = Month(Date) - 1
    If Val(strPrevMonth) = 0 Then
        strPrevYear = Val(strPrevYear) - 1
        strPrevMonth = 12
    End If
    strPrevTableName = Right(strPrevYear, 2) & strPrevMonth
    
    HasThisTD = HasThisTable(strPrevTableName)
    blnCreateNew = True
    If HasThisTD Then
'        If MsgBox(modMsg2, vbQuestion + vbYesNo, gTitle) = vbYes Then '是否沿用
'            Sql = "select * into " & TableName & " from " & strPrevTableName
'            gDataBase.Execute Sql
'            Sql = "delete * from " & TableName
'            gDataBase.Execute Sql
'            blnCreateNew = False
'        Else
            MsgBox modMsg3, vbInformation, gTitle
'        End If
    End If
    If blnCreateNew Then
        Sql = "select * into " & TableName & " from EmptyPlan"
        gDataBase.Execute Sql
    End If
    
    '創(chuàng)建關(guān)系
    Dim Rel As Relation
    Dim RelName As String
    Dim HasRel As Boolean
    
    RelName = gRelShift
    HasRel = HasThisRelation(RelName)
    
    If Not HasRel Then 'create relation
        Set Rel = gDataBase.CreateRelation(RelName)
        With Rel
            .Table = "Shift"
            .ForeignTable = TableName
            .Fields.Append .CreateField("ID")
            .Fields("ID").ForeignName = "F_Shift"
            gDataBase.Relations.Append Rel
        End With
    End If
    
    Set Rel = Nothing
    HasRel = False
    RelName = gRelEmp
    HasRel = HasThisRelation(RelName)
    If Not HasRel Then
        Set Rel = gDataBase.CreateRelation(RelName)
        With Rel
            .Table = "Employee"
            .ForeignTable = TableName
            .Fields.Append .CreateField("WorkNo")
            .Fields("WorkNo").ForeignName = "WorkNo"
            gDataBase.Relations.Append Rel
        End With
    End If
    Set Rel = Nothing
    
'    Dim QD As QueryDef
    Dim QDName As String
    Dim HasThisQry As Boolean
    QDName = gPlanQryName
    HasThisQry = HasThisQuery(QDName)
    If Not HasThisQry Then
        Set QD = New QueryDef 'PARAMETERS DeptID Short;
        QD.Sql = "select a.Name,a.DeptID," _
            & "b.WorkNo," _
            & "b.F_Day,c.ShiftName,c.ID" _
            & " from Employee a," _
            & TableName & " b,Shift c" _
            & " where a.WorkNo=b.WorkNo " _
            & "and b.F_Shift=c.ID and a.F_DelFlag=" & gFALSE _
            & " order by b.WorkNo"
        QD.Name = QDName
        gDataBase.QueryDefs.Append QD
    End If
    QD.Close
    Set QD = Nothing
    CreateATable = True
    Exit Function
CreateErr:
    Err.Clear
    CreateATable = False
    Exit Function
End Function

Public Function HasThisQuery(QryName As String) As Boolean
    Dim QD As QueryDef
    For Each QD In gDataBase.QueryDefs
        If QD.Name = QryName Then
            HasThisQuery = True
            Exit Function
        End If
    Next
    HasThisQuery = False
End Function

Public Function HasThisRelation(RelName As String) As Boolean
    Dim Rel As Relation
    For Each Rel In gDataBase.Relations
        If Rel.Name = RelName Then
            HasThisRelation = True
            Exit Function
        End If
    Next
    HasThisRelation = False
End Function


Function AsciiToVal(nAscii As Byte)
  Select Case UCase(nAscii)
  Case 48 To 57: AsciiToVal = nAscii - 48
  Case 65 To 70: AsciiToVal = nAscii - 55
  Case 97 To 102: AsciiToVal = nAscii - 87
 End Select
End Function

Public Sub Main()
    If App.PrevInstance Then Exit Sub
    Dim Str As String
    ChDrive Mid(App.Path, 1, 2)
    ChDir App.Path
    
    GetRegister
    gTitle = "考勤系統(tǒng)"
    gMaxDay = GetMaxDayInAMonth(Year(Date), Month(Date))
    gUserID = "Wsh"
    Str = App.Path + "\data\kq.mdb"
    gMainDbName = Str
    On Error GoTo OpenErr
    If Dir(Str) <> Empty Then
        Set gDataBase = Workspaces(0).OpenDatabase(Str, False, False, ";pwd=" & gSTRPWD)
    Else
        MsgBox "找不到數(shù)據(jù)庫(kù)!請(qǐng)您檢查一下您的數(shù)據(jù)庫(kù)路徑!!", , gTitle
        End
    End If
    
    SetPlanTableName
    
    IniPort
    IniItem "Department", aDepartment()
    IniItem "LeaveType", aLeaveType()
    IniItem "Title", aTitle()
    IniShift
    
    aDepartment(0).Name = gALLDEPTNAME
    aLeaveType(0).Name = "所有請(qǐng)假類型"
    aTitle(0).Name = "所有職務(wù)"
    
    frmSplash.Show
    'frmMonth.Show
    'frmLookMan.Show 1
    'frmEmploy.Show 1
    'frmPlan.Show
    
    Exit Sub
OpenErr:
    MsgBox Err.Description, , gTitle
    Err.Clear
    EndSystem
End Sub

Private Sub IniPort()
    gPosNumber = 1
    gCommPort = 0
End Sub
Public Sub SetPlanTableName()
    gPlanTableName = Right(Year(Date), 2) & Month(Date)
    gPlanQryName = gQRY & gPlanTableName
    gRelEmp = Trim(gPlanTableName) & gRELEMPLOYEEPLAN
    gRelShift = Trim(gPlanTableName) & gRELSHIFTPLAN
End Sub
Private Sub IniShift()
    With aInnerShift(1)
        .ID = GSHIFTRESTID
        .ShiftName = GSHIFTRESTNAME
        .Note = GSHIFTRESTSTR
    End With
    
    With aInnerShift(2)
        .ID = GSHIFTLEAVEID
        .ShiftName = GSHIFTLEAVENAME
        .Note = GSHIFTLEAVESTR
    End With
    
    With aInnerShift(3)
        .ID = GSHIFTEVECTIONID
        .ShiftName = GSHIFTEVECTIONNAME
        .Note = GSHIFTEVECTIONSTR
    End With