DateTimePicker شمسی - بدون نیاز به DLL

[ir_programmer]

می دونم الان همه میگن بازم بحث تکراری تاریخ.
اگه میشه با تامل بیشتر کمک کنید.
من یه DateTimePicker میخام که تاریخ شمسی رو ساپورت کنه و هیچ DLLی توی برنامم اضافه نشه.
یعنی فقط سوروس کد و حتی اینجور نباشه که سورس رو داشته باشم و بازم بخام کنار فایلام این DLL ها استفاده بشه.

کار آقای اسکندری عالیه. (http://www.codeproject.com/KB/selection/FarsiLibrary.aspx) اما نیاز به DLL ها توی استفاده داره. اگر لطف کنید کمک کنید ممنون میشم.

[bahar2008]

دوست عزیز من کدش رو دارم که کار می کنه و خودم دارم استفادش می کنم ولی به صورت store procedure هست و نیازی به هیچ dll نداری .
اگر بخوای می تونم کدش رو برات اینجا قرارش بدم .

[ir_programmer]

خوبه.
اگر اینجور باشه مشکلی نداره.
ممنون میشم قرار بدین.

[bahar2008]

امیدوارم بتونه کارتون رو راه بندازه :لبخندساده::لبخندساده:



ALTER Proc GetShamsiInfo
as
Declare
@Year Integer,
@Month Integer,
@Day Integer,
@F_Year Integer,
@F_Month Integer,
@F_Day Integer,
@F_Day_Name Varchar(10),
@F_Month_Name Varchar(10),
@LastDay Integer,
@Plus Integer,
@Minus Integer,
@Intercalary Integer,
@S_Year Varchar(5),
@S_Month Varchar(5),
@S_Day Varchar(5),
@E_Date Varchar(20),
@Ret Varchar(20)
Set @Plus = 0
Set @Year = Year(Getdate())
Set @Month = Month(Getdate())
Set @Day = Day(Getdate())
----- بدست آوردن تاریخ میلادی
Set @S_Year = Cast(@Year AS VarChar(5))
Set @S_Month = Cast(@Month AS VarChar(5))
Set @S_Day = Cast(@Day AS VarChar(5))
IF Len(@S_Month) < 2
Set @S_Month = '0'+@S_Month

IF Len(@S_Day) < 2
Set @S_Day = '0'+@S_Day
Set @E_Date = @S_Year + @S_Month+ @S_Day
----- بدست آوردن تاریخ میلادی
----- بدست آوردن نام روز به فارسی
Set @F_Day_Name = Case DATEPART(dw, Getdate())
When 1 Then 'یکشنبه'
When 2 Then 'دوشنبه'
When 3 Then 'سه شنبه'
When 4 Then 'چهارشنبه'
When 5 Then 'پنجشنبه'
When 6 Then 'جمعه'
When 7 Then 'شنبه'
End
----- بدست آوردن نام روز به فارسی
IF ((@Month = 1) or (@Month = 5) or (@Month = 6))
Set @Plus = 10
IF ((@Month = 2) or (@Month = 4))
Set @Plus = 11
IF ((@Month = 3) or (@Month = 7) or (@Month = 8) or
(@Month = 9) or (@Month = 11) or (@Month = 12))
Set @Plus = 9
IF (@Month = 10)
Set @Plus = 8
Set @Year = @Year % 100
Set @Intercalary = @Year
IF (@Intercalary % 4 = 0)
IF (@Month > 2)
Set @Plus = @Plus + 1
IF ((@Intercalary - 1) % 4 = 0)
begin
Set @LastDay = 30
IF (@Month <= 3)
Set @Plus = @Plus + 1
end
Else
Set @LastDay = 29
Set @F_Year = @Year - 22
IF (@F_Year < 0)
Set @F_Year = @F_Year + 100
Set @F_Month = @Month + 9
IF (@F_Month > 12)
begin
Set @F_Month = @F_Month - 12
Set @F_Year = @F_Year + 1
end
IF (@F_Month > 12)
begin
Set @F_Month = @F_Month - 12;
Set @F_Year = @F_Year + 1
end;
Set @F_Day = @Day + @Plus
IF (@F_Month <= 6)
Set @Minus = 31
Else
IF ((@F_Month > 6) and (@F_Month<12))
Set @Minus = 30
Else
Set @Minus = @LastDay
IF (@F_Day > @Minus)
begin
Set @F_Day = @F_Day - @Minus;
Set @F_Month = @F_Month + 1
end
IF @F_Month >= 10
Set @Ret = @Ret
Else
Set @Ret = @Ret +'0'+ Cast(@F_Month As Varchar(4))
IF @F_Year >= 10
Set @Ret =@f_day
Else
Set @Ret = '0'+ Cast(@F_year As Varchar(1))
----- بدست آوردن نام ماه به فارسی
Set @F_Month_Name = Case @F_Month
When 1 Then 'فروردین'
When 2 Then 'اردیبهشت'
When 3 Then 'خرداد'
When 4 Then 'تیر'
When 5 Then 'مرداد'
When 6 Then 'شهریور'
When 7 Then 'مهر'
When 8 Then 'آبان'
When 9 Then 'آذر'
When 10 Then 'دی'
When 11 Then 'بهمن'
When 12 Then 'اسفند'
End
----- بدست آوردن نام ماه به فارسی
IF @F_Day >= 10
Set @Ret = @Ret
Else
Set @Ret = @Ret + '0'
Select
@Ret As FarsiDate,
@F_Month_Name AS FarsiMonthName,
@F_Day_Name AS FarsiDayName

return

[ir_programmer]

از توجهتون ممنون.
فکر کنم سوالمو خوب مطرح نکردم.
من منظورم DateTimePicker هست نه تبدیل تاریخ. واسه تبدیل تاریخ خودم یه تابع خوب دارم که چند ساله دارم باش کار می کنم.

[bahar2008]

ببخشید که من درست سوالتون رو متوجه نشدم
آخه شما نوشته بودید تاریخ شمسی رو ساپورت کنه من فکر کردم منظورتون نشون دادن تاریخ شمسی هست

[ir_programmer]

سایر دوستان نظر خاصی ندارند؟ میتونید نظرات خودتون رو بدید...

[Dariuosh]

پس در واقع یه سورس میخوای ؟

[Dariuosh]

این یه کنتروله ببین به کارت میاد

[ir_programmer]

این یه کنتروله ببین به کارت میاد

اره. همین خوبه.
اما clsAllDate این کجاست؟

[ir_programmer]

یکی از دوستان تابع کامل و بدون عیب تبدیل تاریخ رو درخواست کردن. اینجا میزارم واسه عموم.
اما اگه توی dateTimePicker تونستین کمک کنید به من ممنون میشم.


Module ConvertDate
Function dayofweek(ByVal tmpdate As String) As Integer
Dim defrence As Long
Dim tmpday As Integer
tmpdate = "13" + tmpdate
If tmpdate >= "1375/01/04" Then
defrence = SSub(tmpdate, "1375/01/04")
If (defrence Mod 7) = 0 Then
dayofweek = 7
Else
dayofweek = (defrence Mod 7)
End If
Else
defrence = SSub(tmpdate, "1375/01/04") - 1
If (defrence Mod 7) = 0 Then
dayofweek = 1
Else
dayofweek = 7 - (defrence Mod 7) + 1
End If
End If
End Function

Function MDaysNo(ByVal tmpMonth As Integer, ByVal IsKab As Integer) As Integer
MDaysNo = 0
Select Case tmpMonth
Case 1, 3, 5, 7, 8, 12, 10
MDaysNo = 31
Case 4, 6, 9, 11
MDaysNo = 30
Case 2
If IsKab Then
MDaysNo = 29
Else
MDaysNo = 28
End If
End Select
End Function

Function mi2sh(ByVal tmpdate As Object, ByVal R8orV6 As Boolean) As String
Dim basedate As Object
Dim basefdate As String
Dim DIFDAYS As Object
Dim realdate As String
basedate = (#3/20/1996#)
basefdate = "1375/01/01"
' DIFDAYS = MSubDate(tmpdate, basedate)
'Debug.Print DIFDAYS

DIFDAYS = DateDiff(DateInterval.Day, basedate, tmpdate)
'DIFDAYS = tmpdate - basedate

If R8orV6 = True Then
realdate = Strings.Right(SAddToDate(Strings.Right(basefdate, 8), DIFDAYS), 8)
mi2sh = Mid(realdate, 1, 2) + Mid(realdate, 4, 2) + Mid(realdate, 7, 2)
Else
mi2sh = Strings.Right(SAddToDate(Strings.Right(basefdate, 8), DIFDAYS), 8)
End If

End Function

Function MIsKabiseh(ByVal tmpYear As Integer) As Integer
MIsKabiseh = 0
If ((tmpYear Mod 4) = 0 And (tmpYear Mod 100) <> 0) Or (tmpYear Mod 400) = 0 Then
MIsKabiseh = -1
End If
End Function

Function MonNoToStr(ByVal monno As Integer) As String
MonNoToStr = ""
Select Case monno
Case 1
MonNoToStr = "فروردین"
Case 2
MonNoToStr = "اردیبهشت"
Case 3
MonNoToStr = "خرداد"
Case 4
MonNoToStr = "تیر"
Case 5
MonNoToStr = "مرداد"
Case 6
MonNoToStr = "شهریور"
Case 7
MonNoToStr = "مهر"
Case 8
MonNoToStr = "آبان"
Case 9
MonNoToStr = "آذر"
Case 10
MonNoToStr = "دی"
Case 11
MonNoToStr = "بهمن"
Case 12
MonNoToStr = "اسفند"
End Select
End Function

Function MonStrToNo(ByVal monthstr As String) As Integer
MonStrToNo = 0
Select Case Trim(monthstr)
Case "فروردین"
MonStrToNo = 1
Case "اردیبهشت"
MonStrToNo = 2
Case "خرداد"
MonStrToNo = 3
Case "تیر"
MonStrToNo = 4
Case "مرداد"
MonStrToNo = 5
Case "شهریور"
MonStrToNo = 6
Case "مهر"
MonStrToNo = 7
Case "آبان"
MonStrToNo = 8
Case "آذر"
MonStrToNo = 9
Case "دی"
MonStrToNo = 10
Case "بهمن"
MonStrToNo = 11
Case "اسفند"
MonStrToNo = 12
End Select
End Function

Function MSubDate1(ByVal date1 As Object, ByVal date2 As Object) As Long
Const COUNTORDIF As Integer = 0 'FOR COUNT = 1 AND FOR DIF = 0
Dim DAYSIGN As Integer
Dim i, M1, M2, D1, D2, Y1, Y2 As Integer
Dim DSUP, DS, DSDOWN As Long
Dim tmpdate As Object
'------------ swap dates ------------
DAYSIGN = 1
If date1 < date2 Then
tmpdate = date1
date1 = date2
date2 = tmpdate
DAYSIGN = -1
End If
'------------ Separate DAtes -------------------
M1 = Month(date1)
M2 = Month(date2)

'D1 = Day(date1)
'D2 = Day(date2)
Y1 = Year(date1)
Y2 = Year(date2)
'------------ Besmel -------------
'------------- هر دو تاریخ برای یک سال باشند
If Y1 = Y2 Then
If M1 = M2 Then
DSDOWN = D1 - D2 + COUNTORDIF
DSUP = 0
Else
DSDOWN = MDaysNo(M2, MIsKabiseh(Y2)) - D2 + COUNTORDIF
DSUP = D1
End If
DS = 0
For i = M2 + 1 To M1 - 1
DS = DS + MDaysNo(i, MIsKabiseh(Y2))
Next i
MSubDate1 = (DSDOWN + DS + DSUP) * DAYSIGN
Exit Function
End If
'------------- تاریخها برای سالهای متفاوت باشند
DSDOWN = MDaysNo(M2, MIsKabiseh(Y2)) - D2 + COUNTORDIF
For i = M2 + 1 To 12
DSDOWN = DSDOWN + MDaysNo(i, MIsKabiseh(Y2))
Next i
DSUP = D1
For i = 1 To M1 - 1
DSUP = DSUP + MDaysNo(i, MIsKabiseh(Y1))
Next i
DS = 0
For i = Y2 + 1 To Y1 - 1
If MIsKabiseh(i) Then
DS = DS + 366
Else
DS = DS + 365
End If
Next i
MSubDate1 = (DSDOWN + DS + DSUP) * DAYSIGN
End Function

Function SAddToDate(ByVal adate As String, ByVal addrate As Long) As String
Dim TYEAR As Integer
Dim TMON As Integer, tmon2 As Integer
Dim TDAY As Integer
Dim TI As Integer
Dim DAYSN As Long
Dim AddToDate As String
AddToDate = ""
adate = "13" & adate
TYEAR = SYear(adate)
TMON = SMonth(adate)
TDAY = Sday(adate)
DAYSN = Math.Abs(addrate)
Select Case addrate
'--------------- مقدار اضافه شده به تاریخ صفر است
Case Is = 0
SAddToDate = adate
'--------------- مقدار اضافه شده به تاریخ مثبت است
Case Is > 0
If DAYSN > (SDaysNo(TMON, siskabiseh(TYEAR)) - TDAY) Then
DAYSN = DAYSN - SDaysNo(TMON, siskabiseh(TYEAR)) + TDAY
TMON = TMON + 1
Else
TDAY = TDAY + DAYSN
SAddToDate = Strings.Right(Format(TYEAR, "0000"), 2) & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
Exit Function
End If
Do While DAYSN > SDaysNo(TMON, siskabiseh(TYEAR)) And TMON <= 12
DAYSN = DAYSN - SDaysNo(TMON, siskabiseh(TYEAR))
TMON = TMON + 1
Loop
If TMON > 12 Then
TYEAR = TYEAR + 1
Else
TDAY = DAYSN
SAddToDate = Strings.Right(Format(TYEAR, "0000"), 2) & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
Exit Function
End If
Do While DAYSN > SYearDaysNo(TYEAR)
DAYSN = DAYSN - SYearDaysNo(TYEAR)
TYEAR = TYEAR + 1
Loop
'If DAYSN = 0 Then
' DAYSN = 1
'End If
TI = 1
Do While DAYSN > SDaysNo(TI, siskabiseh(TYEAR))
DAYSN = DAYSN - SDaysNo(TI, siskabiseh(TYEAR))
TI = TI + 1
Loop
If DAYSN = 0 Then
DAYSN = 1
End If
SAddToDate = Strings.Right(Format(TYEAR, "0000"), 2) & "/" & Format(TI, "00") & "/" & Format(DAYSN, "00")
'--------------- مقدار اضافه شده به تاریخ منفی است
Case Is < 0
If DAYSN >= TDAY Then
DAYSN = DAYSN - TDAY
TMON = TMON - 1
Else
TDAY = TDAY - DAYSN
SAddToDate = Strings.Right(Format(TYEAR, "0000"), 2) & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
Exit Function
End If
Do While DAYSN >= SDaysNo(TMON, siskabiseh(TYEAR)) And TMON >= 1
DAYSN = DAYSN - SDaysNo(TMON, siskabiseh(TYEAR))
TMON = TMON - 1
Loop
If TMON < 1 Then
TYEAR = TYEAR - 1
Else
TDAY = SDaysNo(TMON, siskabiseh(TYEAR)) - DAYSN
SAddToDate = Strings.Right(Format(TYEAR, "0000"), 2) & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
Exit Function
End If
Do While DAYSN >= SYearDaysNo(TYEAR)
DAYSN = DAYSN - SYearDaysNo(TYEAR)
TYEAR = TYEAR - 1
Loop
TI = 12
Do While DAYSN >= SDaysNo(TI, siskabiseh(TYEAR))
DAYSN = DAYSN - SDaysNo(TI, siskabiseh(TYEAR))
TI = TI - 1
Loop
'If DAYSN = 0 Then
' DAYSN = SDaysNo(TI, siskabiseh(TYEAR))
'End If
TDAY = SDaysNo(TI, siskabiseh(TYEAR)) - DAYSN
TMON = TI
SAddToDate = Strings.Right(Format(TYEAR, "0000"), 2) & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
End Select
End Function

Function Sday(ByVal adate As String) As Integer
Sday = Val(Strings.Right(adate, 2))
End Function

Function sdayname(ByVal wdayno As Integer) As String
sdayname = ""
Select Case wdayno
Case 0
sdayname = "جمعه"
Case 1
sdayname = "شنبه"
Case 2
sdayname = "یکشنبه"
Case 3
sdayname = "دوشنبه"
Case 4
sdayname = "سه شنبه"
Case 5
sdayname = "چهار شنبه"
Case 6
sdayname = "پنجشنبه"
Case 7
sdayname = "جمعه"
End Select

End Function

Function SDayOFWeek(ByVal tmpdate As String) As Integer
Dim defrence As Long
'Dim tmpday As Integer
If tmpdate >= "1375/01/04" Then
defrence = SSub(tmpdate, "1375/01/04")
If (defrence Mod 7) = 0 Then
SDayOFWeek = 7
Else
SDayOFWeek = (defrence Mod 7)
End If
Else
defrence = SSub(tmpdate, "1375/01/04") - 1
If (defrence Mod 7) = 0 Then
SDayOFWeek = 1
Else
SDayOFWeek = 7 - (defrence Mod 7) + 1
End If
End If
End Function

Function SDaysNo(ByVal tmpMonth As Integer, ByVal IsKab As Integer) As Integer
SDaysNo = 0
Select Case tmpMonth
Case 12
If IsKab Then
SDaysNo = 30
Else
SDaysNo = 29
End If
Case 7 To 11
SDaysNo = 30
Case 1 To 6
SDaysNo = 31
End Select
End Function

Function SGetDayStr(ByVal adate As Object) As String
SGetDayStr = sdayname(SDayOFWeek(mi2sh(adate, False)))
End Function

Function siskabiseh(ByVal tmpYear As Integer) As Integer
siskabiseh = 0
Dim tmpval As Long
tmpval = tmpYear
If (((tmpval + 38) * 31) Mod 128) <= 30 Then
siskabiseh = -1
End If
End Function

Function SMonth(ByVal adate As String) As Long
SMonth = Val(Mid(adate, 6, 2))
End Function

Function SSub(ByVal date1 As String, ByVal date2 As String) As Long
Dim alldays As Long
Dim i As Integer
Dim year1 As Integer
Dim year2 As Integer
Dim month1 As Integer
Dim month2 As Integer
Dim days1 As Integer
Dim days2 As Integer
Dim tmps As String
SSub = 0
If date1 < date2 Then
tmps = date2
date2 = date1
date1 = tmps
End If
alldays = 0
year1 = Val(Strings.Left(date1, 4))
year2 = Val(Strings.Left(date2, 4))
month1 = Val(Mid(date1, 6, 2))
month2 = Val(Mid(date2, 6, 2))
days1 = Val(Strings.Right(date1, 2))
days2 = Val(Strings.Right(date2, 2))
If year1 = year2 Then
For i = month2 + 1 To month1 - 1
alldays = alldays + SDaysNo(i, siskabiseh(year1))
Next i
If month1 <> month2 Then
alldays = alldays + days1
alldays = alldays + SDaysNo(month2, siskabiseh(year2)) - days2 + 1
Else
alldays = Math.Abs(days1 - days2) + 1
End If
SSub = alldays
Exit Function
End If
For i = year2 + 1 To year1 - 1
If siskabiseh(i) Then
alldays = alldays + 366
Else
alldays = alldays + 365
End If
Next i
For i = 1 To month1 - 1
alldays = alldays + SDaysNo(i, siskabiseh(year1))
Next i
For i = month2 + 1 To 12
alldays = alldays + SDaysNo(i, siskabiseh(year2))
Next i

alldays = alldays + days1
alldays = alldays + SDaysNo(month2, siskabiseh(year2)) - days2 + 1
SSub = alldays
End Function

Function SXAddToDate(ByVal adate As String, ByVal addrate As Long) As String
Dim TYEAR As Integer
Dim TMON As Integer, tmon2 As Integer
Dim TDAY As Integer
Dim TI As Integer
Dim DAYSN As Long
SXAddToDate = ""
TYEAR = SYear(adate)
TMON = SMonth(adate)
TDAY = Sday(adate)
DAYSN = Math.Abs(addrate)
Select Case addrate
'--------------- مقدار اضافه شده به تاریخ صفر است
Case Is = 0
SXAddToDate = adate
'--------------- مقدار اضافه شده به تاریخ مثبت است
Case Is > 0
If DAYSN > (SDaysNo(TMON, siskabiseh(TYEAR)) - TDAY) Then
DAYSN = DAYSN - SDaysNo(TMON, siskabiseh(TYEAR)) + TDAY
TMON = TMON + 1
Else
TDAY = TDAY + DAYSN
SXAddToDate = Format(TYEAR, "0000") & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
Exit Function
End If
Do While DAYSN > SDaysNo(TMON, siskabiseh(TYEAR)) And TMON <= 12
DAYSN = DAYSN - SDaysNo(TMON, siskabiseh(TYEAR))
TMON = TMON + 1
Loop
If TMON > 12 Then
TYEAR = TYEAR + 1
Else
TDAY = DAYSN
SXAddToDate = Format(TYEAR, "0000") & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
Exit Function
End If
Do While DAYSN > SYearDaysNo(TYEAR)
DAYSN = DAYSN - SYearDaysNo(TYEAR)
TYEAR = TYEAR + 1
Loop
'If DAYSN = 0 Then
' DAYSN = 1
'End If
TI = 1
Do While DAYSN > SDaysNo(TI, siskabiseh(TYEAR))
DAYSN = DAYSN - SDaysNo(TI, siskabiseh(TYEAR))
TI = TI + 1
Loop
If DAYSN = 0 Then
DAYSN = 1
End If
SXAddToDate = Format(TYEAR, "0000") & "/" & Format(TI, "00") & "/" & Format(DAYSN, "00")
'--------------- مقدار اضافه شده به تاریخ منفی است
Case Is < 0
If DAYSN >= TDAY Then
DAYSN = DAYSN - TDAY
TMON = TMON - 1
Else
TDAY = TDAY - DAYSN
SXAddToDate = Format(TYEAR, "0000") & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
Exit Function
End If
Do While DAYSN >= SDaysNo(TMON, siskabiseh(TYEAR)) And TMON >= 1
DAYSN = DAYSN - SDaysNo(TMON, siskabiseh(TYEAR))
TMON = TMON - 1
Loop
If TMON < 1 Then
TYEAR = TYEAR - 1
Else
TDAY = SDaysNo(TMON, siskabiseh(TYEAR)) - DAYSN
SXAddToDate = Format(TYEAR, "0000") & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
Exit Function
End If
Do While DAYSN >= SYearDaysNo(TYEAR)
DAYSN = DAYSN - SYearDaysNo(TYEAR)
TYEAR = TYEAR - 1
Loop
TI = 12
Do While DAYSN >= SDaysNo(TI, siskabiseh(TYEAR))
DAYSN = DAYSN - SDaysNo(TI, siskabiseh(TYEAR))
TI = TI - 1
Loop
'If DAYSN = 0 Then
' DAYSN = SDaysNo(TI, siskabiseh(TYEAR))
'End If
TDAY = SDaysNo(TI, siskabiseh(TYEAR)) - DAYSN
TMON = TI
SXAddToDate = Format(TYEAR, "0000") & "/" & Format(TMON, "00") & "/" & Format(TDAY, "00")
End Select
End Function


Function SYear(ByVal adate As String) As Integer
SYear = Val(Strings.Left(adate, 4))
End Function

Function SYearDaysNo(ByVal TYEAR As Integer) As Integer
If siskabiseh(TYEAR) Then
SYearDaysNo = 366
Else
SYearDaysNo = 365
End If
End Function
Function MiladiToShamsi(ByVal tmpdate As Object, ByVal R8orV6 As Boolean) As String
Dim StrDate As String

StrDate = mi2sh(tmpdate, R8orV6)
'Return StrDate
Return StrDate.Substring(0, 2) + "/" + StrDate.Substring(3, 2) + "/" + StrDate.Substring(6, 2)

End Function

Function ShowDateNow() As String
Dim StrDate As String

StrDate = mi2sh(Now.Date, False)
'Return StrDate
Return StrDate.Substring(0, 2) + "/" + StrDate.Substring(3, 2) + "/" + StrDate.Substring(6, 2)

End Function

Function ShowTimeNow() As String

Dim nHour, nMinute As String

nHour = Now.Hour.ToString
If Len(nHour) = 1 Then
nHour = "0" + nHour
End If
nMinute = Now.Minute.ToString
If Len(nMinute) = 1 Then
nMinute = "0" + nMinute
End If

Return nHour + ":" + nMinute

End Function

End Module

[babakj]

بله کار آقای اسکندری واقعا جالبه و جای قدر دانی داره
اتفاقا کدی که ایشون گذاشته دارای باگ اساسی است به روزه آخر سال و اول سال بعد دقت کنید
ولی خودشون به من گفتند که اشکال رو رفع کردند و به زودی توی وب لاگشون قرار می دهند

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