Prikazi cijelu temu 04.01.2013 19:29
mrkela Van mreze
Clan
Registrovan od:10.11.2008
Lokacija:-


Predmet:Re: Digitalni sat
Na formi stavi u On Timer eventu
(Private Sub Form_Timer()
TimeLabel.Caption = Time$
DateLabel.Caption = DATE_GetLongDate(True)
End Sub

I dodaj novi modul priložen ispod ovog...

Attribute VB_Name = "modTimeDate"
Option Explicit
Option Compare Database

Declare Sub TIMEDATE_GetSystemTime Lib "kernel32" Alias "GetSystemTime" (lpSystemTime As SYSTEMTIME)
Declare Sub TIMEDATE_GetLocalTime Lib "kernel32" Alias "GetLocalTime" (lpSystemTime As SYSTEMTIME)

Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Function DATE_DaysInMonth(ByVal lpMonth As Long, ByVal lpYear As Long) As Long
Select Case lpMonth
Case 1
DATE_DaysInMonth = 31
Case 2
If (Val(lpYear) Mod 4) = 0 Then DATE_DaysInMonth = 29 Else DATE_DaysInMonth = 28
If (Val(lpYear) Mod 100) = 0 Then If (Val(lpYear) Mod 400) = 0 Then DATE_DaysInMonth = 29 Else DATE_DaysInMonth = 28
Case 3
DATE_DaysInMonth = 31
Case 4
DATE_DaysInMonth = 30
Case 5
DATE_DaysInMonth = 31
Case 6
DATE_DaysInMonth = 30
Case 7
DATE_DaysInMonth = 31
Case 8
DATE_DaysInMonth = 31
Case 9
DATE_DaysInMonth = 30
Case 10
DATE_DaysInMonth = 31
Case 11
DATE_DaysInMonth = 30
Case Else
DATE_DaysInMonth = 31
End Select
End Function

Function DATE_GetDay() As Long
Dim TIMEDATE_SYSTEM_DATE As SYSTEMTIME
TIMEDATE_GetLocalTime TIMEDATE_SYSTEM_DATE
DATE_GetDay = TIMEDATE_SYSTEM_DATE.wDay
End Function

Function DATE_GetMonth() As Long
Dim TIMEDATE_SYSTEM_DATE As SYSTEMTIME
TIMEDATE_GetLocalTime TIMEDATE_SYSTEM_DATE
DATE_GetMonth = TIMEDATE_SYSTEM_DATE.wMonth
End Function

Function DATE_GetYear() As Long
Dim TIMEDATE_SYSTEM_DATE As SYSTEMTIME
TIMEDATE_GetLocalTime TIMEDATE_SYSTEM_DATE
DATE_GetYear = TIMEDATE_SYSTEM_DATE.wYear
End Function

Function DATE_GetDayOfWeek() As Long
Dim TIMEDATE_SYSTEM_DATE As SYSTEMTIME
TIMEDATE_GetLocalTime TIMEDATE_SYSTEM_DATE
DATE_GetDayOfWeek = TIMEDATE_SYSTEM_DATE.wDayOfWeek
End Function

Function DATE_CheckDate(ByVal CheckDate As String) As Boolean
On Local Error Resume Next
Dim TEMP_DAY As Long
TEMP_DAY = Day(CheckDate)
If Err <> 0 Then
DATE_CheckDate = False
Else
DATE_CheckDate = True
End If
End Function

Function DATE_GetLongDate(ByVal Serbian As Boolean, Optional ByVal CurrentDate As String)
Dim TIMEDATE_SYSTEM_DATE As SYSTEMTIME
Dim TIMEDATE_DAY(7) As String, TIMEDATE_MONTH(12) As String
Dim TEMP_DAYOFWEEK As Long
Dim TEMP_DAY As Long, TEMP_MONTH As Long, TEMP_YEAR As Long

If Serbian Then
TIMEDATE_DAY(1) = "Nedjelja"
TIMEDATE_DAY(2) = "Ponedjeljak"
TIMEDATE_DAY(3) = "Utorak"
TIMEDATE_DAY(4) = "Srijeda"
TIMEDATE_DAY(5) = "Četvrtak"
TIMEDATE_DAY(6) = "Petak"
TIMEDATE_DAY(7) = "Subota"
TIMEDATE_MONTH(1) = "Siječanj"
TIMEDATE_MONTH(2) = "Veljača"
TIMEDATE_MONTH(3) = "Ožujak"
TIMEDATE_MONTH(4) = "Travanj"
TIMEDATE_MONTH(5) = "Svibanj"
TIMEDATE_MONTH(6) = "Lipanj"
TIMEDATE_MONTH(7) = "Srpanj"
TIMEDATE_MONTH(8) = "Kolovoz"
TIMEDATE_MONTH(9) = "Rujan"
TIMEDATE_MONTH(10) = "Listopad"
TIMEDATE_MONTH(11) = "Studeni"
TIMEDATE_MONTH(12) = "Prosinac"
Else
TIMEDATE_DAY(1) = "Sunday"
TIMEDATE_DAY(2) = "Monday"
TIMEDATE_DAY(3) = "Tuesday"
TIMEDATE_DAY(4) = "Wednesday"
TIMEDATE_DAY(5) = "Thursday"
TIMEDATE_DAY(6) = "Friday"
TIMEDATE_DAY(7) = "Saturday"
TIMEDATE_MONTH(1) = "January"
TIMEDATE_MONTH(2) = "February"
TIMEDATE_MONTH(3) = "March"
TIMEDATE_MONTH(4) = "April"
TIMEDATE_MONTH(5) = "May"
TIMEDATE_MONTH(6) = "June"
TIMEDATE_MONTH(7) = "July"
TIMEDATE_MONTH(8) = "August"
TIMEDATE_MONTH(9) = "September"
TIMEDATE_MONTH(10) = "October"
TIMEDATE_MONTH(11) = "November"
TIMEDATE_MONTH(12) = "December"
End If

If CurrentDate = "" Then
TIMEDATE_GetLocalTime TIMEDATE_SYSTEM_DATE
TEMP_DAYOFWEEK = TIMEDATE_SYSTEM_DATE.wDayOfWeek + 1
TEMP_DAY = TIMEDATE_SYSTEM_DATE.wDay
TEMP_MONTH = TIMEDATE_SYSTEM_DATE.wMonth
TEMP_YEAR = TIMEDATE_SYSTEM_DATE.wYear
Else
If Not DATE_CheckDate(CurrentDate) Then DATE_GetLongDate = "": Exit Function
TEMP_DAYOFWEEK = Weekday(CurrentDate)
TEMP_DAY = Day(CurrentDate)
TEMP_MONTH = Month(CurrentDate)
TEMP_YEAR = Year(CurrentDate)
End If
If Serbian Then
DATE_GetLongDate = TIMEDATE_DAY(TEMP_DAYOFWEEK) + ", " + Trim$(TEMP_DAY) + ". " + TIMEDATE_MONTH(TEMP_MONTH) + " " + Trim$(TEMP_YEAR) + "."
Else
DATE_GetLongDate = TIMEDATE_DAY(TEMP_DAYOFWEEK) + ", " + TIMEDATE_MONTH(TEMP_MONTH) + " " + Trim$(TEMP_DAY) + ". " + Trim$(TEMP_YEAR) + "."
End If
End Function

Function DATE_GetShortDate(Optional ByVal CurrentDate As String)
Dim TIMEDATE_SYSTEM_DATE As SYSTEMTIME
If CurrentDate = "" Then
TIMEDATE_GetLocalTime TIMEDATE_SYSTEM_DATE
DATE_GetShortDate = DateSerial(TIMEDATE_SYSTEM_DATE.wYear, TIMEDATE_SYSTEM_DATE.wMonth, TIMEDATE_SYSTEM_DATE.wDay)
Else
If DATE_CheckDate(CurrentDate) Then
DATE_GetShortDate = DateSerial(Year(CurrentDate), Month(CurrentDate), Day(CurrentDate))
Else
DATE_GetShortDate = ""
End If
End If
End Function

Function TIME_TimeToSec(ByVal ConvertTime As String) As Long
Dim TEMP_SECONDS As Long
Dim TEMP_TIME As String, TEMP_MULTI As Long
Dim S As String, I As Long
TEMP_TIME = "": TEMP_MULTI = 1
For I = Len(ConvertTime) To 1 Step -1
S = Mid$(ConvertTime, I, 1)
If S = ":" Then
TEMP_SECONDS = TEMP_SECONDS + Val(TEMP_TIME) * TEMP_MULTI
TEMP_TIME = ""
TEMP_MULTI = TEMP_MULTI * 60
Else
TEMP_TIME = S + TEMP_TIME
End If
Next
TEMP_SECONDS = TEMP_SECONDS + Val(TEMP_TIME) * TEMP_MULTI
TIME_TimeToSec = TEMP_SECONDS
End Function

Function TIME_SecToTime(ByVal Seconds As Long) As String
Dim TEMP_HOUR As Long, TEMP_MIN As Long, TEMP_SEC As Long
Dim TEMP_TIME As Long, S As String
TEMP_TIME = Seconds
TEMP_HOUR = Int(TEMP_TIME / 3600): TEMP_TIME = TEMP_TIME - TEMP_HOUR * 3600
TEMP_MIN = Int(TEMP_TIME / 60): TEMP_SEC = TEMP_TIME - TEMP_MIN * 60
If TEMP_HOUR < 100 Then S = Right$("00" + Trim$(TEMP_HOUR), 2) Else S = Trim$(TEMP_HOUR)
S = S + ":" + Right$("00" + Trim$(TEMP_MIN), 2)
S = S + ":" + Right$("00" + Trim$(TEMP_SEC), 2)
TIME_SecToTime = S
End Function

Function TIME_MilliSecToTime(ByVal MilliSeconds As Long) As String
Dim TEMP_MIN As Long, TEMP_SEC As Long, TEMP_MSEC As Long
Dim TEMP_TIME As Long, S As String
TEMP_TIME = MilliSeconds
TEMP_MIN = Int(TEMP_TIME / 6000): TEMP_TIME = TEMP_TIME - TEMP_MIN * 6000
TEMP_SEC = Int(TEMP_TIME / 100): TEMP_MSEC = TEMP_TIME - TEMP_MIN * 100
If TEMP_MIN < 100 Then S = Right$("00" + S, 2) Else S = Trim$(TEMP_MIN)
S = S + ":" + Right$("00" + Trim$(TEMP_SEC), 2)
S = S + ":" + Right$("00" + Trim$(TEMP_MSEC), 2)
TIME_MilliSecToTime = S
End Function