Public Class Form1
Dim reeks() As String = {"Januari", "Februari", "Maart", "April", "Mei", "Juni", "Juli", "Augustus", "September", "Oktober", "Novermber", "December"}
Dim dagenpermaand() As Integer = {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31} 'voor februarie kan u een script maken dat in een schrikkeljaar 29 dagen worden
Dim werknemers() As String = {""} 'hoeft u zelf niet in te vullen
Dim ConectedFile As String = "C:\Verlof\2010.txt" 'u kan een script voor maken dat het elk jaar veranderd
Enum ArrayText
Helemaal = 0
DeelVanArray = 1
End Enum
Private Sub Form1_Load1() Handles MyBase.Load
Verlofdagen.Rows.Add(31)
For k = 0 To 23
Verlofdagen.Columns(k).Width = 35
If Even(k) Then
Verlofdagen.Columns(k).ReadOnly = True
Verlofdagen.Columns(k).HeaderText = reeks(k / 2)
For r = 0 To 30
Verlofdagen.Rows(r).Cells(k).Value = r + 1
Verlofdagen.Rows(r).Height = 20
Next
Else
Verlofdagen.Columns(k).ReadOnly = False
Verlofdagen.Columns(k).HeaderText = "Naam"
End If
Next
DisableOverdatums()
If Not My.Computer.FileSystem.DirectoryExists("C:\Verlof") Then My.Computer.FileSystem.CreateDirectory("C:\Verlof")
If Not My.Computer.FileSystem.FileExists(ConectedFile) Then Files.Overwrite("", ConectedFile) Else Loaden()
End Sub
Sub DisableOverdatums()
For k = 1 To 23 Step 2
For r = 0 To 30
If r + 1 > dagenpermaand((k - 1) / 2) Then
Verlofdagen.Rows(r).Cells(k).ReadOnly = True
Verlofdagen.Rows(r).Cells(k - 1).ReadOnly = True
SetCell(r, k - 1, "XXX")
SetCell(r, k, "XXX")
End If
Next
Next
End Sub
[COLOR="Blue"]Enum SaveType
VoledigeNaamEnHeleDatum = 0
VolledigeNaamEnVakjeVoorVakje = 1
VerwijzingsNaamEnHeleDatum = 2
VerwijzingsNaamEnVakjeVoorVakje = 3
End Enum[/COLOR]
[COLOR="DarkOrange"] Private Sub Save_Click() Handles Button1.Click
Saven(SaveType.[COLOR="Teal"]VoledigeNaamEnHeleDatum[/COLOR]) [COLOR="Red"]'u kunt het beste de code kopieren naar uw vb project en daar 'het groene stuk' wijzigen, dan krijgt u namelijk een keuze uit 4, hier moet u de namen precies weten zie: [COLOR="Blue"]'enum SaveType" (blauw hierboven)[/COLOR][/COLOR]
End Sub[/COLOR]
Sub Saven(Optional ByVal Type As SaveType = SaveType.VerwijzingsNaamEnHeleDatum)
GetWerkNemers()
Dim Text As String = ""
If Type = SaveType.VerwijzingsNaamEnVakjeVoorVakje Or Type = SaveType.VerwijzingsNaamEnHeleDatum Then
Text &= "<wnc>" 'WerkNemerCodes
For w = 0 To werknemers.Length - 1
If Not w = 0 Then Text &= ";"
Text &= GetLetterCode(w) & "=" & werknemers(w)
Next
Text &= "</wnc>"
For k = 1 To 23 Step 2
For r = 0 To 30
For w = 0 To werknemers.Length - 1
If GetCell(r, k) = werknemers(w) Then SetCell(r, k, "$" & GetLetterCode(w))
Next
Next
Next
End If
If Type = SaveType.VolledigeNaamEnVakjeVoorVakje Or Type = SaveType.VerwijzingsNaamEnVakjeVoorVakje Then
Text &= "<vvv>" 'Vakje Voor Vakje
Dim Alles(11) As String
For k = 0 To 11
Dim rij(30) As String
For r = 0 To 30
If Not Replace(GetCell(r, k * 2 + 1), " ", "") = "" Then
rij(r) = GetCell(r, k * 2 + 1)
Else
rij(r) = ""
End If
Next
Alles(k) = ArraySamenvoegen(rij, ";")
Next
Text &= ArraySamenvoegen(Alles, ":")
Text &= "</vvv>"
End If
'bij voledige datums
If Type = SaveType.VoledigeNaamEnHeleDatum Or Type = SaveType.VerwijzingsNaamEnHeleDatum Then
Text &= "<hd>" 'Hele Datum
Dim t As String = ""
For k = 1 To 23 Step 2
For r = 0 To 30
If Not Replace(GetCell(r, k), " ", "") = "" Then
If Not t = "" Then t &= ";"
t = t & (k + 1) / 2 & "-" & r + 1 & ":" & GetCell(r, k) '[maand] "-" [dag] ":" [werknemer] ";" [maand] "-" [da ...
Else
End If
Next
Next
Text &= t
Text &= "</hd>"
End If
If Type = SaveType.VerwijzingsNaamEnVakjeVoorVakje Or Type = SaveType.VerwijzingsNaamEnHeleDatum Then
For k = 1 To 23 Step 2
For r = 0 To 30
For w = 0 To werknemers.Length - 1
If GetCell(r, k) = "$" & GetLetterCode(w) Then SetCell(r, k, werknemers(w))
Next
Next
Next
End If
Files.Overwrite(Text, ConectedFile)
End Sub
Private Sub Loaden_Click() Handles Button2.Click
Loaden()
End Sub
Sub Loaden()
Dim text As String = Files.Lees(ConectedFile)
Dim wnc As String = GetTextBetween(text, "<wnc>", "</wnc>")
Dim vvv As String = GetTextBetween(text, "<vvv>", "</vvv>")
Dim hd As String = GetTextBetween(text, "<hd>", "</hd>")
For k = 1 To 23 Step 2
For r = 0 To 30
SetCell(r, k, "") ' alles leegmaken
Next
Next
If Not vvv = "" Then
Dim maanden() As String = Split(vvv, ":")
For k = 1 To 23 Step 2
Dim dag() As String = Split(maanden((k - 1) / 2), ";")
For r = 0 To 30
SetCell(r, k, dag(r))
Next
Next
End If
If Not hd = "" Then
Dim Gegevens As String() = Split(hd, ";")
For w = 0 To Gegevens.Length - 1
Dim naam As String = Split(Gegevens(w), ":")(1)
Dim kolom As Integer = Split(Gegevens(w), "-")(0) * 2 - 1
Dim rij As Integer = Split(Split(Gegevens(w), ":")(0), "-")(1)
SetCell(rij - 1, kolom, naam)
Next
End If
If Not wnc = "" Then
Dim werknemer() As String = Split(wnc, ";")
ReDim werknemers(werknemer.Length - 1)
For w = 0 To werknemer.Length - 1
werknemers(w) = Split(werknemer(w), "=")(1)
Next
For w = 0 To werknemers.Length - 1
text = Replace(text, GetLetterCode(w), werknemers(w))
Next
For k = 1 To 23 Step 2
For r = 0 To 30
For w = 0 To werknemers.Length - 1
If GetCell(r, k) = "$" & GetLetterCode(w) Then SetCell(r, k, werknemers(w))
Next
Next
Next
End If
DisableOverdatums()
End Sub
Function Even(ByVal getal As Integer) As Boolean
Dim g As Integer = getal / 2
Return getal = g * 2
End Function
Sub GetWerkNemers()
For k = 1 To 23 Step 2
For r = 0 To 30
For a = 0 To werknemers.Length - 1
If GetCell(r, k) = werknemers(a) Then GoTo doorgaan
Next
ReDim Preserve werknemers(werknemers.Length)
werknemers(werknemers.Length - 1) = GetCell(r, k)
doorgaan:
Next
Next
VerkeerdeWeghalen()
End Sub
Sub VerkeerdeWeghalen()
'spaties --> niets
ReplaceArray(werknemers, " ", "")
'haal lege vakjes weg
Dim max As Integer = werknemers.Length - 1
Dim k As Integer = 0
Do While k <= max
If werknemers(k) = "" Then werknemers(k) = werknemers(werknemers.Length - 1) : ReDim Preserve werknemers(werknemers.Length - 2) : max = werknemers.Length - 1
k += 1
Loop
End Sub
Function ReplaceArray(ByVal text() As String, ByVal Zoek As String, ByVal Vervanger As String, Optional ByVal Hoe As ArrayText = ArrayText.DeelVanArray) As String()
For k = 0 To text.Length - 1
If Hoe = ArrayText.DeelVanArray Then text(k) = Replace(text(k), Zoek, Vervanger)
If Hoe = ArrayText.Helemaal Then If text(k) = Zoek Then text(k) = vervanger
Next
Return text
End Function
Function GetTextBetween(ByVal Text As String, ByVal EersteTeken As String, ByVal LaarsteTeken As String) As String ' is niet foutloos maar wel voor dit doel geschikt
On Error GoTo err
Return Split(Split(Text, EersteTeken)(1), LaarsteTeken)(0)
Exit Function
err:
Return ""
End Function
Function ArraySamenvoegen(ByVal Texten() As String, Optional ByVal Scheidingsteken As String = " ") As String
Dim nieuw As String = ""
For k = 0 To Texten.Length - 1
If Not k = 0 Then nieuw &= Scheidingsteken
nieuw &= Texten(k)
Next
Return nieuw
End Function
Function GetCell(ByVal Rij As Integer, ByVal Kolom As Integer) As String
On Error GoTo err
Return Verlofdagen.Rows(Rij).Cells(Kolom).Value
Exit Function
err:
Return ""
End Function
Sub SetCell(ByVal Rij As Integer, ByVal Kolom As Integer, ByVal value As String)
On Error Resume Next
Verlofdagen.Rows.Item(Rij).Cells(Kolom).Value = value
End Sub
Function GetLetterCode(ByVal getal As Integer) As String
Dim L1 As Integer
L1 = getal / 52
Dim L2 As Integer
L2 = getal - L1 * 52
Dim gt As Integer = 0
For k = 0 To 1
If k = 0 Then gt = L1 Else gt = L2
Select Case gt
Case 0 To 25 : gt = 65 + gt
Case 26 To 51 : gt = 97 + gt
Case Else : Return "" : Exit Function
End Select
If k = 0 Then L1 = gt Else L2 = gt
Next
Return Chr(L1) & Chr(L2)
End Function
Function Tel(ByVal Text As String, ByVal Zoek As String) As Integer
Return Split(Text, Zoek).Length - 1
End Function
Private Sub Verlofdagen_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Verlofdagen.MouseMove
Dim muis As Point = e.Location
muis.Y -= 21 'kolom header
muis.X = muis.X / 35 + 0.5
muis.Y = muis.Y / 20 + 0.5
If Not Even(muis.X) Then muis.X += 1
ToolStripStatusLabel1.Text = GetCell(muis.Y - 1, muis.X - 1)
End Sub
End Class
Public Class Files
Shared Sub Add(ByVal TextToAdd As String, ByVal Lokatie As String)
Dim TextNu As String = Lees(Lokatie)
Dim ioFile As New System.IO.StreamWriter(Lokatie)
ioFile.Write(TextNu & TextToAdd)
ioFile.Close()
End Sub
Shared Sub Overwrite(ByVal TextToFile As String, ByVal Lokatie As String)
Dim ioFile As New System.IO.StreamWriter(Lokatie)
ioFile.Write(TextToFile)
ioFile.Close()
End Sub
Shared Function Lees(ByVal Lokatie As String)
On Error GoTo err
Return My.Computer.FileSystem.ReadAllText(Lokatie)
Exit Function
err:
Return ""
End Function
End Class
