درج تاريخ در ديتا گريد با استفاده از Shamsi.dll

[علی جباری]

يك ديتا گريد دارم كه ميخواهم در بعضي از Cellهاي اون تاريخ وارد كنم با مشخصات زير:

1- از Vsflex7.ocx استفاده ميكنم.
2- از Shamsi.dll استفاده مي‌كنم و ميخوام كه فرمت تاريخ بطور صحيح وارد بشه.

البه فكر كنم كه با تابع Format بشه اين كار رو كرد ولي متاسفانه نتونستم حلش كنم.

مــمنــــون

[علی جباری]

هيچكدوم از دوستان جوابي ندارند؟

[reza_mn]

Dim clsShamsi As New ClassShamsi
Shamsi = clsShamsi.Shamsi
]

مقدار SHAMSI تاریخ جاری سیستم به شمسی خواهد بود.

[علی جباری]

من از Shamsi.dll در غالب MaskEdit زياد استفاده كردم و مشكل ندارم. مشكل در اين است كه MaskEdit يا فرمتي مثل اون رو نمي‌تونم در گريد پياده كنم.

[reza_mn]

منظورتون دریافت تاریخ شمسی هست ؟
از کامپوننت ضمیمه برای اینکار استفاده کنید.

[فاطمه وطن دوست]

نمونه



http://barnamenevis.org/forum/showthread.php?t=144063

[علی جباری]

با تشكر از توجه شما ولي هيچكدام از موارد فوق مشكل رو حل نكرد. لطفا به مثال زير توجه كنيد، در جلوي ديتا گريد يك MaskEdit است كه بطور صحيح، تاريخ در آن وارد مي‌شود.
چيزي كه من نياز دارم اين است كه يك تاريخ (تاريخ تولد) دقيقا مانند MaskEdit داخل ديتا گريد وارد شود.

[فاطمه وطن دوست]

از این دستور استفاده کنید .
FG نام گرید .


FG.EditMask = "####/##/##"

[Fery666]

با سلام به دوستان و تبریک سال نو :تشویق::قهقهه::لبخند:. امیدوارم در سال جدید هرچی دوستان می خوان بهش برسن.
برای نمایش تاریخ شمسی می تونین از این کد برای نمایش تاریخ شمسی استفاده کنین و احتیاجی هم به Shamsi.dll نداشته باشین. این کد رو باید در ماژول وارد کنید




Function shamsyDate(dat As Date, far As Boolean)
Dim dd, yy, mm, hh, idays, ldays, ff, gg, qstr
Dim d(12), dy(7)
yy = Year(dat)
d(1) = 31
If (yy / 4) = Int(yy / 4) Then
d(2) = 29
Else
d(2) = 28
End If
dy(1) = "íßÔäÈå"
dy(2) = "ÏæÔäÈå"
dy(3) = "Óå ÔäÈå"
dy(4) = "åÇÑÔäÈå"
dy(5) = "äÌÔäÈå"
dy(6) = "ÌãÚå"
dy(7) = "ÔäÈå"
d(3) = 31
d(4) = 30
d(5) = 31
d(6) = 30
d(7) = 31
d(8) = 31
d(9) = 30
d(10) = 31
d(11) = 30
d(12) = 31
mm = 0
For I = 1 To Month(dat) - 1
mm = mm + d(I)
Next
yy = yy - 1
dd = Day(dat)
ldays = (yy * 365) + (Int(yy / 4)) + mm + dd
idays = ldays - 226899
ff = LTrim(Str(Month(dat)))
gg = LTrim(Str(Day(dat)))
If Len(ff) < 2 Then
ff = "0" + ff
End If
If Len(gg) < 2 Then
gg = "0" + gg
End If
hh = ff + gg
If hh <= "0320" Then
yy = Year(dat) - 622
Else
yy = Year(dat) - 621
End If
mm = idays - (Int(yy / 4)) - ((yy - 1) * 365)
If mm <= 186 Then
dd = mm Mod 31
If dd = 0 Then
dd = 31
mm = Int(mm / 31)
Else
mm = Int(mm / 31) + 1
End If
Else
mm = mm - 186
dd = mm Mod 30
If dd = 0 Then
dd = 30
mm = Int(mm / 30) + 6
Else
mm = Int(mm / 30) + 7
End If
End If
If (Year(dat) / 4) = Int(Year(dat) / 4) And hh > "0320" Or (((Year(dat) - 1) / 4) = Int((Year(dat) - 1) / 4) And hh <= "0320") Then
' dd=dd-1
End If
If far Then
qstr = Trim(Str(yy)) + "/" + IIf(Len(Trim(Str(mm))) = 1, Trim("0") + Trim(Str(mm)), Trim(Str(mm))) + "/" + IIf(Len(Trim(dd)) = 1, Trim("0") + Trim(Str(dd)), Trim(Str(dd))) + " " + dy(Weekday(dat))
Else
yy = yy Mod 100
qstr = Str(yy) + "/"
If mm < 10 Then
qstr = qstr + "0" + Trim(Str(mm)) + "/"
Else
qstr = qstr + Trim(Str(mm)) + "/"
End If
If dd < 10 Then
qstr = qstr + "0" + Trim(Str(dd))
Else
qstr = qstr + Trim(Str(dd))
End If
End If
shamsyDate = qstr
End Function




و در هر جایی از برنامه می تونین از این دستور استفاده کنید
shamsyDate(Date,True) استفاده کنید.

[meys34]

