Attribute VB_Name = "Start_Module"
Public strConnection As String
Public cnnConnection As ADODB.Connection
Public rstCustomers As Recordset
Public blnLoginFlag As Boolean  '登錄標志
Public UserID As String '用戶名
Public strQry As String
Public objfrmCalendar() As frmCalendar
Public IndexfrmCalendar As Integer
Public SelectedDate As Date
Public NowTime As Date

Public prevWndProc As Long
Public Const SYSTEMCAPTION = "GoldSeal 小秘書 1.0"
Public Const CBN_SELENDCANCEL = 10
Public Const CBN_SELENDOK = 9
Public Const WM_COMMAND = &H111
Public Const GWL_WNDPROC = (-4)

Public Const CB_SHOWDROPDOWN = &H14F

Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

'啟動過程
Sub Main()

    Dim strAppPath As String
    
    On Error GoTo VBError
    
    '保證路徑字符串尾有斜扛號
    strAppPath = App.Path
    If Right(strAppPath, 1) <> "\" Then
        strAppPath = strAppPath & "\"
    End If
    
    strAppPath = strAppPath & "RCGL_DATA.mdb"
    strConnection = "DRIVER=Microsoft Access Driver (*.mdb);DBQ=" & strAppPath & ";"
    
    '打開連接
    Set cnnConnection = New Connection
    Set rstCustomers = New Recordset
    
    With cnnConnection
        .ConnectionString = strConnection
        .CursorLocation = adUseClient
        .CommandTimeout = 30
        .Open
    End With
    
    
    frmSplash.Show
    Exit Sub
VBError:
    DisplayVBError
    
End Sub

'獲取指定的記錄集
Public Function GetRecordSet(cnnConnection As ADODB.Connection, sQry As String) As ADODB.Recordset
    
    Dim fun_rstCustomers As ADODB.Recordset
    
    Set fun_rstCustomers = New Recordset
    '下面的記錄鎖類型，因為CursorLocation設為adUseClient
    '實際當打開記錄集時，記錄鎖類型已設為adOpenStatic
    fun_rstCustomers.CursorType = adOpenDynamic
    fun_rstCustomers.LockType = adLockOptimistic
    '設置記錄集的數據來源為一個SQL串
    fun_rstCustomers.Source = sQry
    '設置記錄集的連接字符串
    Set fun_rstCustomers.ActiveConnection = cnnConnection
    fun_rstCustomers.Open
    
    Set GetRecordSet = fun_rstCustomers

End Function

Public Sub DisplayADOErrors(cnnConnection As ADODB.Connection)
 
    Dim errLoop As ADODB.Error
    Dim strHelp As String
    
    For Each errLoop In cnnConnection.Errors
        If errLoop.HelpFile = "" Then
            strHelp = "沒有幫助信息可用"
        Else
            strHelp = "幫助文件： " & errLoop.HelpFile & "； 幫助內容： " & errLoop.HelpContext
        End If
        MsgBox "ADO 錯誤 #" & errLoop.Number & vbCrLf & "錯誤源： " & errLoop.Source & vbCrLf & "SQL 狀態： " & errLoop.SQLState & "；本地錯誤： " & errLoop.NativeError & vbCrLf & vbCrLf & "錯誤目標： " & errLoop.Description & vbCrLf & vbCrLf & strHelp, vbCritical, "ADO 錯誤"
    Next
    
End Sub

Public Sub DisplayVBError()

    If CBool(Err) Then
        MsgBox "VB 錯誤 #" & Err.Number & vbCrLf & "錯誤源： " & Err.Source & vbCrLf & vbCrLf & "Description: " & Err.Description, vbCritical, "VB 運行時錯誤"
        Err.Clear
    End If
    
End Sub

Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If Msg = WM_COMMAND Then
        Select Case wParam \ 65536
            Case CBN_CLOSEUP
            Case CBN_SELENDOK
                If lParam = objfrmCalendar(IndexfrmCalendar).cboStartTime.hWnd Then
                    SendMessage objfrmCalendar(IndexfrmCalendar).cboEndTime.hWnd, CB_SHOWDROPDOWN, True, ByVal 0&
                End If
            Case CBN_SELENDCANCEL
        End Select
    End If
    
    WndProc1 = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End Function