این برنامه ازچهارتابع استفاده می کند که به شرح زیر است:
1- تابع DateShamsi: این تابع درواقع تابع اصلی برنامه است و می توانید هرجا که خواستید عمل تبدیل تاریخ میلادی به شمسی را انجام دهید این تابع را صدا بزنید.
2- تابع ValDayMiladi: این تابع به محاسبه کل روزهای سپری شده ازتاریخ میلادی تاحال می پردازد و نتیجه خودرا به تابع اصلی برنامه برمیگرداند.
3- تابع ValDaySal : این تابع ابتدا تعداد کل روزهای سپری شده ازتاریخ شمسی را ازورودی دریافت می کند سپس به محاسبه سال شمسی می پردازد وبرای محاسبه ماه وروز تاریخ شمسی از تابع TarikhShamsi کمک می گیرد سپس نتیجه کار که همان تاریخ شمسی است را به تابع اصلی برنامه تحویل می دهد.
4- تابع TarikhShamsi : این تابع به محاسبه ماه و روز تاریخ شمسی می پردازد.
حال برنامه در VB.NET به صورت زیر است:
این برنامه ازچهارتابع استفاده می کند که به شرح زیر است:
1- تابع DateShamsi: این تابع درواقع تابع اصلی برنامه است و می توانید هرجا که خواستید عمل تبدیل تاریخ میلادی به شمسی را انجام دهید این تابع را صدا بزنید.
2- تابع ValDayMiladi: این تابع به محاسبه کل روزهای سپری شده ازتاریخ میلادی تاحال می پردازد و نتیجه خودرا به تابع اصلی برنامه برمیگرداند.
3- تابع ValDaySal : این تابع ابتدا تعداد کل روزهای سپری شده ازتاریخ شمسی را ازورودی دریافت می کند سپس به محاسبه سال شمسی می پردازد وبرای محاسبه ماه وروز تاریخ شمسی از تابع TarikhShamsi کمک می گیرد سپس نتیجه کار که همان تاریخ شمسی است را به تابع اصلی برنامه تحویل می دهد.
4- تابع TarikhShamsi : این تابع به محاسبه ماه و روز تاریخ شمسی می پردازد.
حال برنامه در VB.NET به صورت زیر است:
Private Function DateShamsi() As String
Dim T As Int32
Dim S As String
T = ValDayMiladi()
S = ValDaySal(T - 226900)
DateShamsi = S
End Function
Private Function ValDayMiladi() As Int32
Dim x(2) As Int16
Dim v() As Byte = {31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30}
Dim i As Byte
Dim Sum As Int32
Sum = 0
x(0) = Convert.ToInt16(Now.Year)
x(1) = Convert.ToInt16(Now.Month)
x(2) = Convert.ToInt16(Now.Day)
If x(1) = 1 Then
Sum = x(2)
x(2) = 0
Else
For i = 0 To x(1) - 2
Sum = Sum + v(i)
Next
End If
ValDayMiladi = x(0) * 365 + x(0) \ 4 + 1 + Sum + x(2)
End Function
Private Function ValDaySal(ByVal Digit As Int32) As String
Dim x, y, z As Int32
Dim a As Int16
Dim str As String
x = Digit
y = (4 * x) \ ((4 * 365) + 1)
z = (y * 365) + (y \ 4)
a = x - z
str = TarikhShamsi(a)
If a = 0 Then
y = y - 1
End If
ValDaySal = y.ToString & "/" & str
End Function
Private Function TarikhShamsi(ByVal b As Int16) As String
Dim v() As Int16 = {31, 62, 93, 124, 155, 186, 216, 246, 276, 306, 336, 365}
Dim Mon, Day As Int16
Dim i As Int16
If b = 366 Or b = 0 Then
Mon = 12
Day = 30
Else
Mon = 1
Day = b
For i = 10 To 0 Step -1
If b > v(i) Then
If b <> v(i + 1) Then
Mon = i + 2
Day = b - v(i)
Exit For
Else
Mon = i + 2
Day = v(i + 1) - v(i)
Exit For
End If
End If
Next
End If
TarikhShamsi = Mon.ToString & "/" & Day.ToString
End Function
حال برای آنکه یک مثال ازبرنامه راببینید یک جعبه متن ویک کنترل Button به برنامه اضافه کنید ودر قسمت رویداد کلیک کنترل باتن دستورات زیر را بنویسید.
Dim str1 As String
str1 = DateShamsi()
TextBox1.Text = str1
حال برنامه رااجراکنید و کنترل باتن را کلیک کنید تا تاریخ شمسی نمایش داده شود.
بسیار بسیار متشکرم . من مدتها بود که دنبال این کد می گشتم . امید وارم همیشه در زندگی موفق باشید .
حجتی پرست (زنجان)
سلام
ممنون از شما خیلی کمکم کرد
سلام
ممنون از کد خوبتون!
ولی من خیلی سخت تر از این تصورش می کردم.
کامل و درست کار می کنه؟سال کبیسه رو هم در نظر می گیره؟
ممنون
سلام
وبلاگ جالبی دارید مطالبتون عالیه خیلی کمک کرد
موفق باشید
سلام.
انصافاْ کد خیلی خیلی خوبی تهیه کردید.برای سایتم ازش استفاده کردم.
با شما آرزوی موفقیت برای شما.
سلام . ممنون از لطفت . امیدوارم موفق باشی
واقعاً ممنونم خیلی لطف کردی اینو جدی میگم. واقعاً مرسی
سلام. ممنون از برنامتون !!!!! ولی مشکی عمده ای که داره ، این است که در مورد ماه تا ماه آذر را قبول نمیکند جون به صورت پیش فرض قسمت ماه تک رقمی منظور شده !!! ممنون میشم کمک کنید
میتونست خیلی کاملتر باشه.مثلا روزهای هفته رو به فارسی بنویسه .
ولی در کل دستتون درد نکنه .خیلی عالیه.موفق باشید
عالیه مرسی
اما یه مشکل داره توی ماه آذر و دی و بهمن و اصفند یک روز جلوتری
unit MiladiAndShamsi;
interface
uses
SysUtils;
const
def_sal=0.23984771573604060913705583756345;
Function Miladi_To_Shamsi(MiladiX:TDateTime): String;
Function Shamsi_To_Miladi(ShamsiX:string): TDateTime;
implementation
function IToSLen(Value, Len: Integer): String;
var
str:string;
begin
str:=IntToStr(Value);
while Length(str)<len do str:='0'+str;
Result:=str;
end;
Function Miladi_To_Shamsi(MiladiX:TDateTime): String;
var
sumday: Integer;
Year, Month, Day: Word;
begin
sumday:=Trunc(MiladiX)+466696;
Year:=Trunc(sumday / (365+def_sal))+1;
sumday:= sumday-((Year-1)*365)-Round((Year-1)*def_sal);
if sumday>186 then Month:=Trunc((sumday-186) div 30)+6+1
else Month:=Trunc(sumday div 31)+1;
if Month>7 then sumday:= sumday-((Month-6-1)*30)-186
else sumday:= sumday-((Month-1)*31);
Day:=sumday;
Result:=IToSLen(Year,4)+'/'+IToSLen(Month,2)+'/'+IToSLen(Day,2);
end;
Function Shamsi_To_Miladi(ShamsiX:string): TDateTime;
var
sumday: Integer;
Year, Month, Day: Word;
begin
Year:=StrToIntDef(Copy(ShamsiX,1,4),0);
Month:=StrToIntDef(Copy(ShamsiX,6,2),0);
Day:=StrToIntDef(Copy(ShamsiX,9,2),0);
sumday:=((Month-1)*30)+Day;
if Month>6 then sumday:=sumday+6
else sumday:=sumday+Month-1;
sumday:=sumday+((Year-1)*365)+Round((Year-1)*def_sal)-466696;
Result:=sumday;
end;
end.
سلام.
ایول دمت گرم خیلی جالب بود. خیلی بدردم خورد. مرسی
لینکت کردم
آقا ممنون
بسیار ممنون عالی بود
خیلی کاربردی بود ممنون
سلام ممنون از لطفتون
من میخوام دو تا تاریخ بگیرم بعد مدتشو محاسبه کنم.کمکم میکنی؟