VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "FLEXGRID.OCX"
Begin VB.Form formReport 
   Caption         =   "Report"
   ClientHeight    =   4380
   ClientLeft      =   885
   ClientTop       =   2100
   ClientWidth     =   9330
   LinkTopic       =   "Form1"
   ScaleHeight     =   4380
   ScaleWidth      =   9330
   Begin MSFlexGridLib.MSFlexGrid gridReport 
      Height          =   3375
      Left            =   120
      TabIndex        =   4
      Top             =   840
      Width           =   7695
      _ExtentX        =   13573
      _ExtentY        =   5953
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   1
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.CommandButton btnSave 
      Caption         =   "&Save"
      Height          =   375
      Left            =   7920
      TabIndex        =   3
      Top             =   1320
      Width           =   1212
   End
   Begin VB.CommandButton btnClose 
      Caption         =   "&Close"
      Height          =   375
      Left            =   7920
      TabIndex        =   1
      Top             =   1800
      Width           =   1212
   End
   Begin VB.CommandButton btnRemind 
      Caption         =   "&Remind"
      Enabled         =   0   'False
      Height          =   375
      Left            =   7920
      TabIndex        =   0
      Top             =   840
      Width           =   1212
   End
   Begin VB.Label lblHeader 
      Alignment       =   2  'Center
      Caption         =   "Time Report for Pay Period Ending 1/1/2095"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   13.5
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   240
      TabIndex        =   2
      Top             =   120
      Width           =   8775
   End
End
Attribute VB_Name = "formReport"
Attribute VB_Base = "0{19C4F559-DF36-11CF-A520-00A0D1003923}"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_TemplateDerived = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim aReport() As Double '3D : days x categories x users
Dim cReceivedReports As Integer 'number of received reports
Dim cReportCategories As Integer 'number of report categories in ReportCategorylist
Dim ReportCategoryList As Variant 'Report categories
Dim ReportPayPeriod As Date     'report payperiod
Dim ReportDate() As Date        'when user sent the report

Public Function CompileReport() As Boolean
'Iterates through all the report messages and extract info
'for the current pay period
On Error GoTo error_olemsg

Dim objReceivFolder As Object
Dim objRepMsg As Object
Dim objmessages As Object

If Not frmCalender.GetDate(ReportPayPeriod) Then
    Exit Function
End If


If objSession Is Nothing Then
    MsgBox "Not logged on"
    CompileReport = False
    Exit Function
End If

'get the receiving folder
GetReceivIPCFolder objReceivFolder
If objReceivFolder Is Nothing Then
    MsgBox "Can't open receive folder"
    CompileReport = False
    Exit Function
End If

'Get message collection from the receiving folder
Set objmessages = objReceivFolder.Messages
If objmessages Is Nothing Then
    MsgBox "Failed to open folder's Messages collection"
    CompileReport = False
    Exit Function
End If
    
'start iterating throuhg the messages
Set objRepMsg = objmessages.getfirst(ReportMsgType)
If objRepMsg Is Nothing Then
    MsgBox "no report msgs found"
    CompileReport = False
    Exit Function
End If


cReceivedReports = 0
Do While Not objRepMsg Is Nothing 'while there are messages
    If Not ProcessMessage(objRepMsg) Then
        CompileReport = False
        Exit Function
    End If
    Set objRepMsg = Nothing
    Set objRepMsg = objmessages.getnext 'next message
Loop


CompileReport = True

Exit Function

error_olemsg:
    MsgBox "Error " & Str(err) & ": " & Error$(err)
    Resume Next

End Function




Function ProcessMessage(objmsg As Object) As Boolean
'If the message is for the right pay period extract and store info

On Error GoTo error_olemsg

Dim tmpPayPeriod As Date
Dim tmpcRepCats As Integer
Dim tmpRepCats As Variant
Dim ind As Integer
Dim PropName As String
Dim var As Variant
Dim day As Integer
Dim userindex As Integer
Dim usrName As String
Dim response As Integer
Dim objFields As Object
Dim msgSentDate As Date
 
'Get msg's fields collection
Set objFields = objmsg.Fields
If objFields Is Nothing Then
    ProcessMessage = True 'ignore this msg
    Exit Function
End If

'get the pay-period
tmpPayPeriod = objFields.Item(PayPeriodPropName)

