Class HebrewProfile

	Public Function GregorianToHebrew(strGregorianDate,blnWithDayInWeek,blnFullYearFormat)   
		Dim dtmGregorian          
		Dim dtmDayOfNewHeadYear   
		Dim dtmDayOfHeadMonth 
		Dim dtmConGregorianInit    

		Dim intKindDiffDates        ' אם ההפרש בין התאריכים שלילי הערך של המשתנה יהיה 1- ואם לא: 1
		Dim intYearIncluded         ' אם ההפרש בין התאריכים שלילי הערך של המשתנה יהיה 1 ואם לא: 0
		Dim intYearInMachzor        ' השנה הנוכחית בתוך מחזור העיבור
		Dim intYearIndexInMachzor   ' האינדקס הנוכחי במערך שנות העיבור במחזור
		Dim intMonthIndex           ' האינדקס של החודש
		Dim intYearYuliyan        
		Dim intNumDayAddition     

		Dim intHebrewYear         
		Dim intDayOfLastHeadYear  
		Dim intDayOfNewHeadYear   
		Dim intNumDaysInLastYear  
		Dim intNumDaysInNewYear   
		Dim intNumDaysInThisYear  
		Dim intNumDaysInThisMonth 

		Dim lngYearsBetweenDates  
		Dim lngDaysBetweenYears   

		Dim sgnMoladDay
		Dim sgnConDaysInMonth
		Dim sgnConMoladDayInit            

		Dim strHebrewDayInWeek
		Dim strHebrewDay          
		Dim strHebrewMonth        
		Dim strHebrewYear         

		Dim vntYearsMeubarot      
		Dim vntDaysInMonth        
	 	 
		' עבור האיתחול נגדיר: 30/9/2000 <==> א' תשרי תשס"א
		Const conHebrewDayInWeekInit = 0	' שבת
		Const conHebrewDayInit       = 1
		Const conHebrewMonthInit		 = 1
		Const conHebrewYearInit			 = 5761

		dtmConGregorianInit = CDate("30/9/2000")
		sgnConMoladDayInit = 5 + 13 / 24 + 17 / 1440 + 4 / 25920 ' היום בשבוע למולד תשרי תשס"א

		' הגדרת קבועים הקשורים לכללים בלוח העברי
		sgnConDaysInMonth  = (29.5 + 793 / 25920)   ' אורך החודש העברי. שעה כוללת 1080 חלקים (=>יום=25920 חלקים)
			
		' Date dataType-בדיקת חוקיות התאריך. במידה והוא חוקי תתבצע המרה של המשתנה ל
		If IsDate(strGregorianDate) = True Then
			dtmGregorian = CDate(strGregorianDate)
			If dtmGregorian <= CDate("2/9/1752") Then
				dtmGregorian = CDate(dtmGregorian) + 11      ' מעבר ללוח היוליאני
				intYearYuliyan = 1700
				intNumDayAddition = 0
				Do While dtmGregorian < CDate("1/3/" & intYearYuliyan) + 11
					intNumDayAddition = intNumDayAddition + 1
					intYearYuliyan = intYearYuliyan - 100
				Loop
				dtmGregorian = CDate(dtmGregorian) - intNumDayAddition
			ElseIf CDate(dtmGregorian) > CDate("2/9/1752") And CDate(dtmGregorian) < CDate("14/9/1752") Then
				MsgBox "טווח התאריכים בין 3/9/1752 ו-13/9/1752 אינו קיים", vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading
				Exit Function
			End If
		Else
			If Len(strGregorianDate) > 0 Then MsgBox "המחרוזת אינה תבנית חוקית של תאריך", vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, "תבנית שגויה"
			Exit Function
		End If
	  
		' איתחול הגדרות נוספות הקשורות בשנה ובחודש העברי
		vntYearsMeubarot = Split("0;3;6;8;11;14;17", ";")   ' השנים המעוברות במחזור הלבנה
		vntDaysInMonth = Split("30;29;30;29;30;30;29;30;29;30;29;30;29", ";") ' אורך החודשים בשנה מעוברת של 384 יום

		' מולד חודש תשרי בשנים המתחמות את התאריך הנבחר
		If DateDiff("d", CDate(dtmConGregorianInit), CDate(dtmGregorian)) < 0 Then
			intKindDiffDates = -1
			intYearIncluded = 1
		Else
			intKindDiffDates = 1
			intYearIncluded = 0
		End If
		' הוספת ה-0.1 למקרה של תאריך החל מיד אחרי ראש השנה, שלפי חישוב השנים היה אמור לחול לפני
		lngYearsBetweenDates = Int(DateDiff("d", CDate(dtmConGregorianInit), CDate(dtmGregorian)) / 365.2422 + 0.1)
	  
		' מציאת השנה הקרובה במחזור שתהיה מעוברת
		intYearIndexInMachzor = 0
		Do
			If CInt(vntYearsMeubarot(intYearIndexInMachzor + intYearIncluded)) >= conHebrewYearInit Mod 19 Then Exit Do
			intYearIndexInMachzor = intYearIndexInMachzor + 1
		Loop

		lngDaysBetweenYears = 0
		intNumDaysInNewYear = 353
		intHebrewYear = conHebrewYearInit
		intDayOfNewHeadYear = conHebrewDayInWeekInit
		sgnMoladDay = sgnConMoladDayInit
	  
		For intHebrewYear = conHebrewYearInit To intHebrewYear + lngYearsBetweenDates Step intKindDiffDates
			intDayOfLastHeadYear = intDayOfNewHeadYear
			intNumDaysInLastYear = intNumDaysInNewYear
			If (intHebrewYear - intYearIncluded) Mod 19 = CInt(vntYearsMeubarot(intYearIndexInMachzor)) Then
				sgnMoladDay = sgnMoladDay + 13 * sgnConDaysInMonth * intKindDiffDates
				If intKindDiffDates = 1 Then
					intDayOfNewHeadYear = GetDayOfHebrewHeadYear(sgnMoladDay, True, False)
				Else
					intDayOfNewHeadYear = GetDayOfHebrewHeadYear(sgnMoladDay, False, True)
				End If
				intYearIndexInMachzor = intYearIndexInMachzor + intKindDiffDates
				If intYearIndexInMachzor < 0 Then intYearIndexInMachzor = 6
				If intYearIndexInMachzor = 7 Then intYearIndexInMachzor = 0
				intNumDaysInNewYear = 383 + ((intDayOfNewHeadYear - intDayOfLastHeadYear) * intKindDiffDates + 9) Mod 7
				lngDaysBetweenYears = lngDaysBetweenYears + intNumDaysInNewYear
			Else
				sgnMoladDay = sgnMoladDay + 12 * sgnConDaysInMonth * intKindDiffDates
				If intKindDiffDates = 1 Then
					intDayOfNewHeadYear = GetDayOfHebrewHeadYear(sgnMoladDay, False, (intHebrewYear + 1) Mod 19 = CInt(vntYearsMeubarot(intYearIndexInMachzor)))
				Else
					intDayOfNewHeadYear = GetDayOfHebrewHeadYear(sgnMoladDay, (intHebrewYear - 2) Mod 19 = CInt(vntYearsMeubarot(intYearIndexInMachzor)), False)
				End If
				intNumDaysInNewYear = 353 + ((intDayOfNewHeadYear - intDayOfLastHeadYear) * intKindDiffDates + 11) Mod 7
				lngDaysBetweenYears = lngDaysBetweenYears + intNumDaysInNewYear
			End If
		Next
	   
		dtmDayOfNewHeadYear = CDate(dtmConGregorianInit) + (lngDaysBetweenYears - intNumDaysInNewYear) * intKindDiffDates
		dtmDayOfHeadMonth = CDate(dtmDayOfNewHeadYear)
		If intKindDiffDates = 1 Then
			intNumDaysInThisYear = intNumDaysInNewYear
		Else
			intNumDaysInThisYear = intNumDaysInLastYear
		End If
	  
		If blnFullYearFormat <> True Then blnFullYearFormat = False
		If CDate(dtmGregorian) >= CDate(dtmDayOfNewHeadYear) Then
			intMonthIndex = 0
			Do
				intNumDaysInThisMonth = CInt(vntDaysInMonth(intMonthIndex))
				If intMonthIndex = 1 And intNumDaysInThisYear Mod 10 = 5 Then intNumDaysInThisMonth = 30   ' חודש חשון מלא
				If intMonthIndex = 2 And intNumDaysInThisYear Mod 10 = 3 Then intNumDaysInThisMonth = 29   ' חודש כסלו חסר
				If CDate(dtmGregorian) < CDate(dtmDayOfHeadMonth) + intNumDaysInThisMonth Then
					GregorianToHebrew = CHeberwDateFormat(DateDiff("d", CDate(dtmDayOfHeadMonth), CDate(dtmGregorian)) + 1, _
															intMonthIndex, _
															intHebrewYear - intKindDiffDates, _
															intNumDaysInThisYear >= 383, _
															blnFullYearFormat)
					Exit Do
				End If
				dtmDayOfHeadMonth = CDate(dtmDayOfHeadMonth) + intNumDaysInThisMonth
				intMonthIndex = intMonthIndex + 1
				If intNumDaysInThisYear <= 355 And intMonthIndex = 5 Then intMonthIndex = 6
			Loop
		Else
			intMonthIndex = 12
			Do
				dtmDayOfHeadMonth = CDate(dtmDayOfHeadMonth) - CInt(vntDaysInMonth(intMonthIndex))
				If CDate(dtmGregorian) >= CDate(dtmDayOfHeadMonth) Then
					GregorianToHebrew = CHeberwDateFormat(DateDiff("d", CDate(dtmDayOfHeadMonth), CDate(dtmGregorian)) + 1, _
															intMonthIndex, _
															intHebrewYear + 2 * (intYearIncluded - 1), _
															intNumDaysInThisYear >= 383, _
															blnFullYearFormat)
					Exit Do
				End If
				intMonthIndex = intMonthIndex - 1
			Loop
		End If
	  
		If blnWithDayInWeek = True Then
			Select Case (DateDiff("d",CDate(dtmConGregorianInit),CDate(dtmGregorian)) Mod 7 + 7 + strHebrewDayInWeek) Mod 7
				Case 0 : strHebrewDayInWeek = "שבת"
				Case 1 : strHebrewDayInWeek = "יום ראשון"
				Case 2 : strHebrewDayInWeek = "יום שני"
				Case 3 : strHebrewDayInWeek = "יום שלישי"
				Case 4 : strHebrewDayInWeek = "יום רביעי"
				Case 5 : strHebrewDayInWeek = "יום חמישי"
				Case 6 : strHebrewDayInWeek = "יום שישי"
			End Select
		Else
			strHebrewDayInWeek = ""
		End If

		GregorianToHebrew = strHebrewDayInWeek & " " & GregorianToHebrew
	End Function

