Mini Kabibi Habibi
Imports Microsoft.VisualBasic
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports DevExpress.XtraPrinting
Imports System.Threading
Imports System.Globalization
Namespace XtraPrintingDemos.Calendar
Public Class CalendarLink
Private Shared Function IsHoliday(ByVal [date] As DayOfWeek) As Boolean
Return [date] = DayOfWeek.Saturday OrElse [date] = DayOfWeek.Sunday
End Function
Private Const WeeksInMonth As Integer = 6
Private imageList As ImageList
Private daysOfWeek() As String
Private shortDaysOfWeek() As String
Private week() As DayOfWeek
Private firstDayOfWeek As DayOfWeek
Private prSelectedDate? As System.DateTime
Public Property SelectedDate() As System.DateTime
Get
Return If(prSelectedDate.HasValue, prSelectedDate.Value, DateTime.Now)
End Get
Set(ByVal value As System.DateTime)
prSelectedDate = value
End Set
End Property ' Second
Public Sub New(ByVal iml As ImageList)
daysOfWeek = Thread.CurrentThread.CurrentCulture.DateTimeFormat.DayNames
shortDaysOfWeek = Thread.CurrentThread.CurrentCulture.DateTimeFormat.AbbreviatedDayNames
firstDayOfWeek = Thread.CurrentThread.CurrentCulture.DateTimeFormat.FirstDayOfWeek
week = New DayOfWeek(daysOfWeek.Length - 1) {}
Dim index As Integer = 0
For i As Integer = CInt(Fix(firstDayOfWeek)) To daysOfWeek.Length - 1
week(index) = CType(i, DayOfWeek)
index += 1
Next i
For i As Integer = 0 To CInt(Fix(firstDayOfWeek)) - 1
week(index) = CType(i, DayOfWeek)
index += 1
Next i
If iml IsNot Nothing Then
imageList = iml
Else
imageList = New ImageList()
imageList.ImageSize = New Size(35, 35)
End If
End Sub
Public Sub CreateYearCalendar(ByVal ps As PrintingSystem, ByVal year As Integer)
Dim gr As BrickGraphics = ps.Graph
ps.Begin()
Dim columnCount As Integer
Dim rowCount As Integer
Dim width As Integer = CInt(Fix(gr.ClientPageSize.Width)) - 1
Dim height As Integer = CInt(Fix(gr.ClientPageSize.Height)) - 1
Dim monthHorizontalPadding As Integer
Dim monthVerticalPadding As Integer = 24
If width > height Then
monthHorizontalPadding = 28
rowCount = 2
columnCount = 3
height = height / 4
width = width / 9 * 2
Else
monthHorizontalPadding = 40
columnCount = 2
rowCount = 3
width = Fix(width / 7) * 2
height = height / 5
End If
CreatePageFooter(gr)
gr.Modifier = BrickModifier.ReportHeader
gr.Font = New Font("Tahoma", 26.0F, FontStyle.Bold)
gr.StringFormat = New BrickStringFormat(StringAlignment.Center, StringAlignment.Center)
gr.BackColor = Color.Transparent
Dim brick As Brick = gr.DrawString(year.ToString() & " year", Color.FromArgb(41, 113, 182), New RectangleF(0.0F, 0.0F, gr.ClientPageSize.Width, height / 2.0F), BorderSide.None)
brick.Separable = True
gr.Modifier = BrickModifier.Detail
Dim month As Integer = 1
Dim daysPadding As New PaddingInfo(10, 10, 10, 10)
For row As Integer = 0 To rowCount
For column As Integer = 0 To columnCount
MonthPrint(gr, column * (width + monthHorizontalPadding), row * (height + monthVerticalPadding), height / 10 + daysPadding.Top - 1, (width - daysPadding.Left) \ daysOfWeek.Length, (height - daysPadding.Top) \ (WeeksInMonth + 3), month, year, 18.0F, 9.0F, "Tahoma", daysPadding)
month += 1
Next column
Next row
ps.End()
End Sub
Public Sub CreateMonthCalendar(ByVal ps As PrintingSystem, ByVal format As Integer, ByVal month As Integer, ByVal year As Integer)
Dim gr As BrickGraphics = ps.Graph
ps.Begin()
CreatePageFooter(gr)
Const LeftRightDaysPadding As Integer = 53
Const TopBottomDaysPadding As Integer = 35
Dim daysPadding As New PaddingInfo(LeftRightDaysPadding, LeftRightDaysPadding, TopBottomDaysPadding, TopBottomDaysPadding)
Dim leftCell As Integer = 0
Dim topRow As Integer = 0
Dim dayWidth As Integer = CInt(Fix(Math.Floor(CDbl(gr.ClientPageSize.Width - (daysPadding.Left + daysPadding.Right)) / week.Length)))
Dim dayHeight As Integer = 60
Dim daysFontSize As Single = 22.0F
Dim captionFontSize As Single = 36.0F
Select Case format
Case 1
dayWidth = dayWidth / 3 * 2
dayHeight = dayHeight / 3 * 2
daysFontSize = daysFontSize / 3 * 2
captionFontSize = captionFontSize / 3 * 2
leftCell = CInt(Fix(gr.ClientPageSize.Width / WeeksInMonth))
topRow = CInt(Fix(gr.ClientPageSize.Height / WeeksInMonth))
Case 2
dayWidth /= 2
dayHeight /= 2
daysFontSize /= 2
captionFontSize /= 2
leftCell = CInt(Fix(CDbl(gr.ClientPageSize.Width) / 4.0F))
topRow = CInt(Fix(CDbl(gr.ClientPageSize.Height) / 4.0F))
End Select
gr.Modifier = BrickModifier.Detail
MonthPrint(gr, leftCell, topRow, dayHeight + 5, dayWidth, dayHeight, month, year, captionFontSize, daysFontSize, "Tahoma", daysPadding)
ps.End()
End Sub
Private Function AllowWidth(ByVal gr As BrickGraphics, ByVal weekdays() As String, ByVal width As Integer) As Boolean
Dim result As Boolean = True
For Each s As String In weekdays
If gr.MeasureString(s).Width > width Then
result = False
End If
Next s
Return result
End Function
Private Sub CreatePageFooter(ByVal gr As BrickGraphics)
gr.Font = New Font("Tahoma", 8.0F, FontStyle.Underline)
gr.BackColor = Color.Transparent
gr.Modifier = BrickModifier.MarginalFooter
Dim r As New RectangleF(0, 0, 0, gr.Font.Height)
Dim brick As PageInfoBrick = gr.DrawPageInfo(PageInfo.None, "XtraPrinting Library by Developer Express Inc.", Color.Blue, r, BorderSide.None)
brick.Url = "http://devexpress.com/Products/NET/XtraPrinting/"
brick.Hint = brick.Url
brick.Alignment = BrickAlignment.Far
brick.AutoWidth = True
End Sub
Private Sub MonthPrint(ByVal gr As BrickGraphics, ByVal leftCell As Integer, ByVal topRow As Integer, ByVal daysHeight As Integer, ByVal dayWidth As Integer, ByVal dayHeight As Integer, ByVal month As Integer, ByVal year As Integer, ByVal monthNameFontSize As Single, ByVal daysFontSize As Single, ByVal fontName As String, ByVal dayPadding As PaddingInfo)
gr.BeginUnionRect()
Dim captionMonth As String = Thread.CurrentThread.CurrentCulture.DateTimeFormat.MonthNames(month - 1)
gr.Font = New Font(fontName, monthNameFontSize, FontStyle.Bold)
gr.StringFormat = New BrickStringFormat(StringAlignment.Far, StringAlignment.Center)
gr.BackColor = Color.FromArgb(71, 143, 212)
gr.BorderColor = Color.FromArgb(42, 114, 183)
gr.StringFormat = gr.StringFormat.ChangeAlignment(StringAlignment.Center)
Dim captionWidth As Integer = dayWidth * daysOfWeek.Length + dayPadding.Left + dayPadding.Right
Dim captionHeight As Integer = Math.Max(dayHeight * 2 - 14, gr.Font.Height)
gr.DrawString(captionMonth, Color.White, New RectangleF(leftCell, topRow, captionWidth, captionHeight), BorderSide.Top Or BorderSide.Right Or BorderSide.Left)
topRow += captionHeight
gr.Font = New Font(fontName, daysFontSize, FontStyle.Regular)
gr.StringFormat = gr.StringFormat.ChangeAlignment(StringAlignment.Center)
gr.BackColor = Color.White
Dim firstDayInWeek As DayOfWeek = New DateTime(year, month, 1).DayOfWeek
Dim daysInMonth As Integer = DateTime.DaysInMonth(year, month)
Dim allowWidth As Boolean = Me.AllowWidth(gr, daysOfWeek, dayWidth)
gr.BorderColor = Color.FromArgb(159, 159, 159)
gr.DrawRect(New RectangleF(leftCell, topRow, dayWidth * daysOfWeek.Length + dayPadding.Left + dayPadding.Right, daysHeight), BorderSide.Right Or BorderSide.Left Or BorderSide.Bottom, gr.BackColor, Color.FromArgb(159, 159, 159))
Dim weekDay As String = Nothing
Dim index As Integer = 0
For Each dayOfWeek As DayOfWeek In week
Dim i As Integer = CInt(Fix(dayOfWeek))
If (allowWidth) Then
weekDay = daysOfWeek(i)
Else
weekDay = shortDaysOfWeek(i).Substring(0, 2)
End If
If IsHoliday(dayOfWeek) Then
gr.DrawString(weekDay, Color.FromArgb(188, 0, 0), New RectangleF(leftCell + index * dayWidth + dayPadding.Left, topRow, dayWidth, daysHeight), BorderSide.None)
Else
gr.DrawString(weekDay, Color.FromArgb(42, 114, 183), New RectangleF(leftCell + index * dayWidth + dayPadding.Left, topRow, dayWidth, daysHeight), BorderSide.None)
End If
index += 1
Next dayOfWeek
topRow += daysHeight
gr.DrawRect(New RectangleF(leftCell, topRow, dayWidth * daysOfWeek.Length + dayPadding.Left + dayPadding.Right, dayHeight * WeeksInMonth + dayPadding.Top + dayPadding.Bottom), BorderSide.All, Color.FromArgb(255, 241, 219), Color.FromArgb(159, 159, 159))
gr.Font = New Font(fontName, daysFontSize)
Dim day As Integer = 1
Dim drawHorizontalLine As Boolean = True
For weekIndex As Integer = 0 To WeeksInMonth - 1
For Each dayOfWeek As DayOfWeek In week
Dim dayNumber As String = String.Empty
Dim hint As String = Nothing
gr.BackColor = Color.Transparent
gr.ForeColor = Color.Black
If drawHorizontalLine AndAlso day > daysInMonth AndAlso dayOfWeek = week(0) Then
drawHorizontalLine = False
End If
If Not (weekIndex = 0 AndAlso Array.IndexOf(week, dayOfWeek) < Array.IndexOf(week, firstDayInWeek)) AndAlso day <= daysInMonth Then
dayNumber = day.ToString()
Dim currentDate As New DateTime(year, month, day)
If currentDate.Equals(SelectedDate()) Then
gr.BackColor = Color.FromArgb(&H47, &H8F, &HD4)
gr.ForeColor = Color.White
drawHorizontalLine = True
ElseIf IsHoliday(dayOfWeek) Then
gr.ForeColor = Color.FromArgb(188, 0, 0)
End If
hint = currentDate.ToString("dddd, MMMM dd yyyy")
day += 1
End If
Dim borders As BorderSide
If weekIndex > 0 AndAlso drawHorizontalLine Then
borders = BorderSide.Top
Else
borders = BorderSide.None
End If
Dim dayBrick As TextBrick = gr.DrawString(dayNumber, gr.ForeColor, New RectangleF(leftCell + Array.IndexOf(week, dayOfWeek) * dayWidth + dayPadding.Left, topRow + dayHeight * weekIndex + dayPadding.Top, dayWidth, dayHeight), borders)
dayBrick.Hint = hint
dayBrick.BorderStyle = BrickBorderStyle.Outset
Next dayOfWeek
Next weekIndex
gr.EndUnionRect()
End Sub
End Class
End Namespace