If tmpPayPeriod <> ReportPayPeriod Then
    ProcessMessage = True   'not intrested in this one
    Exit Function
End If
    
objmsg.Unread = False
objmsg.Update

If cReceivedReports = 0 Then 'first report, has to get the categ. lits
    cReportCategories = objFields.Item(NumCatPropName).Value
    If cReportCategories = 0 Then
        Debug.Print "impossible happend: cReportCats = 0"
        Exit Function
    End If
    ReportCategoryList = objFields.Item(CatPropName).Value
    ReDim aReport(7, cReportCategories, UserList.cUsers)
    ReDim ReportDate(UserList.cUsers)
    
Else 'let's do some validation
    tmpcRepCats = objFields.Item(NumCatPropName).Value
    If tmpcRepCats <> cReportCategories Then
        Debug.Print "number of categories do not match, skipping this message..."
        ProcessMessage = True
        Exit Function
    End If
    tmpRepCats = objFields.Item(CatPropName).Value
    For ind = 0 To tmpcRepCats
        If tmpRepCats(ind) <> ReportCategoryList(ind) Then
            Debug.Print "categories do not match, skipping message..."
            ProcessMessage = True
            Exit Function
        End If
    Next ind
    
End If

usrName = objmsg.sender.Name
'usrName = objFields.Item(NamePropName).Value

userindex = FindUser(usrName)

If E_NOT_FOUND = userindex Then 'the user is not on the list
    response = MsgBox("Received a report from user " & usrName & _
            " who is not on the user list." & Chr(13) & _
            "Would you like to add him/her to the list?", _
            vbYesNo + vbQuestion)
    
    If response = vbYes Then
        'allocate space for the new guy
        ReDim Preserve UserList.aUsers(UserList.cUsers + 1)
        ReDim Preserve aReport(7, cReportCategories, UserList.cUsers + 1)
        ReDim Preserve ReportDate(UserList.cUsers + 1)
        
        'enter him in the list
        UserList.aUsers(UserList.cUsers).DisplayName = usrName
        UserList.aUsers(UserList.cUsers).EntryID = objmsg.sender.id
        UserList.aUsers(UserList.cUsers).ReportIndex = E_NOT_FOUND
        
        'set the index
        userindex = UserList.cUsers
        
        UserList.cUsers = UserList.cUsers + 1
        
    Else
        ProcessMessage = True  'don't care about this one
        Exit Function
    End If
    
End If


'If we are here, everything is cool. Get the data.

'remember when the msg was sent
msgSentDate = objmsg.timesent

If UserList.aUsers(userindex).ReportIndex = E_NOT_FOUND Then
    'if first report from the user
    For ind = 1 To cReportCategories Step 1
        PropName = RepDataPropPrefix & Str(ind)
        var = objFields.Item(PropName)
        For day = 0 To 6 Step 1
            aReport(day, ind - 1, cReceivedReports) = var(day)
        Next day
    Next ind

    UserList.aUsers(userindex).ReportIndex = cReceivedReports
    ReportDate(userindex) = msgSentDate
    cReceivedReports = cReceivedReports + 1
Else
    'if there are more than one report from the same user, user the
    'one that was sent later
    '$
    'make the two loops into one, when sure that they work
    Debug.Print "There is more than one report from " & usrName
    
    If msgSentDate > ReportDate(userindex) Then
        For ind = 1 To cReportCategories Step 1
            PropName = RepDataPropPrefix & Str(ind)
            var = objFields.Item(PropName)
            For day = 0 To 6 Step 1
                aReport(day, ind - 1, UserList.aUsers(userindex).ReportIndex) = var(day)
            Next day
        Next ind
        ReportDate(userindex) = msgSentDate
    End If
    
End If


ProcessMessage = True
Exit Function

error_olemsg:
    MsgBox "Error " & Str(err) & ": " & Error$(err)
    Resume Next

End Function

Function FindUser(strName As String) As Integer
'finds user's positions in the user list given user name
Dim ind As Integer

ind = 0
Do While ind < UserList.cUsers
    If UserList.aUsers(ind).DisplayName = strName Then
        FindUser = ind
        Exit Function
    End If
    ind = ind + 1
Loop

FindUser = E_NOT_FOUND
Exit Function

End Function


Sub ShowGrid()
'uses the extracted data to display the report