'-----------------------------------------------------------------------------------------------------------------------
	Private Function GetDayOfHebrewHeadYear(sgnMoladDay,blnPrevYearMeuberet,blnNewYearMeuberet)	
		Dim sgnCon3_9_204
		Dim sgnCon2_15_589  
			                            
		sgnCon3_9_204 = 3 + 3 / 24 + 204 / 25920  ' כלל גטר"ד
		sgnCon2_15_589 = 2 + 9 / 24 + 589 / 25920  ' כלל בט"ו-תקפ"ט

		sgnMoladDay = sgnMoladDay - Int(sgnMoladDay) + Int(sgnMoladDay) Mod 7
		If sgnMoladDay < 0 Then sgnMoladDay = sgnMoladDay + 7

		If sgnMoladDay >= 0.5 And sgnMoladDay < 2.5 Then
			If sgnMoladDay > sgnCon2_15_589 And blnPrevYearMeuberet = True Then
				GetDayOfHebrewHeadYear = 3
			Else
				GetDayOfHebrewHeadYear = 2
			End If
		ElseIf sgnMoladDay >= 2.5 And sgnMoladDay < 3.5 Then
			If sgnMoladDay > sgnCon3_9_204 And blnNewYearMeuberet = False Then
				GetDayOfHebrewHeadYear = 5
			Else
				GetDayOfHebrewHeadYear = 3
			End If
		ElseIf sgnMoladDay >= 3.5 And sgnMoladDay < 5.5 Then
			GetDayOfHebrewHeadYear = 5
		Else
			GetDayOfHebrewHeadYear = 0
		End If
	End Function

