iCentar » Racunari i oprema » Programirannje i baze podataka » Access

pmiroslav	04.01.2013 17:08
Predmet:Digitalni sat Ima li netko kakav primjer za ubaciti datum i vrijeme na formu. Ovo mi treba jer imama aplikaciju za izdavanje računa, pa postoji problem da ako se zbog neispravne baterije na matičnoj ploči poremeti sistemski datum da na računu bude ispisan pogrešan datum. Na ovaj način bi korisnik trebao imati pregled dali su datum i vrijeme ispravni.

zxz	04.01.2013 17:53
Predmet:Re: Digitalni sat Bilo koji sat i vrijeme da pstavis u stvari uzimas sistemsko vrijeme sa cipa i ukoliko tamo nije tacno nigdje nece biti.

mrkela	04.01.2013 20:29
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

mrkela

04.01.2013 20:29

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

mrkela	04.01.2013 20:38
Predmet:Re: Digitalni sat U prilogu je primjer...
Prilozi: sat.rar (Velicina datoteke:16.37 KB)

pmiroslav	06.01.2013 12:27
Predmet:Re: Digitalni sat Napravio sam sat na temelju ZXZ-ovog prijedloga. Jedino se problem što mi se naziv dana neispravno pokazuje. U kodu sam napisao: WeekdayName(Month(Date)) Danas je Nedjelja, a napiše mi Ponedjeljak.
Prilozi: Sat primjer.rar (Velicina datoteke:17.32 KB)