'************************************************************************
'* Arkkimaagi's SS Calendar (v2.0)
'* Acalendar.vbs for SS 0.81a
'************************************************************************
'Change these values to your liking
ShortMonth = 99 ' How many chars of the month name is written
AlertRight = ")" ' The right side of todays date gets this char. (One Char is minimum)
AlertLeft = "(" ' The left sife of today date gets this char. (One Char is minimum)
NoAlertRight = " " ' The Right side of non todays date (One Char is minimum)
NoAlertLeft = " " ' The Left side of non todays date (One Char is minimum)
ZeroLetter = " " 'What letter to use as the leading Zero (One Char is minimum)
ZeroWeek = " " 'What letter to use as the leading Zero in week numbers (One Char is minimum)
ColorTitle = True 'Should TITLE name of current weekday be colored? (True/False)
ColorDate = True 'Should current day DATE be colored? (True/False)
ColorWDayNum = True 'Should the current weekday NUMBER be colored? (True/False)
'Select colors for different sections
'1 = weekday black
'2 = weeknumber&dayname white
'3 = sunday blue
'4 = today red
TodayDate = 4 'current day color (default is 4, red)
AlertColor = 4 'current day alert color (default is 4, red)
TodayWDNum = 4 'current week number color (default is 4, red)
TodayWDName = 4 'current day title color (default is 4, red)
'My weeks begin from Monday and I want Sunday to be blue
'So I chose 0 for all the others and 3 for seventh day
'If you'r weeks begin from Sunday and you want sundays to
'be blue, select 3 for for first day and 0 for all the rest.
Day1Color = 0 'Select 0 for default, 1-4 for other colors
Day2Color = 0 'Select 0 for default, 1-4 for other colors
Day3Color = 0 'Select 0 for default, 1-4 for other colors
Day4Color = 0 'Select 0 for default, 1-4 for other colors
Day5Color = 0 'Select 0 for default, 1-4 for other colors
Day6Color = 0 'Select 0 for default, 1-4 for other colors
Day7Color = 3 'Select 0 for default, 1-4 for other colors
' There is FOUR different casings for the text
' lower = low case of each char
' upper = UPPER CASE OF EACH CHAR
' firstup = Upper Case For The First Char In Each Word
' firstdown = lOWER cASE fOR tHE fIRST cHAR iN eACH wORD
casing = "firstup"
'************************************************************
'* Changes from version 1.0:
'*
' Total Rewrite for Serious Samurize. You really should use this
' script instead of 1.0
'************************************************************
'* Dont change anything below.
'*
dim Cd(52)
Cd(0) = 2 'first empty spot
Cd(1) = 2 'First weekday name
Cd(2) = 2
Cd(3) = 2
Cd(4) = 2
Cd(5) = 2
Cd(6) = 2
Cd(7) = 3 ' seventh weekday name
Cd(8) = 2 '1st week number
Cd(9) = 1
Cd(10) = 1
Cd(11) = 1
Cd(12) = 1
Cd(13) = 1
Cd(14) = 1
Cd(15) = 1
Cd(16) = 2 '2nd week number
Cd(17) = 1
Cd(18) = 1
Cd(19) = 1
Cd(20) = 1
Cd(21) = 1
Cd(22) = 1
Cd(23) = 1
Cd(24) = 2 '3d week number
Cd(25) = 1
Cd(26) = 1
Cd(27) = 1
Cd(28) = 1
Cd(29) = 1
Cd(30) = 1
Cd(31) = 1
Cd(32) = 2 '4th week number
Cd(33) = 1
Cd(34) = 1
Cd(35) = 1
Cd(36) = 1
Cd(37) = 1
Cd(38) = 1
Cd(39) = 1
Cd(40) = 2 '5th week number
Cd(41) = 1
Cd(42) = 1
Cd(43) = 1
Cd(44) = 1
Cd(45) = 1
Cd(46) = 1
Cd(47) = 1
Cd(48) = 2 '6th week number
Cd(49) = 1
Cd(50) = 1
Cd(51) = 1
'**************************************
'Coloring options end
'Actual code starts
If (Day1Color <> 0) Then
for counter = 1 to 6
temp = counter*8+1
Cd(temp)=Day1Color
next
End If
If (Day2Color <> 0) Then
for counter = 1 to 6
temp = counter*8+2
Cd(temp)=Day2Color
next
End If
If (Day3Color <> 0) Then
for counter = 1 to 5
temp = counter*8+3
Cd(temp)=Day3Color
next
End If
If (Day4Color <> 0) Then
for counter = 1 to 5
temp = counter*8+4
Cd(temp)=Day4Color
next
End If
If (Day5Color <> 0) Then
for counter = 1 to 5
temp = counter*8+5
Cd(temp)=Day5Color
next
End If
If (Day6Color <> 0) Then
for counter = 1 to 5
temp = counter*8+6
Cd(temp)=Day6Color
next
End If
If (Day7Color <> 0) Then
for counter = 1 to 5
temp = counter*8+7
Cd(temp)=Day7Color
next
' ShowColor=Cd(temp)&" "&temp
' exit function
End If
'Black
Function ShowColor1
ShowColor1 = ShowColor(1)
End Function
'White
Function ShowColor2
ShowColor2 = ShowColor(2)
End Function
'Blue
Function ShowColor3
ShowColor3 = ShowColor(3)
End Function
'Red
Function ShowColor4
ShowColor4 = ShowColor(4)
End Function
Function ShowMonth
Today = Now()
Month_ = Month(Today)
ShowMonth = ChangeCase(Left(MonthName(Month_),ShortMonth))
End Function
Function ShowYear
Today = Now()
ShowYear = Year(Today)
End Function
Function ShowColor(color)
Today = Now()
Year_ = Year(Today)
Month_ = Month(Today)
WeekNumber_ = DateDiff("ww", Year_&"-01-01",Today,0,0)+1
WeekDay_ = Weekday(Today, vbusesystem)
WeekDayName_ = Left(WeekDayName(WeekDay_), 2)
Day_ = Day(Today)
FirstWeekMonth_ = DateDiff("ww", Year_&"-01-01",Year_&"-"&Month_&"-01",0,0)+1
FirstDayWeek_ = Weekday(year_&"-"&Month_&"-01", vbusesystem)
daysInMonth_ = Day(DateSerial(Year(today), Month(today)+1, 0) )
' The Weeknumbers For The Weeks in Current Month
dim MW(6)
MW(1) = Right(ZeroWeek&FirstWeekMonth_, 2)
MW(2) = Right(ZeroWeek&FirstWeekMonth_+1, 2)
MW(3) = Right(ZeroWeek&FirstWeekMonth_+2, 2)
MW(4) = Right(ZeroWeek&FirstWeekMonth_+3, 2)
MW(5) = Right(ZeroWeek&FirstWeekMonth_+4, 2)
MW(6) = " "
If ( (daysInMonth_ > 29) AND (FirstDayWeek_ > 6) ) Then
MW(6) = Right(ZeroWeek&FirstWeekMonth_+5, 2)
ElseIf ( (daysInMonth_ > 30) AND (FirstDayWeek_ > 5) ) Then
MW(6) = Right(ZeroWeek&FirstWeekMonth_+5, 2)
End If
' The TITLE Names of Each WeekDay
dim WD(8)
WD(1) = ChangeCase(Left(WeekDayName(1, False, vbusesystem), 2))
WD(2) = ChangeCase(Left(WeekDayName(2, False, vbusesystem), 2))
WD(3) = ChangeCase(Left(WeekDayName(3, False, vbusesystem), 2))
WD(4) = ChangeCase(Left(WeekDayName(4, False, vbusesystem), 2))
WD(5) = ChangeCase(Left(WeekDayName(5, False, vbusesystem), 2))
WD(6) = ChangeCase(Left(WeekDayName(6, False, vbusesystem), 2))
WD(7) = ChangeCase(Left(WeekDayName(7, False, vbusesystem), 2))
'get date data
dim DP(37)
'Colored weeknumbers code
For counter = 0 to 5
temp = 8+counter*8
'If the weeknumbers are wanted colorized
If (Cd(temp) = color) Then
'but then its the today weekday, and the color does not match
If (((FirstWeekMonth_ + counter ) = WeekNumber_) AND (TodayWDNum <> color) AND (ColorWDayNum)) Then
temp = 1 + counter
MW(temp) = " "
End If
'now we do not want to color this number
Else
'unless its this week and color matches
If (((FirstWeekMonth_ + counter ) = WeekNumber_) AND (TodayWDNum = color) AND (ColorWDayNum)) Then
Else
temp = 1 + counter
MW(temp) = " "
End If
End If
Next
For counter = 1 to 7
'If the weekTitles are wanted colorized
If (Cd(counter) = color) Then
'but then its the today weekday, and the color does not match
If ((WeekDay_ = Counter) AND (TodayWDName <> color) AND ColorTitle) Then
WD(WeekDay_) = " "
End If
'now we do not want to color this title
Else
'unless its this week and color matches
If ((WeekDay_ = Counter) AND (TodayWDName = color) AND (ColorTitle)) Then
Else
WD(Counter) = " "
End If
End If
Next
dim AA(37)
temp = 1
for counter = 1 to 5
AA(temp)=8*counter+1
AA(temp+1)=8*counter+2
AA(temp+2)=8*counter+3
AA(temp+3)=8*counter+4
AA(temp+4)=8*counter+5
AA(temp+5)=8*counter+6
AA(temp+6)=8*counter+7
temp=temp+7
next
AA(36)=49
AA(37)=50
for counter = 1 to 37
aDate = counter - firstdayweek_ +1
On Error Resume Next
**** = DateValue(MonthName(Month_) & " " & aDate & ", " &Year_)
If err.number <> 0 Then
aDate = 0
End If
If aDate < 1 or aDate > 31 Then aDate = " "
If ((AlertColor = color) AND (Day_ = aDate)) Then
addLeft=AlertLeft
addRight=AlertRight
Else
addLeft=NoAlertLeft
addRight=NoAlertRight
End If
If (Cd(AA(counter)) = color) Then
temp = Right(ZeroLetter&aDate, 2)
'but then its today
If ((Day_ = aDate) AND (TodayDate <> color) AND ColorDate) Then
temp = " "
End If
Else
temp = " "
'but then its today
If ((Day_ = aDate) AND (TodayDate = color) AND ColorDate) Then
temp = Right(ZeroLetter&aDate, 2)
End If
End If
DP(counter) = addLeft & temp & addRight
next
' Saving the data in a format
nl = "%b"
z1 = " "
z2 = " "
'Formatting of the calendar
ret = z2& z2& WD(1) &z2& WD(2) &z2& WD(3) &z2& WD(4) &z2& WD(5) &z2& WD(6) &z2& WD(7) & nl
ret = ret & MW(1) &z1& DP(1) & DP(2) & DP(3) & DP(4) & DP(5) & DP(6) & DP(7) & nl
ret = ret & MW(2) &z1& DP(8) & DP(9) & DP(10) & DP(11) & DP(12) & DP(13) & DP(14) & nl
ret = ret & MW(3) &z1& DP(15) & DP(16) & DP(17) & DP(18) & DP(19) & DP(20) & DP(21) & nl
ret = ret & MW(4) &z1& DP(22) & DP(23) & DP(24) & DP(25) & DP(26) & DP(27) & DP(28) & nl
ret = ret & MW(5) &z1& DP(29) & DP(30) & DP(31) & DP(32) & DP(33) & DP(34) & DP(35) & nl
ret = ret & MW(6) &z1& DP(36) & DP(37)
ShowColor = ret
End Function
Function MoveItemHelp
w = " WT "
d = "[00]"
n = "WN "
nl = "%b"
z2 = " "
temp = " "&w&w&w&w&w&w&w&nl
temp = temp& n&d&d&d&d&d&d&d&nl
temp = temp& n&d&d&d&d&d&d&d&nl
temp = temp& n&d&d&d&d&d&d&d&nl
temp = temp& n&d&d&d&d&d&d&d&nl
temp = temp& n&d&d&d&d&d&d&d&nl
temp = temp& n&d&d
MoveItemHelp = temp
End Function
Function ChangeCase(Words)
ChangeCase = UCase(words) ' This changes the case to upper incase CASING is spelled wrong!
If casing = "lower" Then ChangeCase = LCase(words)
If casing = "upper" Then ChangeCase = UCase(words)
If casing = "firstup" Then ChangeCase = UCase(Mid(words,1,1)) & LCase(Mid(words,2,99))
If casing = "firstdown" Then ChangeCase = LCase(Mid(words,1,1)) & UCase(Mid(words,2,99))
End Function
