کدی میخوام که تاریخ رو در برنامه به صورت شمسی نمایش بده

کدی میخوام که تاریخ رو در برنامه به صورت شمسی نمایش بده

ممنون از راهنماییتون .

ببین مهندس هادی این یک تابع است که در قسمت جنرال کپی می کنید

کد:

---

Function TarikhShamsi(Optional date1 As String, Optional SmallDate1 As Boolean) As String

---

.این هم کد

کد:

---

  Dim D, p, w, Mon, Mm, Ym, u, v, rp, X, I, YS, MS, Dm, P1, D1, DS, DateShamsi
      D = Array(20, 19, 20, 20, 21, 21, 22, 22, 22, 22, 21, 21)
      p = Array(11, 12, 10, 12, 11, 11, 10, 10, 10, 9, 10, 10)
      w = Array("íßÔäÈå", "ÏæÔäÈå", "Óå ÔäÈå", "åÇÑÔäÈå", "äÌÔäÈå", "ÌãÚå", "ÔäÈå")
     
      If SmallDate1 = True Then
            Mon = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")
      Else
            Mon = Array("ÝÑæÑÏíä", "ÇÑÏíÈåÔÊ", "ÎÑÏÇÏ", "ÊíÑ", "ãÑÏÇÏ", "ÔåÑíæÑ", "ãåÑ", "ÂÈÇä", "ÂÐÑ", "Ïí", "Èåãä", "ÇÓÝäÏ")
      End If
     
      If date1 = "" Then date1 = Date
     
      Dm = Day(date1)
      Mm = Month(date1)
      Ym = Year(date1)
      u = 0
      rp = 0
      If (Ym Mod 4) = 0 Then u = 1
      If ((Ym Mod 100) = 0 And (Ym Mod 400) <> 0) Then u = 0
      YS = Ym - 622
      X = YS - 22
      X = X Mod 33
      If ((X Mod 4) = 0 And X <> 32) Then rp = 1
      I = Not (rp - 2) + Not (u - 2) * 2
      X = 0
      If (I = 0 And Mm = 3) Then X = 1
      If I = 0 Then I = 3
      MS = (9 + Mm) Mod 13
      If MS < 10 Then MS = MS + 1
      D1 = D(Mm - 1)
      If (I = 1 And Mm > 2) Then D1 = D1 - 1
      If (I = 2 And Mm < 3) Then D1 = D1 - 1
      P1 = p(Mm - 1)
      If (I = 1 And Mm > 2) Then P1 = P1 + 1
      If (I = 2 And Mm < 4) Then P1 = P1 + 1
      If (Dm > 0 And Dm <= D1) Then
            DS = P1 + Dm + X - 1
          X = 1
      Else
          DS = Dm - D1
          MS = MS + 1
          If MS = 13 Then MS = 1
          X = 2
      End If
        If ((Mm = 3 And X = 2) Or Mm > 3) Then YS = YS + 1
      If SmallDate1 = True Then
'    ÇßÑ ÓÇá Èå ÕæÑÊ åÇÑ ßÇÑÇßÊÑí ãíÎæÇåíÏ ÎØ ÒíÑ ÑÇ ÇÒ ÍÇáÊ ßÇãäÊ ÏÑ ÂæÑíÏ
          TarikhShamsi = Trim(Str(YS)) + "/" + Trim(Mon(MS - 1)) + "/" + Trim(Str(DS))
            TarikhShamsi = Mid(Trim(Str(YS)), 3, 2) + "/" + Trim(Mon(MS - 1)) + "/" + Trim(Str(DS))
      Else
            TarikhShamsi = w(Weekday(Date) - 1) + ", " + Str((DS) + Val(Form3.Combo1.Text)) + ", " + Mon(MS - 1) + ", " + Str(YS)
      End If
End Function

---

برای مثال در فرم لود می نویسی

کد:

---

Label1.Caption =TarikhShamsi(Date$)

---

مجتبی رضائی(mojtaba802)

آقا مجتبي سلام . سال توام با موفقيت براي شما آرزو ميكنم.
ممنون از شما . راهنمايي بسيار مفيدي براي من بود . فقط يه مشكل دارم..... در كدي كه شما دادي حروف فارسي به هم ريخته است كه در اجراي برنامه هم به همين صورن نمايش داده ميشود . ولي باور كن تو اينترنت نتونستم هيچ كدي به اين قشنگي گير بيارم. به هر كي ميگفتم يه كد پيچيده بهم تحويل ميداد.
ايـــــول آقـــــــا مجــــتــــــبـــــي

اگه بخواين من يه class module خوب دارم واستونupload كنم

شروود جان هر چي داري رو كن دوست عزيز

Private Sub Form_Load()
c = shamsi.D2D(DateTime.Year(Now), DateTime.Month(Now), DateTime.Day(Now) - 1)
Label11.Caption = shamsi.Sal & "-" & shamsi.Mah & "-" & shamsi.Roz
End Sub

اين كد رو بذار تو فرم لود يه ليبل11 هم بذار تو فرمت
[ برای مشاهده لینک ، با نام کاربری خود وارد شوید یا ثبت نام کنید ]