'-----------------------------------------------------------------------------------------------------------------------
	Private Function CHeberwDateFormat(intDay,intMonth,intYear,blnMeuberet,blnFullYearFormat)
		Dim strDay      
		Dim strMonth    
		Dim strYear     

		Dim vntHebMonth 
			                        
		vntHebMonth = Split("תשרי;חשון;כסלו;טבת;שבט;אדר א';אדר ב';ניסן;אייר;סיון;תמוז;אב;אלול", ";")
		strMonth = vntHebMonth(intMonth)
		If blnMeuberet = False And intMonth = 6 Then strMonth = "אדר"

		strDay = ReverseGimatria(CLng(intDay), False)
		strYear = ReverseGimatria(CLng(intYear), blnFullYearFormat)

		CHeberwDateFormat = strDay & " " & strMonth & " " & strYear 
	End Function

'-----------------------------------------------------------------------------------------------------------------------
	Public Function ReverseGimatria(lngNumber,blnOver1000)
		Dim intDigitIndex 
		Dim intDigitValue 
		Dim strNumber        ' המרת המספר למחרוזת כדי שיהיה ניתן להתייחס לכל סיפרה בנפרד

		intDigitIndex = 0
		strNumber = CStr(lngNumber)
		ReverseGimatria = ""

		Do Until 10 ^ intDigitIndex > lngNumber
			If intDigitIndex = 3 And blnOver1000 = False Then Exit Do
			If intDigitIndex Mod 3 = 0 And intDigitIndex >= 3 Then ReverseGimatria = "'" & ReverseGimatria
			intDigitValue = CInt(Mid(strNumber, Len(strNumber) - intDigitIndex, 1))

			Select Case intDigitIndex Mod 3
				Case 0
					If intDigitValue > 0 Then _
						ReverseGimatria = Chr(223 + intDigitValue) & ReverseGimatria
				Case 1
					Select Case intDigitValue
						Case 1
							ReverseGimatria = "י" & ReverseGimatria
						Case 2
							ReverseGimatria = "כ" & ReverseGimatria
						Case 3
							ReverseGimatria = "ל" & ReverseGimatria
						Case 4
							ReverseGimatria = "מ" & ReverseGimatria
						Case 5
							ReverseGimatria = "נ" & ReverseGimatria
						Case 6
							ReverseGimatria = "ס" & ReverseGimatria
						Case 7
							ReverseGimatria = "ע" & ReverseGimatria
						Case 8
							ReverseGimatria = "פ" & ReverseGimatria
						Case 9
							ReverseGimatria = "צ" & ReverseGimatria
					End Select
				Case 2
					Select Case intDigitValue
						Case 1, 2, 3, 4
							ReverseGimatria = Chr(intDigitValue + 246) & ReverseGimatria
						Case 5, 6, 7, 8
							ReverseGimatria = "ת" & Chr(intDigitValue + 242) & ReverseGimatria
						Case 9
							ReverseGimatria = "תתק" & ReverseGimatria
					End Select
			End Select

			If intDigitIndex Mod 3 = 2 Or intDigitIndex = Len(strNumber) - 1 Then
				If intDigitIndex >= 3 Then
					If Len(Left(ReverseGimatria, InStr(1, ReverseGimatria, "'"))) > 2 Then _
						ReverseGimatria = Left(ReverseGimatria, InStr(1, ReverseGimatria, "'") - 2) & Chr(34) & _
										  Right(ReverseGimatria, Len(ReverseGimatria) - InStr(1, ReverseGimatria, "'") + 2)
				Else
					If Len(ReverseGimatria) >= 2 Then
						ReverseGimatria = Left(ReverseGimatria, Len(ReverseGimatria) - 1) & Chr(34) & Right(ReverseGimatria, 1)
					ElseIf Len(strNumber) <= 3 Or blnOver1000 = False Then
						ReverseGimatria = ReverseGimatria & "'"
					End If
				End If
			End If
			intDigitIndex = intDigitIndex + 1
		Loop

		ReverseGimatria = Replace(ReverseGimatria, "י" & Chr(34) & "ה", "ט" & Chr(34) & "ו")
		ReverseGimatria = Replace(ReverseGimatria, "י" & Chr(34) & "ו", "ט" & Chr(34) & "ז")
	End Function
	
