View Full Version : نمایش تاریخ روزانه در بالای فرم (شمسی)
سپهر-111
چهارشنبه 09 فروردین 1391, 13:40 عصر
سلام دوستان گل
من میخوام تاریخ روزانه رو در نرم افزار نشون بدم( البته نمیخوام تقویم کامل باشه)
تاریخ صحیح رو از سیستم بگیره و نیاز به تنظیم هم نداشته باشه
و فقط بنویسه : امروز : نهم فروردین ماه یک هزار سیصد نود یک
نمیخوام تنظیمات و چیز دیگه داشته باشه و میخوام ساده باشه
ممنون میشم اگه سورس در این باره برام بزارید
باتشکر از توجه شما
rezarko
چهارشنبه 09 فروردین 1391, 13:47 عصر
label1.caption=year(date) & month(date) & day(date)
یا علی
سپهر-111
چهارشنبه 09 فروردین 1391, 14:05 عصر
label1.caption=year(date) & month(date) & day(date)
یا علی
دوستان من میخوام تاریخ شمسی باشه و فارسی
و فقط بنویسه : امروز : نهم فروردین ماه یک هزار سیصد نود یک
تاریخ صحیح رو از سیستم بگیره و نیاز به تنظیم هم نداشته باشه
تشکر
ho3ein.3ven
چهارشنبه 09 فروردین 1391, 14:12 عصر
سلام
شما اول باید تاریخ شمسی رو حساب کنید . ماژول در این زمینه در سایت هست. بعد برای اینکه بنویسه هزار و سیصد و... باید از ماژول تبدیل عدد به حروف استفاده کنید. هر دو در سایت هست جستجو کنید.
سپهر-111
چهارشنبه 09 فروردین 1391, 14:46 عصر
سلام
شما اول باید تاریخ شمسی رو حساب کنید . ماژول در این زمینه در سایت هست. بعد برای اینکه بنویسه هزار و سیصد و... باید از ماژول تبدیل عدد به حروف استفاده کنید. هر دو در سایت هست جستجو کنید.
دوستان خیلی دنبالش گشتم
و چیزی که میخواستم پیدا نکردم
اکثر همراه با تقویم بود ولی من میخوام ساده باشه
تشکر
Mr'Jamshidy
چهارشنبه 09 فروردین 1391, 15:55 عصر
این تابع تاریخ میلادی میگیره شمسی بر میگردونه
البته یکم خر تو خره اما دقیقه و کار راه انداز
موفق باشید
Function PersianCalender() As Date
Dim DayDate As Long
DayDate = Year(Now) * 365
For i = 1 To Month(Now) - 1
Select Case i
Case 1
DayDate = DayDate + 31
Case 2
DayDate = DayDate + 28
Case 3
DayDate = DayDate + 31
Case 4
DayDate = DayDate + 30
Case 5
DayDate = DayDate + 31
Case 6
DayDate = DayDate + 30
Case 7
DayDate = DayDate + 31
Case 8
DayDate = DayDate + 31
Case 9
DayDate = DayDate + 30
Case 10
DayDate = DayDate + 31
Case 11
DayDate = DayDate + 30
Case 12
DayDate = DayDate + 31
End Select
Next
DayDate = DayDate + Day(Now)
DayDate = DayDate - 226713
Dim intYear, intMonth, intMTmp, intDay As Integer
intYear = Int(DayDate / 365)
intMTmp = Int(DayDate - (intYear * 365))
For i = 1 To 12
Select Case i
Case 1
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 2
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 3
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 4
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 5
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 6
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 7
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 8
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 9
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 10
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 11
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 12
If intMTmp > 29 Then
intMTmp = intMTmp - 29
intMonth = intMonth + 1
Else
Exit For
End If
End Select
Next
intDay = intMTmp
Dim Ret As Date
Ret = DateSerial(intYear, intMonth, intDay)
PersianCalender = Ret
End Function
SlowCode
چهارشنبه 09 فروردین 1391, 17:34 عصر
این کد مختصر شده کد آقای جمشیدیه:
Function PersianCalender() As Date
Dim DayDate As Long
DayDate = Year(Now) * 365
For i = 1 To Month(Now) - 1
Select Case i
Case 1,3,5,7,8,10,12
DayDate = DayDate + 31
Case 2
DayDate = DayDate + 28
Case 4,6,9,11
DayDate = DayDate + 30
End Select
Next
DayDate = DayDate + Day(Now)
DayDate = DayDate - 226713
Dim intYear, intMonth, intMTmp, intDay As Integer
intYear = Int(DayDate / 365)
intMTmp = Int(DayDate - (intYear * 365))
For i = 1 To 12
Select Case i
Case 1 to 11
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 12
If intMTmp > 29 Then
intMTmp = intMTmp - 29
intMonth = intMonth + 1
Else
Exit For
End If
End Select
Next
intDay = intMTmp
Dim Ret As Date
Ret = DateSerial(intYear, intMonth, intDay)
PersianCalender = Ret
End Function
سپهر-111
چهارشنبه 09 فروردین 1391, 17:36 عصر
این تابع تاریخ میلادی میگیره شمسی بر میگردونه
البته یکم خر تو خره اما دقیقه و کار راه انداز
موفق باشید
Function PersianCalender() As Date
Dim DayDate As Long
DayDate = Year(Now) * 365
For i = 1 To Month(Now) - 1
Select Case i
Case 1
DayDate = DayDate + 31
Case 2
DayDate = DayDate + 28
Case 3
DayDate = DayDate + 31
Case 4
DayDate = DayDate + 30
Case 5
DayDate = DayDate + 31
Case 6
DayDate = DayDate + 30
Case 7
DayDate = DayDate + 31
Case 8
DayDate = DayDate + 31
Case 9
DayDate = DayDate + 30
Case 10
DayDate = DayDate + 31
Case 11
DayDate = DayDate + 30
Case 12
DayDate = DayDate + 31
End Select
Next
DayDate = DayDate + Day(Now)
DayDate = DayDate - 226713
Dim intYear, intMonth, intMTmp, intDay As Integer
intYear = Int(DayDate / 365)
intMTmp = Int(DayDate - (intYear * 365))
For i = 1 To 12
Select Case i
Case 1
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 2
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 3
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 4
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 5
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 6
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 7
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 8
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 9
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 10
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 11
If intMTmp > 30 Then
intMTmp = intMTmp - 30
intMonth = intMonth + 1
Else
Exit For
End If
Case 12
If intMTmp > 29 Then
intMTmp = intMTmp - 29
intMonth = intMonth + 1
Else
Exit For
End If
End Select
Next
intDay = intMTmp
Dim Ret As Date
Ret = DateSerial(intYear, intMonth, intDay)
PersianCalender = Ret
End Function
سلام مستر جمشیدی
ممنون زحمت کشیدید
ولی یه تقویم پیدا کردم که به درد کارم میخوره
فقط مشکلی که داره میخوام وقتی تغییرات توی تقویم اعمال کردم ، تاریخ خود سیستم هم که به میلادی هست ، ابدیت بشه
که دفعه بعد که نرم افزار باز میشه تاریخ دست نشون بده(یعنی وقتی کابر از اینجا تاریخ درست میکنه این تنظیمات به میلای به خود سیستم هم اعمال بشه
نرم افزار گذاشتم لطفا یه نگاهی بندازید
باتشکر از توجه شما و دوستان گل
Mr'Jamshidy
چهارشنبه 09 فروردین 1391, 18:57 عصر
کد بالا رو که دوستمون هم مرتبش کرده رو اگر دقیقا برعکس کنی مشکلت حل میشه دوست من ولی سر فرصت یک فکری برات بر میدارم
الان واقعا وقت محدوده
Mr'Jamshidy
چهارشنبه 09 فروردین 1391, 19:00 عصر
این کد مختصر شده کد آقای جمشیدیه:
Function PersianCalender() As Date
Dim DayDate As Long
DayDate = Year(Now) * 365
For i = 1 To Month(Now) - 1
Select Case i
Case 1,3,5,7,8,10,12
DayDate = DayDate + 31
Case 2
DayDate = DayDate + 28
Case 4,6,9,11
DayDate = DayDate + 30
End Select
Next
DayDate = DayDate + Day(Now)
DayDate = DayDate - 226713
Dim intYear, intMonth, intMTmp, intDay As Integer
intYear = Int(DayDate / 365)
intMTmp = Int(DayDate - (intYear * 365))
For i = 1 To 12
Select Case i
Case 1 to 11
If intMTmp > 31 Then
intMTmp = intMTmp - 31
intMonth = intMonth + 1
Else
Exit For
End If
Case 12
If intMTmp > 29 Then
intMTmp = intMTmp - 29
intMonth = intMonth + 1
Else
Exit For
End If
End Select
Next
intDay = intMTmp
Dim Ret As Date
Ret = DateSerial(intYear, intMonth, intDay)
PersianCalender = Ret
End Function
ممنون دوست من این کد رو خیلی وقت پیش من نوشتم ولی خوب اون موقع بی تجربه بودم و کد رو زیادی طولانی کردم
ولی شما که مرتب کردی یک مقدار بهش آسیب زدی :متفکر:
خط 26 الی 44 رو یکم دقیق تر بررسی کن متوجه منظورم میشی
moghadam1372
یک شنبه 20 فروردین 1391, 14:37 عصر
با سلام
در این برنامه تمام تبدیل های تقویمی موجود است
vBulletin® v4.2.5, Copyright ©2000-1403, Jelsoft Enterprises Ltd.