fwcalendarconverter/FWCreateCalendar/frmMain.vb

Option Strict On
Imports System.Globalization
Imports System.IO
Imports DevExpress.Data
Imports DevExpress.Spreadsheet
Imports DevExpress.XtraEditors
Imports DevExpress.XtraGrid
Imports DevExpress.XtraGrid.Views.Base
Imports DevExpress.XtraGrid.Views.Grid
Imports DevExpress.XtraScheduler
Imports DevExpress.XtraScheduler.iCalendar
Imports Microsoft.Office.Interop
Public Class frmMain

    ' Dinge, die in My.Settings gepackt werden können:
    Dim headDate As New TableHeader("Datum")
    Dim headTime As New TableHeader("Start")
    Dim headSubject As New TableHeader("Ausbildung")
    Dim headLocation As New TableHeader("Ort")
    Dim headCategory As New TableHeader("Art")

    Dim TableHeaders As New List(Of TableHeader)

    Dim ds As New List(Of EventEntry)
    Dim dv As DataView
    Dim dt1900 As New Date(1900, 1, 1)

    'In diesem Form kann direkt die Excel-Datei von Jörg eingelesen werden
    'Im Idealfall das dann direkt in den Scheduler gegeben werden, der dann eine ICS ausspuckt
    'Dann muss nichtmal mehr die Excel-Datei bearbeitet werden

    Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        prepare()
        With TableHeaders
            .Clear()
            .AddRange({headDate, headTime, headSubject, headLocation, headCategory})
        End With
    End Sub


    Private Sub prepare()
        grd.DataSource = ds
        With grdv
            .PopulateColumns()
            .Columns(NameOf(EventEntry.StartDate)).DisplayFormat.FormatType = DevExpress.Utils.FormatType.DateTime
            .Columns(NameOf(EventEntry.StartDate)).DisplayFormat.FormatString = "ddd dd.MM.yy HH:mm"
            .Columns(NameOf(EventEntry.StartDate)).MinWidth = 100
            .Columns(NameOf(EventEntry.StartDate)).ColumnEdit = ridtpStartEndDate
            .Columns(NameOf(EventEntry.EndDate)).DisplayFormat.FormatType = DevExpress.Utils.FormatType.DateTime
            .Columns(NameOf(EventEntry.EndDate)).DisplayFormat.FormatString = "ddd dd.MM.yy HH:mm"
            .Columns(NameOf(EventEntry.EndDate)).MinWidth = 100
            .Columns(NameOf(EventEntry.EndDate)).ColumnEdit = ridtpStartEndDate
            .Columns(NameOf(EventEntry.StartDate)).Caption = "Start"
            .Columns(NameOf(EventEntry.EndDate)).Caption = "Ende"
            .Columns(NameOf(EventEntry.AllDay)).Caption = "Ganztag"
            .Columns(NameOf(EventEntry.Category)).Caption = "Art"
            .Columns(NameOf(EventEntry.Subject)).Caption = "Betreff"
            .Columns(NameOf(EventEntry.Location)).Caption = "Ort"
            .Columns(NameOf(EventEntry.Status)).Caption = "Hinweis"
            .Columns(NameOf(EventEntry.Status)).Visible = False
            .Columns(NameOf(EventEntry.Status)).OptionsColumn.AllowEdit = False
            .Columns(NameOf(EventEntry.Exclude)).Caption = "Ausschließen"
            .Columns(NameOf(EventEntry.IsInvalid)).Caption = "Ungültig"
            .Columns(NameOf(EventEntry.IsInvalid)).Visible = False
            .Columns(NameOf(EventEntry.IsInvalid)).OptionsColumn.AllowEdit = False
            .Columns(NameOf(EventEntry.RowIndex)).Visible = False
            .Columns(NameOf(EventEntry.RowIndex)).OptionsColumn.AllowEdit = False
            .Columns(NameOf(EventEntry.TimeZoneKey)).Visible = False
            .Columns(NameOf(EventEntry.TimeZoneKey)).OptionsColumn.AllowEdit = False
        End With
        grdv.FormatRules.Add(GridFunctions.CreateFormatRule(grdv, NameOf(EventEntry.Exclude), True, FormatCondition.Equal, True, backcolor:=Color.LightGray))
        grdv.FormatRules.Add(GridFunctions.CreateFormatRule(grdv, NameOf(EventEntry.IsInvalid), True, FormatCondition.Equal, True, backcolor:=Color.MistyRose))

        With schedStorage
            .Appointments.DataSource = ds
            With .Appointments.Mappings
                .AllDay = NameOf(EventEntry.AllDay)
                .Start = NameOf(EventEntry.StartDate)
                .End = NameOf(EventEntry.EndDate)
                .Subject = NameOf(EventEntry.Subject)
                .Location = NameOf(EventEntry.Location)
                .Label = NameOf(EventEntry.Category)
                '.TimeZoneId = NameOf(EventEntry.TimeZoneKey)
            End With
            .Appointments.CustomFieldMappings.Add(New AppointmentCustomFieldMapping(NameOf(EventEntry.IsInvalid), NameOf(EventEntry.IsInvalid)))
            .Appointments.CustomFieldMappings.Add(New AppointmentCustomFieldMapping(NameOf(EventEntry.Exclude), NameOf(EventEntry.Exclude)))

            .Labels.DataSource = General.Settings.Categories
            With schedStorage.Labels.Mappings
                .Color = NameOf(Category.Color)
                .Id = NameOf(Category.Key)
                .DisplayName = NameOf(Category.Text)
                .MenuCaption = NameOf(Category.Text)
            End With

            .Appointments.Filter = $"[{NameOf(EventEntry.IsInvalid)}] = FALSE AND [{NameOf(EventEntry.Exclude)}] = FALSE"
        End With

        sched.GoToToday()
    End Sub

    Private Sub ImportDatasourceFromFile(datei As String)
        schedStorage.Appointments.DataSource = Nothing
        grd.BeginUpdate()
        grd.DataSource = Nothing
        ds = GetEventsFromFile(datei)
        grd.DataSource = ds
        grd.EndUpdate()
        grdv.BestFitColumns()
        schedStorage.Appointments.DataSource = ds
        sched.RefreshData()
    End Sub



    Public Function GetEventsFromFile(datei As String) As List(Of EventEntry)
        Dim xlApp = New Excel.Application
        'Im Fall von folgendem Fehler:
        'The COM object of the type "Microsoft.Office.Interop.Excel.ApplicationClass" cannot be converted to the interface type "Microsoft.Office.Interop.Excel._Application". 
        ' - Office 365 App reparieren (Schnellreparatur hat das letzte mal geholfen)
        ' - "32bit bevorzugen" deaktivieren in den Projekteinstellungen (ggf. bei 64bit Office?)
        ' - https://stackoverflow.com/questions/28066719/unable-to-cast-com-object-of-type-microsoft-office-interop-excel-applicationcla
        Dim xlMappe = xlApp.Workbooks.Open(datei)
        Dim xlBlatt As Excel.Worksheet
        'xlApp = New Excel.Application()
        '    xlApp.Visible = False
        'xlMappe = xlApp.Workbooks.Open(datei)
        xlBlatt = CType(xlMappe.Worksheets(1), Excel.Worksheet)
        Dim Events As New List(Of EventEntry)
        Dim ev As EventEntry
        'Dim culture = CultureInfo.CreateSpecificCulture("de-DE")


        Dim headerfound As Boolean
        Dim HeaderRow As Integer
        'Dim Headers As New List(Of TableHeader)
        'Headers.AddRange()

        If xlBlatt.UsedRange.Rows.Count > 1 Then
            'Kopfzeile suchen
            For i = 1 To xlBlatt.UsedRange.Rows.Count
                'Prüfen, ob alle Header in der Row vorkommen
                For Each header As TableHeader In TableHeaders
                    headerfound = False
                    For j = 1 To xlBlatt.UsedRange.Columns.Count
                        If CStr(CType(xlBlatt.Cells(i, j), Excel.Range).Text).Trim.ToLower = header.FieldName.Trim.ToLower Then
                            header.ColumnIndex = j
                            headerfound = True
                        End If
                    Next
                    If headerfound = False Then
                        HeaderRow = -1
                        Exit For
                    Else
                        HeaderRow = i
                    End If
                Next
                If HeaderRow <> -1 Then Exit For
            Next

            If HeaderRow = -1 Then
                MessageBox.Show("Die Tabellenüberschriften wurden nicht gefunden. Bitte prüfen, ob die Zuordnungen vom Namen her noch stimmen", "Fehler", MessageBoxButtons.OK, MessageBoxIcon.Error)
                Return Nothing
            End If

            Dim zDatum, zStart As String
            Dim foreColor As Color
            ' Dim Status As New List(Of String)
            For i = HeaderRow + 1 To xlBlatt.UsedRange.Rows.Count
                ' Status.Clear()
                zDatum = CStr(CType(xlBlatt.Cells(i, headDate.ColumnIndex), Excel.Range).Text)
                zStart = CStr(CType(xlBlatt.Cells(i, headTime.ColumnIndex), Excel.Range).Text)
                ev = New EventEntry
                ev.RowIndex = i
                foreColor = System.Drawing.ColorTranslator.FromOle(CInt(CType(xlBlatt.Cells(i, headDate.ColumnIndex), Excel.Range).Font.Color))
                If foreColor = Color.White Then
                    ' Status.Add("Datum ist versteckt")
                    ev.IsInvalid = True
                ElseIf zDatum.Trim.Length = 0 Then
                    ' Status.Add("Kein Datum angegeben")
                    ev.IsInvalid = True
                ElseIf zStart.Trim.Length > 0 AndAlso Date.TryParse($"{zDatum} {zStart}", ev.StartDate) Then
                    ev.EndDate = ev.StartDate.AddHours(My.Settings.EndDateCalculationHoursToAdd)
                ElseIf Date.TryParse($"{zDatum}", ev.StartDate) Then
                    'Status.Add("Keine Zeit gefunden, gehe von Ganztag aus")
                    ev.EndDate = ev.StartDate.Date.AddHours(24).AddMinutes(-1)
                    ev.AllDay = True
                Else
                    'Status.Add("Datum konnte nicht ermittelt werden")
                    ev.IsInvalid = True
                End If
                ev.Category = CStr(CType(xlBlatt.Cells(i, headCategory.ColumnIndex), Excel.Range).Text).Trim

                If ev.Category.Trim.Length > 0 AndAlso General.Settings.Categories.Exists(Function(c) c.Key = ev.Category) = False Then
                    General.Settings.Categories.Add(New Category(ev.Category, ev.Category, Color.Red))
                End If

                ev.Subject = CStr(CType(xlBlatt.Cells(i, headSubject.ColumnIndex), Excel.Range).Text).Trim
                ev.Location = CStr(CType(xlBlatt.Cells(i, headLocation.ColumnIndex), Excel.Range).Text).Trim
                '  ev.Status = String.Join(", ", Status.ToArray)
                If ev.Subject.Trim.Length > 0 Then Events.Add(ev)
            Next
        End If
        xlMappe.Close()
        xlApp.Quit()
        General.Settings.Save()

        RefreshEventExclusion(Events)
        CheckEventValidity(Events)

        Return Events
    End Function

    Private Sub RefreshEventExclusion(datasource As List(Of EventEntry))
        For Each ev As EventEntry In datasource
            ev.Exclude = If(General.Settings.Categories.FirstOrDefault(Function(c) c.Key = ev.Category)?.Exclude, False)
        Next
    End Sub

    Private Sub CheckEventValidity(datasource As List(Of EventEntry))
        For Each ev As EventEntry In datasource
            If ev.StartDate > dt1900 AndAlso ev.EndDate > dt1900 Then
                ev.IsInvalid = False
            End If
        Next
    End Sub


    Private Shared Sub Grdv_MouseWheel(sender As Object, e As MouseEventArgs) Handles grdv.MouseWheel
        TryCast(sender, GridView)?.CloseEditor() 'Klappt so auch mit BandedGridViews
    End Sub

    Private Sub btnOpenFile_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnOpenFile.ItemClick
        If OFD.ShowDialog = DialogResult.OK Then
            SFD.FileName = $"{Path.GetFileNameWithoutExtension(OFD.FileName)}.ics"
            SFD.InitialDirectory = Path.GetDirectoryName(OFD.FileName)
            ImportDatasourceFromFile(OFD.FileName)
            xlsSheet.LoadDocument(OFD.FileName)
        End If
    End Sub

    Private Sub btnCategories_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnCategories.ItemClick
        Dim frm As New frmSettings
        If frm.ShowDialog = DialogResult.OK Then
            RefreshEventExclusion(ds)
            CheckEventValidity(ds)
            grdv.RefreshData()
            schedStorage.RefreshData()
        End If
    End Sub

    Private Sub btnExport_ItemClick(sender As Object, e As DevExpress.XtraBars.ItemClickEventArgs) Handles btnExport.ItemClick
        GridFunctions.EndGridEdit(grdv)
        SFD.FileName = Path.GetFileNameWithoutExtension(OFD.FileName) & ".ics"
        If SFD.ShowDialog = DialogResult.OK Then
            'schedStorage.TimeZoneId = General.Settings.DefaultTimezoneId
            Dim exporter As New iCalendarExporter(schedStorage)
            exporter.ProductIdentifier = "FW-EXPORTER"
            exporter.CustomPropertyIdentifier = "FWPROP"
            AddHandler exporter.AppointmentExporting, AddressOf Exporter_AppointmentExporting
            Dim failed As Boolean
            Try
                exporter.Export(SFD.FileName)
            Catch ex As Exception
                failed = True
            End Try
            If failed = False Then MessageBox.Show("Export abgeschlossen", "Kalenderexport", MessageBoxButtons.OK, MessageBoxIcon.Information)
        End If
    End Sub

    Private Sub Exporter_AppointmentExporting(sender As Object, e As AppointmentExportingEventArgs)
        'e.Appointment.TimeZoneId = sched.OptionsBehavior.ClientTimeZoneId
        'e.Appointment.TimeZoneId = General.Settings.DefaultTimezoneId
        If CType(e.Appointment.GetSourceObject(schedStorage), EventEntry).Exclude OrElse CType(e.Appointment.GetSourceObject(schedStorage), EventEntry).IsInvalid Then
            e.Cancel = True
        End If
    End Sub

    Private Sub grdv_CellValueChanged(sender As Object, e As CellValueChangedEventArgs) Handles grdv.CellValueChanged
        If e.Column.FieldName = NameOf(EventEntry.StartDate) OrElse e.Column.FieldName = NameOf(EventEntry.EndDate) Then
            Dim StartDate As Date = CDate(grdv.GetRowCellValue(e.RowHandle, NameOf(EventEntry.StartDate)))
            Dim EndDate As Date = CDate(grdv.GetRowCellValue(e.RowHandle, NameOf(EventEntry.EndDate)))
            If EndDate < StartDate Then
                grdv.SetRowCellValue(e.RowHandle, NameOf(EventEntry.EndDate), StartDate)
            End If
        ElseIf e.Column.FieldName = NameOf(EventEntry.AllDay) Then
            If CBool(e.Value) Then
                Dim EndDate As Date = CDate(grdv.GetRowCellValue(e.RowHandle, NameOf(EventEntry.EndDate)))
                grdv.SetRowCellValue(e.RowHandle, NameOf(EventEntry.EndDate), EndDate.Date.AddDays(1).AddSeconds(-1))
            End If
        End If
        CheckEventValidity(ds)
        grdv.RefreshData()
        schedStorage.RefreshData()
    End Sub

    Private Sub grdv_SelectionChanged(sender As Object, e As SelectionChangedEventArgs) Handles grdv.SelectionChanged
        Dim workbook As IWorkbook = xlsSheet.Document
        Dim activeSheet As Worksheet = workbook.Worksheets.ActiveWorksheet
        xlsSheet.SelectedCell = activeSheet.Cells($"A{grdv.GetFocusedRowCellValue("RowIndex")}")
        activeSheet.ScrollTo(activeSheet.SelectedCell)
    End Sub
End Class