'-----------------------------------------------------------------------------------------------------------------------
	Public Sub ConvertLCaseToHebrew(evnt,rejectDigits)
		pConvertToHebrew evnt,rejectDigits,true
	End Sub

	Public Sub ConvertToHebrew(evnt,rejectDigits)
		pConvertToHebrew evnt,rejectDigits,false
	End Sub
'-----------------------------------------------------------------------------------------------------------------------

	Public Sub pConvertToHebrew(evnt,rejectDigits,lcaseOnly)
		dim sChr
		
 		if evnt.keyCode>=48 and evnt.keyCode<=57 and lcase(cstr(rejectDigits))="true" then
			evnt.returnValue=false
			exit sub
		end if

		sChr=chrW(evnt.keyCode)
		if lcaseOnly=false then sChr=lcase(sChr)
		
		Select Case sChr
			case "t"  
				evnt.keyCode=1488
			case "c"  
				evnt.keyCode=1489
			case "d"  
				evnt.keyCode=1490
			case "s"  
				evnt.keyCode=1491
			case "v"  
				evnt.keyCode=1492
			case "u"  
				evnt.keyCode=1493
			case "z"  
				evnt.keyCode=1494
			case "j"   
				evnt.keyCode=1495
			case "y"  
				evnt.keyCode=1496
			case "h"  
				evnt.keyCode=1497
			case "l"  
				evnt.keyCode=1498
			case "f"  
				evnt.keyCode=1499
			case "k"  
				evnt.keyCode=1500
			case "o"  
				evnt.keyCode=1501
			case "n"  
				evnt.keyCode=1502
			case "i"  
				evnt.keyCode=1503
			case "b"  
				evnt.keyCode=1504
			case "x"  
				evnt.keyCode=1505
			case "g"  
				evnt.keyCode=1506
			case ";" 
				evnt.keyCode=1507
			case "p" 
				evnt.keyCode=1508
			case "." 
				evnt.keyCode=1509
			case "m"  
				evnt.keyCode=1510
			case "e"  
				evnt.keyCode=1511
			case "r"  
				evnt.keyCode=1512
			case "a"  
				evnt.keyCode=1513
			case ","  
				evnt.keyCode=1514
			case "w"
				evnt.keyCode=39
			case "'"
				evnt.keyCode=44
			case "/"
				evnt.keyCode=46
			case "q"
				evnt.keyCode=47
		End Select
	End Sub
	