Const strNoData As String = "No data"
Const FirstColW As Integer = 2250
Const BorderW As Integer = 30
Dim strDays As Variant
Dim indDays As Integer
Dim indCats As Integer
Dim indUsrs As Integer
Dim indRprt As Integer
Dim sum As Double
Dim total As Double
Dim CellW As Double

strDays = Array("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Total")

gridReport.Cols = 9 'number of elements in strDays+1
gridReport.Rows = UserList.cUsers + 1

'resize columns
CellW = (gridReport.Width - FirstColW - BorderW * gridReport.Cols) _
            / (gridReport.Cols - 1)
gridReport.ColWidth(0) = FirstColW
For indDays = 1 To gridReport.Cols - 1
    gridReport.ColWidth(indDays) = CellW
Next indDays

'display the first row
gridReport.Row = 0
For indDays = 0 To gridReport.Cols - 2
    gridReport.Col = indDays + 1
    gridReport.Text = strDays(indDays)
Next indDays
    
'display the rest of the grid
For indUsrs = 0 To UserList.cUsers - 1 'for all users
    indRprt = UserList.aUsers(indUsrs).ReportIndex
    gridReport.Row = indUsrs + 1
    gridReport.Col = 0
    gridReport.Text = UserList.aUsers(indUsrs).DisplayName
    total = 0
    For indDays = 0 To 6 'for each day
        gridReport.Col = indDays + 1
        If indRprt = E_NOT_FOUND Then
            'no report received from this user
            gridReport.Text = strNoData
            btnRemind.Enabled = True
        Else
            sum = 0 'sum for cats per day
            For indCats = 0 To cReportCategories - 1
                sum = sum + aReport(indDays, indCats, indRprt)
            Next indCats
            gridReport.Text = Str(sum)
            total = total + sum 'total for the week
        End If
    Next indDays
    
    'last column is total
    gridReport.Col = gridReport.Cols - 1
    
    If indRprt <> E_NOT_FOUND Then
        gridReport.Text = Str(total)
    Else
        gridReport.Text = strNoData
    End If
Next indUsrs
    
lblHeader = "Time Report for Pay Period Ending " & ReportPayPeriod

End Sub


Private Sub btnClose_Click()
    Unload Me
    
End Sub


Private Sub btnRemind_Click()
'sends second request message to the users who haven't submitted report

Dim ind As Integer
Dim tmpCats() As String

ReDim tmpCats(cReportCategories)

'put all the cats from variant into a string array
For ind = 0 To cReportCategories - 1
    tmpCats(ind) = ReportCategoryList(ind)
Next ind

formmainsvr.SendRequest cReportCategories, tmpCats, _
            ReportPayPeriod, True
End Sub


Private Sub btnSave_Click()
'save report

On Error GoTo CheckError

Dim indUsrs As Integer
Dim indRprt As Integer
Dim indDays As Integer
Dim indCats As Integer

Open "Report.dat" For Output As #1

Print #1, Tab(24); "Time Report"
Print #1, Tab(20); "Pay period ending " & ReportPayPeriod


For indUsrs = 0 To UserList.cUsers - 1
    Print #1,
    Print #1,
    Print #1, "======================================================================"
    Print #1, "Employee: ", UserList.aUsers(indUsrs).DisplayName
    indRprt = UserList.aUsers(indUsrs).ReportIndex
    If Not indRprt = E_NOT_FOUND Then
        Print #1, Tab(20); _
           "Sun     Mon     Tue     Wed     Thu     Fri     Sat"
        For indCats = 0 To cReportCategories - 1
            Print #1, ReportCategoryList(indCats), Tab(20);
            For indDays = 0 To 6
                Print #1, aReport(indDays, indCats, indRprt); Tab(20 + (1 + indDays) * 8);
            Next indDays
            Print #1,
        Next indCats
    Else
        Print #1, "No data submitted"
    End If
Next indUsrs

Close #1

Exit Sub

CheckError:
MsgBox "Error saving user list"


End Sub


Private Sub Form_Load()
    ShowGrid

End Sub


Private Sub Form_Unload(Cancel As Integer)
'deinit variables global to this module

Dim ind As Integer

For ind = 0 To UserList.cUsers - 1
    UserList.aUsers(ind).ReportIndex = E_NOT_FOUND
Next ind

cReceivedReports = 0
cReportCategories = 0
ReportPayPeriod = Date
ReDim aReport(0, 0, 0)


End Sub