اين يكي رو امتحان كردم خيلي باحاله با سال هاي كبيسه (قبل و بعدش هم) مشكلي نداره
مثلا امروز 1388/01/01 هستش:لبخندساده:

البته اين تابع رو من ننوشتما:خجالت:


Private Function Zaman() As String
On Error Resume Next
'for example A = zaman()
'return yyyy/mm/dd-hh:mm:ss as date of shamsi yyyy sale shamsi mm mah shamsi dd roze shamsi hh saat as 24 mm daghighe ss saniyeh
'SMRM 66000024 Tehran 1385
Dim Str As String
Dim Ym, mm, Dm, Ys, Ms, Ds As Integer
Dim Kb, Kb2 As Boolean
Kb2 = False
Zaman = ""
Str = Date 'Zm1
Ym = Val(Left(Str, 4))
mm = Val(Mid(Str, 6, 2))
Dm = Val(Right(Str, 2))

If (mm < 3) Then
If (Ym - 1) Mod 4 = 0 Then Kb = True Else Kb = False
Else
If (Ym - 1) Mod 4 = 0 And mm = 3 And Dm < 21 Then
Kb = True
Kb2 = True
Else
If (Ym Mod 4) = 0 Then Kb = True Else Kb = False
End If
End If

Ys = Ym - 621
Ms = mm - 3
Ds = Dm + 9

Select Case mm
Case 1
If Kb Then
If Ds > 28 Then Ds = Ds - 28: Ms = 11: Ys = Ys - 1 Else Ds = Ds + 2: Ms = 10: Ys = Ys - 1
Else
If Ds > 29 Then Ds = Ds - 29: Ms = 11: Ys = Ys - 1 Else Ds = Ds + 1: Ms = 10: Ys = Ys - 1
End If
Case 2
If Kb Then
If Ds > 27 Then Ds = Ds - 27: Ms = 12: Ys = Ys - 1 Else Ds = Ds + 3: Ms = 11: Ys = Ys - 1
Else
If Ds > 28 Then Ds = Ds - 28: Ms = 12: Ys = Ys - 1 Else Ds = Ds + 2: Ms = 11: Ys = Ys - 1
End If
Case 3
If Kb Then
If Ds > 28 And (Not Kb2) Then Ds = Ds - 28: Ms = 1 Else Ds = Ds + 1: Ms = 12: Ys = Ys - 1
Else
If Ds > 29 Then Ds = Ds - 29: Ms = 1 Else Ms = 12: Ys = Ys - 1
End If
Case 4
If Kb Then
If Ds > 28 Then Ds = Ds - 28: Ms = Ms + 1 Else Ds = Ds + 3
Else
If Ds > 29 Then Ds = Ds - 29: Ms = 2 Else Ds = Ds + 2: Ms = 1
End If
Case 5
If Kb Then
If Ds > 29 Then Ds = Ds - 29: Ms = Ms + 1 Else Ds = Ds + 2
Else
If Ds > 30 Then Ds = Ds - 30: Ms = 3 Else Ds = Ds + 1: Ms = 2
End If
Case 6
If Kb Then
If Ds > 29 Then Ds = Ds - 29: Ms = Ms + 1 Else Ds = Ds + 2
Else
If Ds > 30 Then Ds = Ds - 30: Ms = 4 Else Ds = Ds + 1: Ms = 3
End If
Case 7
If Kb Then
If Ds > 30 Then Ds = Ds - 30: Ms = Ms + 1 Else Ds = Ds + 1
Else
If Ds > 31 Then Ds = Ds - 31: Ms = 5
End If
Case 8
If Kb Then
If Ds > 30 Then Ds = Ds - 30: Ms = Ms + 1 Else Ds = Ds + 1
Else
If Ds > 31 Then Ds = Ds - 31: Ms = 6
End If
Case 9
If Kb Then
If Ds > 30 Then Ds = Ds - 30: Ms = Ms + 1 Else Ds = Ds + 1
Else
If Ds > 31 Then Ds = Ds - 31: Ms = 7
End If
Case 10
If Kb Then
If Ds > 30 Then Ds = Ds - 30: Ms = Ms + 1
Else
If Ds > 31 Then Ds = Ds - 31: Ms = 8 Else Ds = Ds - 1
End If
Case 11
If Kb Then
If Ds > 29 Then Ds = Ds - 29: Ms = Ms + 1 Else Ds = Ds + 1
Else
If Ds > 30 Then Ds = Ds - 30: Ms = 9
End If
Case 12
If Kb Then
If Ds > 29 Then Ds = Ds - 29: Ms = Ms + 1 Else Ds = Ds + 1
Else
If Ds > 30 Then Ds = Ds - 30: Ms = 10
End If
End Select
If Ms < 10 Then Zaman = Ys & "/0" & Ms Else Zaman = Ys & "/" & Ms
If Ds < 10 Then Zaman = Zaman & "/0" & Ds Else Zaman = Zaman & "/" & Ds

End Function

[علی جباری]

با تشكر از همه، مشكل من با


FG.EditMask = "####/##/##"
حل شد دقيقا همون چيزي بود كه ميخواستم.
فقط يه چيز ديگه ميخواستم زمان تايپ اعداد در Cellها اعداد را سه رقم سه رقم جدا كنم (جدا كننده اعداد)

[850725115]

با سلام
نمیشه لطفا کنین سورس برنامه تبدیل تاریخ شمسی به میلادی رو برام بزارین ؟؟؟؟