'-----------------------------------------------------------------------------------------------------------------------
	Public Sub ConvertToEnglish(evnt,rejectDigits)
 		if evnt.keyCode>=48 and evnt.keyCode<=57 and lcase(cstr(rejectDigits))="true" then
			evnt.returnValue=false
			exit sub
		end if

		Select Case lcase(chrW(evnt.keyCode))
			case "ש"  
				evnt.keyCode=97
			case "נ"  
				evnt.keyCode=98
			case "ב"  
				evnt.keyCode=99
			case "ג"  
				evnt.keyCode=100
			case "ק"  
				evnt.keyCode=101
			case "כ"  
				evnt.keyCode=102
			case "ע"  
				evnt.keyCode=103
			case "י"   
				evnt.keyCode=104
			case "ן"  
				evnt.keyCode=105
			case "ח"  
				evnt.keyCode=106
			case "ל"  
				evnt.keyCode=107
			case "ך"  
				evnt.keyCode=108
			case "צ"  
				evnt.keyCode=109
			case "מ"  
				evnt.keyCode=110
			case "ם"  
				evnt.keyCode=111
			case "פ"  
				evnt.keyCode=112
			case "/"  
				evnt.keyCode=113
			case "ר"  
				evnt.keyCode=114
			case "ד"  
				evnt.keyCode=115
			case "א" 
				evnt.keyCode=116
			case "ו" 
				evnt.keyCode=117
			case "ה" 
				evnt.keyCode=118
			case "'"  
				evnt.keyCode=119
			case "ס"  
				evnt.keyCode=120
			case "ט"  
				evnt.keyCode=121
			case "ז"  
				evnt.keyCode=122
			case "ת"  
				evnt.keyCode=60
			case "ץ"
				evnt.keyCode=62
			case "."
				evnt.keyCode=63
			case "ף"
				evnt.keyCode=59
			case ","
				evnt.keyCode=39
		End Select
	End Sub

End Class