Imports System.Data.SqlClient Public Class DienstplanTV Public SQL As New sqlConn Dim aktWoche = DateToWeek(Now).Substring(4, 2) Dim aktJahr = DateToWeek(Now).Substring(0, 4) Dim aktDate = Now Dim aktpnl = "" Dim SCHICHT As String = "ROT" Dim cptmp As Point Dim woTagWidthProz = 0.136 Dim HeaderLeftWidthProz = 0.048 Dim mousepos Dim art As String = "ZOLL" Dim niederlassung As String = "SUB" Dim SCHICHTEN_ARTEN As New List(Of ADMIN.cDienstplanSchicht) Dim SETTINGS As ADMIN.cDienstSettings Dim TVAnzeige = False 'True Private Sub Form1_Load(sender As Object, e As EventArgs) Handles Me.Load tbcntr.TabPages.Clear() Dim s As New VERAG_PROG_ALLGEMEIN.SQL Dim dt As DataTable = s.loadDgvBySql("SELECT [dpset_id],[dpset_niederlassung] FROM [tblDienstSettings] order by dpset_reihenfolge", "ADMIN") For Each r As DataRow In dt.Rows Dim d As New TabPage() d.Text = r("dpset_niederlassung") d.Name = "tb" & r("dpset_niederlassung") tbcntr.TabPages.Add(d) Next tbcntr.SelectedIndex = 0 getNiederlassung() If TVAnzeige Then Timer1.Start() Cursor.Position = Me.PointToScreen(New Point(Me.Width, Me.Height)) Else ' Me.WindowState = FormWindowState.Normal Me.FormBorderStyle = Windows.Forms.FormBorderStyle.Sizable End If If EvenNumber(aktWoche) = False Then lblROTBLAU.ForeColor = Color.Red lblROTBLAU.Text = "( ROT )" SCHICHT = "ROT" Else lblROTBLAU.ForeColor = System.Drawing.Color.FromArgb(0, 54, 128) lblROTBLAU.Text = "( BLAU )" SCHICHT = "BLAU" End If initDienstplan() End Sub Sub getNiederlassung() If tbcntr.TabPages.Count = 0 Then Exit Sub niederlassung = tbcntr.SelectedTab.Name.Replace("tb", "") MsgBox(niederlassung) If niederlassung = "QS" Then art = "QS" Else art = "ZOLL" End Sub Sub initDienstplan() GC.Collect() lblKw.Text = "KW " & aktWoche margin_left = 0 If TVAnzeige Then mousepos = MousePosition initGrundgeruest() For Each o In pnlMain.Controls If o.GetType.ToString = "System.Windows.Forms.Panel" And Not o.Name = aktpnl Then o.Dispose() 'schließt das Panel und gibt den Arbeitsspeicher frei; vorher wurde der AS immer erhöht! End If Next End Sub Sub DoToAllControls(ByVal m_Control As Control) SQL = New sqlConn For Each ctrl As Control In m_Control.Controls If ctrl.Controls.Count > 0 Then DoToAllControls(ctrl) End If If ctrl.GetType.Name.Contains("DataGridView") Then DirectCast(ctrl, DataGridView).Columns.Clear() DirectCast(ctrl, DataGridView).DataSource = Nothing RemoveHandler DirectCast(ctrl, DataGridView).SelectionChanged, AddressOf dgv_SelectionChanged End If Next End Sub Private Sub pnlMain_MouseHover(sender As Object, e As EventArgs) ' MsgBox("m") Cursor.Show() End Sub Private Sub Panel4_MouseMove(sender As Object, e As MouseEventArgs) Handles pnlMain.MouseMove End Sub Public Function EvenNumber(ByVal n As Long) As Boolean EvenNumber = (n And 1&) = 0& End Function Dim margin_left As Integer = 0 Function getWochentagPanelZOLL(pnlMain As Panel, d As Date) As Panel Dim p As New Panel p.Width = pnlMain.Width * woTagWidthProz p.Height = pnlMain.Height p.Top = 0 p.BorderStyle = BorderStyle.FixedSingle p.Left = margin_left p.HorizontalScroll.Visible = False p.VerticalScroll.Visible = False pnlMain.Controls.Add(p) p.Controls.Add(getPnlHeader(pnlMain, d)) Dim pVM As New Panel pVM.Width = p.Width pVM.Top = 30 pVM.Height = CInt((p.Height - 30) * 0.4) p.Controls.Add(pVM) Dim pNM As New Panel pNM.Width = p.Width pNM.Height = CInt((p.Height - 30) * 0.4) pNM.Top = pVM.Height + 30 p.Controls.Add(pNM) Dim pTAG As New Panel pTAG.Width = p.Width pTAG.Height = CInt((p.Height - 30) * 0.2) pTAG.Top = pVM.Height + pNM.Height + 30 p.Controls.Add(pTAG) margin_left += p.Width Dim SCHICHTEN_ARTEN As New List(Of ADMIN.cDienstplanSchicht) Dim SETTINGS As ADMIN.cDienstSettings 'SCHICHTEN_ARTEN Dim Top_tmp = 0 For Each s In SCHICHTEN_ARTEN Dim pTmp As New Panel pTmp.Width = p.Width pTmp.Top = Top_tmp MsgBox(s.dedet_ProzentGrafik) pTmp.Height = CInt((p.Height - 30) * s.dedet_ProzentGrafik) p.Controls.Add(pTmp) ' p.BackColor = System.Drawing.Color.FromArgb(200, 200, 200) addDGVtoPnl(pTmp, d, s.dedet_bezeichnungDP, "dgv_" & s.dedet_abt & d.ToString("ddd")) ' pNM.Height = CInt((p.Height - 30) * 0.2) ' pNM.Top = CInt((p.Height - 30) * 0.6) + 30 Top_tmp += pTmp.Height Next If False Then If d.DayOfWeek = 0 Then p.BackColor = System.Drawing.Color.FromArgb(200, 200, 200) addDGVtoPnl(pNM, d, "'ZOLL_NM', 'DBL'", "dgv_NM" & d.ToString("ddd")) pNM.Height = CInt((p.Height - 30) * 0.2) pNM.Top = CInt((p.Height - 30) * 0.6) + 30 ElseIf d.DayOfWeek = 6 Then p.BackColor = System.Drawing.Color.FromArgb(200, 200, 200) addDGVtoPnl(pVM, d, "'ZOLL_VM','DBL'", "dgv_VM" & d.ToString("ddd")) pVM.Height = CInt((p.Height - 30) * 0.5) Else addDGVtoPnl(pVM, d, "'ZOLL_VM','DBL'", "dgv_VM" & d.ToString("ddd")) addDGVtoPnl(pNM, d, "'ZOLL_NM','DBL'", "dgv_NM" & d.ToString("ddd")) addDGVtoPnl(pTAG, d, "'ZOLL_TAG'", "dgv_TAG" & d.ToString("ddd")) End If End If Return p End Function Function getWochentagPanelQS(pnlMain As Panel, d As Date) As Panel Dim p As New Panel p.Width = pnlMain.Width * woTagWidthProz p.Height = pnlMain.Height p.Top = 0 p.BorderStyle = BorderStyle.FixedSingle p.Left = margin_left p.HorizontalScroll.Visible = False p.VerticalScroll.Visible = False pnlMain.Controls.Add(p) p.Controls.Add(getPnlHeader(pnlMain, d)) Dim pVM As New Panel pVM.Width = p.Width pVM.Top = 30 pVM.Height = CInt((p.Height - 30) * 1) '*1=100% p.Controls.Add(pVM) ' Dim pNM As New Panel ' pNM.Width = p.Width ' pNM.Height = CInt((p.Height - 30) * 0.4) ' pNM.Top = pVM.Height + 30 ' p.Controls.Add(pNM) ' Dim pTAG As New Panel ' pTAG.Width = p.Width ' pTAG.Height = CInt((p.Height - 30) * 0.2) ' pTAG.Top = pVM.Height + pNM.Height + 30 ' p.Controls.Add(pTAG) margin_left += p.Width If d.DayOfWeek = 0 Then p.BackColor = System.Drawing.Color.FromArgb(200, 200, 200) ' addDGVtoPnl(pNM, d, "'ZOLL_NM','DBL'", "dgv_NM" & d.ToString("ddd")) ' pNM.Height = CInt((p.Height - 30) * 0.2) ' pNM.Top = CInt((p.Height - 30) * 0.6) + 30 ElseIf d.DayOfWeek = 6 Then p.BackColor = System.Drawing.Color.FromArgb(200, 200, 200) addDGVtoPnl(pVM, d, "'QS'", "dgv_QS" & d.ToString("ddd")) pVM.Height = CInt((p.Height - 30) * 0.5) Else addDGVtoPnl(pVM, d, "'QS'", "dgv_QS" & d.ToString("ddd")) ' addDGVtoPnl(pNM, d, "'ZOLL_NM','DBL'", "dgv_NM" & d.ToString("ddd")) ' addDGVtoPnl(pTAG, d, "'ZOLL_TAG'", "dgv_TAG" & d.ToString("ddd")) End If Return p End Function Function getPnlHeader(pnlMain As Panel, d As Date) As Panel Dim p As New Panel p.Width = pnlMain.Width * woTagWidthProz p.Height = 30 p.Top = 0 ' p.Dock = DockStyle.Top p.BorderStyle = BorderStyle.FixedSingle Dim l As New Label l.Font = New Font(l.Font.FontFamily, 12, FontStyle.Bold) l.Top = 5 : l.Left = 5 l.Text = d.ToString("ddd, dd.MMM") p.Controls.Add(l) p.BackColor = System.Drawing.Color.FromArgb(240, 245, 255) If d.ToShortDateString = Now.ToShortDateString Then l.Font = New Font(l.Font, FontStyle.Bold Or FontStyle.Underline) p.BackColor = System.Drawing.Color.FromArgb(255, 255, 255) End If If d.DayOfWeek = 0 Then Dim l_so As New Label l_so.Font = New Font(l.Font.FontFamily, 9, FontStyle.Bold) l_so.Top = 5 : l_so.Left = p.Width - 100 If art = "ZOLL" Then l_so.Text = "(18-22 Uhr)" If art = "QS" Then l_so.Text = "" l_so.ForeColor = Color.White p.Controls.Add(l_so) p.BackColor = System.Drawing.Color.FromArgb(255, 130, 130) l.ForeColor = Color.White ElseIf d.DayOfWeek = 6 Then Dim l_sa As New Label l_sa.Font = New Font(l.Font.FontFamily, 9, FontStyle.Bold) l_sa.Top = 5 : l_sa.Left = p.Width - 100 If art = "ZOLL" Then l_sa.Text = "(6-14 Uhr)" If art = "QS" Then l_sa.Text = "(8-12 Uhr)" p.Controls.Add(l_sa) End If Return p End Function Sub getLeftPanel(pnlMain As Panel) Dim p As New Panel p.Width = pnlMain.Width * HeaderLeftWidthProz p.Height = pnlMain.Height p.BackColor = System.Drawing.Color.FromArgb(240, 245, 255) p.BorderStyle = BorderStyle.FixedSingle p.Left = margin_left pnlMain.Controls.Add(p) margin_left += p.Width '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! For Each s In SCHICHTEN_ARTEN Dim pnl As New Panel pnl.Width = p.Width pnl.Top = 30 pnl.BorderStyle = BorderStyle.FixedSingle pnl.Height = CInt((p.Height - 30) * s.dedet_ProzentGrafik) 'CInt((p.Height - 30) * 0.4) pnl.Controls.Add(getLabel("VORM." & vbNewLine & "6-13 Uhr", pnl)) p.Controls.Add(pnl) Next Exit Sub 'p.Controls.Add(getPnlHeader(d)) Dim pVM As New Panel pVM.Width = p.Width pVM.Top = 30 pVM.BorderStyle = BorderStyle.FixedSingle pVM.Height = CInt((p.Height - 30) * 0.4) pVM.Controls.Add(getLabel("VORM." & vbNewLine & "6-13 Uhr", pVM)) p.Controls.Add(pVM) Dim pNM As New Panel pNM.Width = p.Width pNM.Height = CInt((p.Height - 30) * 0.4) pNM.BorderStyle = BorderStyle.FixedSingle pNM.Controls.Add(getLabel("NACHM." & vbNewLine & "13-22 Uhr", pVM)) pNM.Top = pVM.Height + 30 p.Controls.Add(pNM) Dim pTAG As New Panel pTAG.Width = p.Width pTAG.Height = CInt((p.Height - 30) * 0.2) pTAG.BorderStyle = BorderStyle.FixedSingle pTAG.Controls.Add(getLabel("TAG" & vbNewLine & "8-17 Uhr", pTAG)) pTAG.Top = pVM.Height + pNM.Height + 30 p.Controls.Add(pTAG) End Sub Sub getLeftPanelQS(pnlMain As Panel) Dim p As New Panel p.Width = pnlMain.Width * HeaderLeftWidthProz p.Height = pnlMain.Height p.BackColor = System.Drawing.Color.FromArgb(240, 245, 255) p.BorderStyle = BorderStyle.FixedSingle p.Left = margin_left pnlMain.Controls.Add(p) margin_left += p.Width 'p.Controls.Add(getPnlHeader(d)) Dim pVM As New Panel pVM.Width = p.Width pVM.Top = 30 pVM.BorderStyle = BorderStyle.FixedSingle pVM.Height = CInt((p.Height - 30) * 1) pVM.Controls.Add(getLabel("QS" & vbNewLine & "8-12 Uhr", pVM)) p.Controls.Add(pVM) End Sub Function getLabel(t, p) As Label Dim l As New Label l.Font = New Font(l.Font.FontFamily, 10, FontStyle.Bold) ' l.Top = 5 : l.Left = 5 l.Text = t l.TextAlign = ContentAlignment.MiddleCenter l.AutoSize = True l.Top = p.height / 2 - l.PreferredHeight / 2 l.Left = p.width / 2 - l.PreferredWidth / 2 Return l End Function Sub initGrundgeruest() Dim pnlMainNew = New Panel pnlMainNew.Dock = DockStyle.Fill pnlMainNew.Name = "pnlMain_" & Now.ToString("ddMMHHmmss") aktpnl = pnlMainNew.Name pnlMain.Controls.Add(pnlMainNew) Dim montag As Date = CalendarWeek(aktWoche, aktJahr) If art = "ZOLL" Then getLeftPanel(pnlMainNew) If art = "QS" Then getLeftPanelQS(pnlMainNew) For i = 0 To 6 Dim d As Date = montag.AddDays(i) 'Wochentag If art = "ZOLL" Then getWochentagPanelZOLL(pnlMainNew, d) If art = "QS" Then getWochentagPanelQS(pnlMainNew, d) Next pnlMainNew.BringToFront() End Sub Sub addDGVtoPnl(p As Panel, d As Date, art As String, name As String) Dim dgv As New DataGridView With dgv .AllowUserToAddRows = False .AllowUserToDeleteRows = False .ReadOnly = False .AllowUserToResizeColumns = False .AllowUserToResizeRows = False .Name = name AddHandler dgv.SelectionChanged, AddressOf dgv_SelectionChanged .Dock = DockStyle.Fill .RowHeadersVisible = False .ColumnHeadersVisible = False If d.ToShortDateString = Now.ToShortDateString Then .BackgroundColor = System.Drawing.Color.FromArgb(255, 255, 230) .GridColor = System.Drawing.Color.FromArgb(255, 255, 230) .DefaultCellStyle.BackColor = System.Drawing.Color.FromArgb(255, 255, 230) Else .BackgroundColor = Color.White .GridColor = Color.White .DefaultCellStyle.BackColor = Color.White End If .Dock = DockStyle.Fill p.Controls.Add(dgv) initMABinding(dgv, art, d) 'AddHandler dgv.Paint, AddressOf initDgv(dgv, d) End With End Sub Private Sub PictureBox2_Click(sender As Object, e As EventArgs) Handles PictureBox2.Click Me.Close() End Sub Public Sub initMABinding(dgv As DataGridView, art As String, d As Date) dgv.DataSource = SQL.getDatatableBySql("SELECT dstma_kuerzel + ' '+ dstetr_info,dstma_reihenfolge, dstma_farbe,[dstetr_von],[dstetr_bis],[dstetr_pause] FROM tblDienstplanEintraege,tblDienstMitarb,tblMitarbeiter WHERE dstetr_dstmaId=dstma_id AND mit_id=dstma_mitId AND dstetr_datum='" & d.ToShortDateString & "' AND dstetr_art IN(" & art & ") AND dstetr_niederlassung = '" & niederlassung & "' ORDER BY dstma_reihenfolge ASC") End Sub Public Function DateToWeek(ByVal dDate As Date) As String ' Startdatum der ersten Kalenderwoche des Jahres und Folgejahres berechnen Dim dThisYear As Date = CalendarWeek(1, dDate.Year) Dim dNextYear As Date = CalendarWeek(1, dDate.Year + 1) ' Prüfen, ob Datum zur ersten Woche des Folgejahres gehört If dDate >= dNextYear Then ' Rückgabe: KW 1 des Folgejahres Return dDate.Year + 1 & "01" ElseIf dDate < dThisYear Then ' Falls das Datum noch zu einer KW aus dem letzten Jahr zählt Return dDate.Year - 1 & DatePart(DateInterval.WeekOfYear, _ New Date(dDate.Year - 1, 12, 28), FirstDayOfWeek.Monday, _ FirstWeekOfYear.FirstFourDays) Else ' KW = Differenz zum ersten Tag der ersten Woche Return dDate.Year & Format$(dDate.Subtract(dThisYear).Days \ 7 + 1, "00") End If End Function Public Function CalendarWeek(ByVal nWeek As Integer, _ ByVal nYear As Integer) As Date ' Wochentag des 4. Januar des Jahres ermitteln Dim dStart As New Date(nYear, 1, 4) Dim nDay As Integer = (dStart.DayOfWeek + 6) Mod 7 + 1 ' Beginn der 1. KW des Jahres Dim dFirst As Date = dStart.AddDays(1 - nDay) ' Gesuchte KW ermitteln Return dFirst.AddDays((nWeek - 1) * 7) End Function Private Sub dgv_SelectionChanged(sender As Object, e As EventArgs) sender.ClearSelection() End Sub Private Sub initDgv(dgv As DataGridView, d As Date) dgv.DefaultCellStyle.Font = New Font(dgv.Font.FontFamily, 12) If TVAnzeige Then If art = "ZOLL" Then dgv.DefaultCellStyle.Font = New Font(dgv.Font.FontFamily, 12) If art = "QS" Then dgv.DefaultCellStyle.Font = New Font(dgv.Font.FontFamily, 16) End If ' Dim dgv As DataGridView = DirectCast(sender, DataGridView) ' dgv.Columns(0).ReadOnly = False If dgv.Rows.Count > 0 Then dgv.Columns(0).Width = dgv.Parent.Width - 10 For Each r As DataGridViewRow In dgv.Rows Try : r.Cells(0).Style.ForeColor = ColorTranslator.FromHtml(r.Cells(2).Value) : Catch : End Try Next ' MsgBox(dgv.Rows(0).Cells(0).Value) dgv.Columns("dstetr_von").Visible = False dgv.Columns("dstetr_bis").Visible = False dgv.Columns("dstetr_pause").Visible = False If TVAnzeige Then If Not d.DayOfWeek = DayOfWeek.Sunday And (dgv.Name.ToString.Contains("dgv_VM") Or dgv.Name.ToString.Contains("dgv_NM")) Then dgv.Rows(0).Cells(0).Value = dgv.Rows(0).Cells(0).Value & " (SL)" ' dgv.Rows(0).Cells(0).Style.ForeColor = Color.Red dgv.Rows(0).Cells(0).Style.Font = New Font(dgv.Font.FontFamily, 12, FontStyle.Bold) End If Else dgv.Columns(0).AutoSizeMode = DataGridViewAutoSizeColumnMode.Fill ' = dgv.Parent.Width - 10 ' dgv.Rows(0).Cells(0).Value = dgv.Rows(0).Cells(0).Value & " " & dgv.Rows(0).Cells("dstetr_von").Value & "-" & dgv.Rows(0).Cells("dstetr_bis").Value dgv.Columns("dstetr_von").Width = 50 dgv.Columns("dstetr_bis").Width = 50 dgv.Columns("dstetr_von").Visible = True dgv.Columns("dstetr_bis").Visible = True 'dgv.Columns("dstetr_pause").Visible = False End If dgv.Columns(1).Visible = False dgv.Columns(2).Visible = False 'dgv.Rows(0).Cells(0).Style.Font.Bold = True dgv.ScrollBars = ScrollBars.None Else dgv.Columns.Clear() End If End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Me.Cursor = Cursors.WaitCursor aktDate = aktDate.AddDays(7) aktWoche = DateToWeek(aktDate).Substring(4, 2) aktJahr = DateToWeek(aktDate).Substring(0, 4) initDienstplan() Me.Cursor = Cursors.Default End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click Me.Cursor = Cursors.WaitCursor aktDate = aktDate.AddDays(-7) aktWoche = DateToWeek(aktDate).Substring(4, 2) aktJahr = DateToWeek(aktDate).Substring(0, 4) initDienstplan() Me.Cursor = Cursors.Default End Sub Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick If Cursor.Position = cptmp Then Cursor.Position = Me.PointToScreen(New Point(0, Me.Height)) End If cptmp = Cursor.Position initDienstplan() End Sub Private Sub pnlMain_Paint(sender As Object, e As PaintEventArgs) Handles pnlMain.Paint End Sub Private Sub Label1_Click(sender As Object, e As EventArgs) Handles Label1.Click Exit Sub If Label1.Text = "DIENSTPLAN - ATILLA" Then art = "QS" niederlassung = "SUB" Label1.Text = "DIENSTPLAN - QS" ElseIf Label1.Text = "DIENSTPLAN - QS" Then art = "ZOLL" niederlassung = "SUB" Label1.Text = "DIENSTPLAN - ZOLL" ElseIf Label1.Text = "DIENSTPLAN - ZOLL" Then art = "ZOLL" niederlassung = "ATILLA" Label1.Text = "DIENSTPLAN - ATILLA" End If initDienstplan() End Sub Private Sub tbcntr_SelectedIndexChanged(sender As Object, e As EventArgs) Handles tbcntr.SelectedIndexChanged getNiederlassung() initDienstplan() End Sub End Class