daneshjo

<body>

<!-- ONE STEP TO INSTALL MONTHLY: DAY HIGHLIGHTED:

1. Put the code into the BODY of your HTML document -->

<html>

<body>

</script>
</center>

</body>

</html>

</body>

<head> 
<meta name="link" content="http://footofan.net" <META 
content="FrontPage.Editor.Document" name=ProgId> <meta 
http-equiv="Content-Type" content="text/html; 
charset=utf-8"></HEAD> <TITLE>تاريخ هجري 
شمسي</TITLE> <SCRIPT LANGUAGE=JAVASCRIPT> function 
showdate() { week= new Array("يكشنبه","دوشنبه","سه 
شنبه","چهارشنبه","پنج شنبه","جمعه","شنبه") months = new 
Array("فروردين","ارديبهشت","خرداد","تير","مرداد","شهريور","مهر","آبان","آذر","دي","بهمن","اسفند"); 
a = new Date(); d= a.getDay(); day= a.getDate(); month = 
a.getMonth()+1; year= a.getYear(); if (year== 0){year=2000;} if 
(year<100){year +=1900;} y=1; for(i=0;i<3000;i+=4) { if (year==i) 
{y=2;} } for(i=1;i<3000;i+=4) { if (year==i) {y=3;} } if (y==1) { 
year -= ( (month < 3) || ((month == 3) && (day < 21)) )? 
622:621; switch (month) { case 1: (day<21)? (month=10, 
day+=10):(month=11, day-=20); break; case 2: (day<20)? (month=11, 
day+=11):(month=12, day-=19); break; case 3: (day<21)? (month=12, 
day+=9):(month=1, day-=20); break; case 4: (day<21)? (month=1, 
day+=11):(month=2, day-=20); break; case 5: case 6: (day<22)? 
(month-=3, day+=10):(month-=2, day-=21); break; case 7: case 8: case 9: 
(day<23)? (month-=3, day+=9):(month-=2, day-=22); break; case 
10:(day<23)? (month=7, day+=8):(month=8, day-=22); break; case 11: 
case 12:(day<22)? (month-=3, day+=9):(month-=2, day-=21); break; 
default: break; } } if (y==2) { year -= ( (month < 3) || ((month == 
3) && (day < 20)) )? 622:621; switch (month) { case 1: 
(day<21)? (month=10, day+=10):(month=11, day-=20); break; case 2: 
(day<20)? (month=11, day+=11):(month=12, day-=19); break; case 3: 
(day<20)? (month=12, day+=10):(month=1, day-=19); break; case 4: 
(day<20)? (month=1, day+=12):(month=2, day-=19); break; case 5: 
(day<21)? (month=2, day+=11):(month=3, day-=20); break; case 6: 
(day<21)? (month=3, day+=11):(month=4, day-=20); break; case 7: 
(day<22)? (month=4, day+=10):(month=5, day-=21); break; case 8: 
(day<22)? (month=5, day+=10):(month=6, day-=21); break; case 9: 
(day<22)? (month=6, day+=10):(month=7, day-=21); break; case 
10:(day<22)? (month=7, day+=9):(month=8, day-=21); break; case 
11:(day<21)? (month=8, day+=10):(month=9, day-=20); break; case 
12:(day<21)? (month=9, day+=10):(month=10, day-=20); break; default: 
break; } } if (y==3) { year -= ( (month < 3) || ((month == 3) 
&& (day < 21)) )? 622:621; switch (month) { case 1: 
(day<20)? (month=10, day+=11):(month=11, day-=19); break; case 2: 
(day<19)? (month=11, day+=12):(month=12, day-=18); break; case 3: 
(day<21)? (month=12, day+=10):(month=1, day-=20); break; case 4: 
(day<21)? (month=1, day+=11):(month=2, day-=20); break; case 5: case 
6: (day<22)? (month-=3, day+=10):(month-=2, day-=21); break; case 7: 
case 8: case 9: (day<23)? (month-=3, day+=9):(month-=2, day-=22); 
break; case 10:(day<23)? (month=7, day+=8):(month=8, day-=22); 
break; case 11: case 12:(day<22)? (month-=3, day+=9):(month-=2, 
day-=21); break; default: break; } } document.write(week[d]+" "+day+" 
"+months[month-1]+" "+ year); } </SCRIPT> </HEAD> 
<BODY> TABLE align="center"><TR><TD> <FONT 
face=tahoma size="2" color="#000000"> 
<SCRIPT>showdate()</SCRIPT> </FONT> 
</TD></TR></TABLE> </BODY> </HTML>java 
script by<a href="http://footofan.net" target="_blank" 
>:HGS.BLOGFA.COM</a></span></div></td>

تاریخ شمسی در دلفی :

function shamsi(tt:tdatetime):string; var str,y,m,d:string; yi,mi,di:integer; begin str:=datetostr(tt); y:=copy(str,1,4); m:=copy(str,6,2); d:=copy(str,9,2); yi:=strtoint(y); mi:=strtoint(m); di:=strtoint(d); if (yi mod 4=0) then if mi>2 then begin tt:=tt+1; str:=datetostr(tt); y:=copy(str,1,4); m:=copy(str,6,2); d:=copy(str,9,2); yi:=strtoint(y); mi:=strtoint(m); di:=strtoint(d); end; if ((mi<3) or ((mi=3) and (di<21))) then begin yi:=yi-622; end else begin yi:=yi-621; end; case mi of 1: if di<21 then begin mi:=10; di:=di+10; end else begin mi:=11; di:=di+10; end; 2: if di<20 then begin mi:=11; di:=di+11; end else begin mi:=12; di:=di-19; end; 3: if di<21 then begin mi:=12; di:=di+9; end else begin mi:=1; di:=di-20; end; 4: if di<21 then begin mi:=1; di:=di+11; end else begin mi:=2; di:=di-20; end; 5: if di<22 then begin mi:=mi-3; di:=di+10; end else begin mi:=mi-2; di:=di-21; end; 6: if di<22 then begin mi:=mi-3; di:=di+10; end else begin mi:=mi-2; di:=di-21; end; 7: if di<23 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-22; end; 8: if di<23 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-22; end; 9: if di<23 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-22; end; 10: if di<23 then begin mi:=7; di:=di+8; end else begin mi:=8; di:=di-22; end; 11: if di<22 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-21; end; 12: if di<22 then begin mi:=mi-3; di:=di+9; end else begin mi:=mi-2; di:=di-21; end; end; y:=inttostr(yi); m:=inttostr(mi); if (length(m)=1) then m:='0'+m; d:=inttostr(di); if length(d)=1 then d:='0'+d; shamsi:=y+'/'+m+'/'+d end;

تاریخ شمسی در ویژوال بیسیک

Option Explicit Dim MESHAMSI As New ShamsiDate Private Sub cmdComp_2Date_Click() Dim Result As Integer If InStr(1, txtComp_Date1.Text, "?") > 0 Or InStr(1, txtComp_Date2.Text, "?") > 0 Then Exit Sub Call MESHAMSI.DateCompare(txtComp_Date1.Text, txtComp_Date2.Text, Result) Select Case Result Case Is = 0 lblComp_2Date.Caption = "=" Case Is = -1 lblComp_2Date.Caption = ">" Case Is = 1 lblComp_2Date.Caption = "<" End Select End Sub Private Sub cmdComp_3Date_Click() Dim Result As Boolean If InStr(1, txtComp_Date31.Text, "?") > 0 Or InStr(1, txtComp_Date33.Text, "?") > 0 _ Or InStr(1, txtComp_Date33.Text, "?") > 0 Then Exit Sub Call MESHAMSI.DateBetween(txtComp_Date31.Text, txtComp_Date33.Text, txtComp_Date32.Text, Result) MsgBox Result End Sub Private Sub cmdConvert_Date_Click() If InStr(1, txtCon_Date_I.Text, "?") > 0 Then Exit Sub If optShamsi.Value = True Then txtCon_Date_O.Text = MESHAMSI.Convert_Date(txtCon_Date_I.Text, Gregorian_, HijriShamsi_) Else txtCon_Date_O.Text = MESHAMSI.Convert_Date(txtCon_Date_I.Text, HijriShamsi_, Gregorian_) End If End Sub Private Sub cmdConvert_Letter_Click() Dim Result As String If InStr(1, txtCon_Date2Letter_I.Text, "?") > 0 Then Exit Sub Call MESHAMSI.Convert_Date2Letter(txtCon_Date2Letter_I.Text, Result) lblCon_Date2Letter_O.Caption = Result End Sub Private Sub cmdConvert_Month_Click() If InStr(1, txtCon_Month_I.Text, "?") > 0 Then Exit Sub txtCon_Month_O.Text = MESHAMSI.Convert_Month2Letter(Val(txtCon_Month_I.Text)) End Sub Private Sub cmdConvert_Num_Click() Dim Result As String If IsNumeric(txtCon_Num2Letter_I.Text) = False Then Exit Sub Call MESHAMSI.Convert_Number2Letter(txtCon_Num2Letter_I.Text, Result) lblCon_Num2Letter_O.Caption = Result End Sub Private Sub cmdDec_Click() If IsNumeric(txtJump.Text) = False Then txtJump.Text = "1" If Val(txtJump.Text) = 1 Then txtIncDec.Text = MESHAMSI.DecreaseDate(txtIncDec.Text) Else txtIncDec.Text = MESHAMSI.DecreaseDate_Custom(txtIncDec.Text, Val(txtJump.Text)) End If End Sub Private Sub cmdDiff_Click() If InStr(1, txtDiff_Date1.Text, "?") > 0 Or InStr(1, txtDiff_Date1.Text, "?") > 0 Then Exit Sub lblDay.Caption = MESHAMSI.DateDiffShamsi(txtDiff_Date1.Text, txtDiff_Date2.Text, O_Day) lblHour.Caption = MESHAMSI.DateDiffShamsi(txtDiff_Date1.Text, txtDiff_Date2.Text, O_Hour) lblMinute.Caption = MESHAMSI.DateDiffShamsi(txtDiff_Date1.Text, txtDiff_Date2.Text, O_Minute) lblMonth.Caption = MESHAMSI.DateDiffShamsi(txtDiff_Date1.Text, txtDiff_Date2.Text, O_Month) lblSecond.Caption = MESHAMSI.DateDiffShamsi(txtDiff_Date1.Text, txtDiff_Date2.Text, O_Second) lblWeek.Caption = MESHAMSI.DateDiffShamsi(txtDiff_Date1.Text, txtDiff_Date2.Text, O_Week) lblYear.Caption = MESHAMSI.DateDiffShamsi(txtDiff_Date1.Text, txtDiff_Date2.Text, O_Year) End Sub Private Sub cmdGetDetails_Click() Dim S As String, E As String Dim Y As Long, M As Long, D As Long If InStr(1, txtDateWeek.Text, "?") > 0 Then Exit Sub If MESHAMSI.IsValidDate(txtDateWeek.Text) = False Then lblValid.Caption = "ÛáØ" Exit Sub End If lblValid.Caption = "ÏÑÓÊ" Call MESHAMSI.Get_Week(txtDateWeek.Text, S, E) txtDateWeek1.Text = S txtDateWeek2.Text = E txtWeekDay.Text = MESHAMSI.Get_DayOfWeek(txtDateWeek.Text) Call MESHAMSI.Split_Date(txtDateWeek.Text, "/", Y, M, D) txtY.Text = Y: txtM.Text = M: txtD.Text = D End Sub Private Sub cmdInc_Click() If InStr(1, txtIncDec.Text, "?") > 0 Then Exit Sub If IsNumeric(txtJump.Text) = False Then txtJump.Text = "1" If Val(txtJump.Text) = 1 Then txtIncDec.Text = MESHAMSI.IncreaseDate(txtIncDec.Text) Else txtIncDec.Text = MESHAMSI.IncreaseDate_Custom(txtIncDec.Text, Val(txtJump.Text)) End If End Sub Private Sub cmdTools_Click() Dim Cur1 As String, Cur2 As String Dim Pre1 As String, Pre2 As String Dim Y As Long, M As Long, D As Long Call MESHAMSI.Get_CurrentMonth(Cur1, Cur2) txtCurMon1.Text = Cur1: txtCurMon2.Text = Cur2 Call MESHAMSI.Get_PreviousMonth(Pre1, Pre2) txtPreMon1.Text = Pre1: txtPreMon2.Text = Pre2 Call MESHAMSI.Get_CurrentWeek(Cur1, Cur2) txtCurWeek1.Text = Cur1: txtCurWeek2.Text = Cur2 Call MESHAMSI.Get_CurrentYear(Cur1, Cur2) txtCurYear1.Text = Cur1: txtCurYear2.Text = Cur2 txtCurYearLength.Text = MESHAMSI.Get_CurrentYearLength() Call MESHAMSI.Get_PreviousYear(Pre1, Pre2) txtPreYear1.Text = Pre1: txtPreYear2.Text = Pre2 Call MESHAMSI.Get_CurrentYearMonthDay(Y, M, D) txtCur_Year.Text = Y: txtCur_Month.Text = M: txtCur_Day.Text = D txtFirstMD.Text = MESHAMSI.Get_First_DayOfCurrentMonth() txtFirstWD.Text = MESHAMSI.Get_First_DayOfCurrentWeek End Sub Private Sub Form_Load() Dim Tod As String Tod = MESHAMSI.Today lblToday.Caption = "ÇãÑæÒ " & Tod txtCon_Date_I.Text = Tod txtCon_Month_I.Text = "01" txtCon_Date2Letter_I.Text = Tod txtIncDec.Text = Tod txtDateWeek.Text = Tod txtComp_Date1.Text = Tod txtComp_Date2.Text = Tod txtComp_Date31.Text = Tod txtComp_Date32.Text = Tod txtComp_Date33.Text = Tod txtDiff_Date1.Text = Tod txtDiff_Date2.Text = MESHAMSI.IncreaseDate(Tod) '//======== Call cmdConvert_Date_Click Call cmdConvert_Month_Click Call cmdConvert_Letter_Click Call cmdConvert_Num_Click Call cmdTools_Click Call cmdGetDetails_Click Call cmdComp_2Date_Click Call cmdDiff_Click End Sub