помош [VB Clock]

[petar.bt]

Во мојата апликација сакам во левиот агол да имам сатче кое ке ја показува датата и сатот.Дали некој мози да ми најди код за таа работа.
Чао

 

[LiquidWorm]

....

[hl='vb']
'Автор на кодот: Randy

Begin VB.Form frmClock
BackColor = &H00000000&
BorderStyle = 0 'None
Caption = "My Clock"
ClientHeight = 1035
ClientLeft = 4965
ClientTop = 5070
ClientWidth = 4785
LinkTopic = "frmClock"
ScaleHeight = 1035
ScaleWidth = 4785
ShowInTaskbar = 0 'False
Begin VB.Timer Timer1
Interval = 100
Left = 0
Top = 600
End
Begin VB.Label lTime
BackColor = &H00FF0000&
BackStyle = 0 'Transparent
Caption = "myTime"
BeginProperty Font
Name = "EndlessShowroom"
Size = 18
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 675
Left = 0
TabIndex = 0
Top = 120
Width = 4605
End
Begin VB.Label ampm
Alignment = 2 'Center
BackColor = &H00FF0000&
BackStyle = 0 'Transparent
Caption = "ampm"
BeginProperty Font
Name = "EndlessShowroom"
Size = 18
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 420
Left = 900
TabIndex = 2
Top = 120
Width = 1365
End
Begin VB.Label lbldate
Alignment = 1 'Right Justify
BackColor = &H00FF0000&
BackStyle = 0 'Transparent
Caption = "myDate"
BeginProperty Font
Name = "EndlessShowroom"
Size = 18
Charset = 0
Weight = 900
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 660
Left = 2280
TabIndex = 1
Top = 0
Width = 2205
End
End
Attribute VB_Name = "frmClock"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private lngMinutesDiff As Long
Private bSommerzeit As Boolean

Private Declare Function GetPrivateProfileString Lib _
"kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, _
ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString _
Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName _
As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function SetWindowPos Lib "user32" ( _
ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _
ByVal X As Long, ByVal Y As Long, ByVal cx As Long, _
ByVal cy As Long, ByVal lFlags As Long) As Long


Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_SHOWWINDOW = &H40

Public Function SetFormOnTop(Fenster As Form) As Long
SetFormOnTop = SetWindowPos(Fenster.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE)
End Function

Private Sub ShowTime()
lTime = Format(Now, "HH:MM:SS")
lbldate = Format(Now, "dddd, MMM-DD-YYYY")
ampm = Format(Now, "AM/PM")
End Sub

Private Sub Form_Load()
On Error Resume Next
Dim sIn As String * 8
Dim lngRc As Long
Dim lngLeft As Long
Dim lngTop As Long
lngRc = GetPrivateProfileString("Position", "Left", Format$(Screen.Width - 1400, "1"), sIn, Len(sIn), "BMT.ini")
lngLeft = Val(Left$(sIn, lngRc))
lngRc = GetPrivateProfileString("Position", "Top", "0", sIn, Len(sIn), "BMT.ini")
lngTop = Val(Left$(sIn, lngRc))
lngRc = GetPrivateProfileString("Time", "MinutesDiffToBiel", "0", sIn, Len(sIn), "BMT.ini")
lngMinutesDiff = Val(Left$(sIn, lngRc))
lngRc = GetPrivateProfileString("Time", "Sommerzeit", "N", sIn, Len(sIn), "BMT.ini")
bSommerzeit = IIf(UCase(Left$(sIn, lngRc)) = "J", True, False)
Me.Move lngLeft, lngTop, lTime.Width - 10, lTime.Height
Call ShowTime
Call SetFormOnTop(Me)
lTime.ToolTipText = Format(Now, "dddd, mmm-ddd-yyyy")
lbldate.ToolTipText = Format(Now, "dddd, mmm-ddd-yyyy")
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Dim lRc As Long
Dim sSommerzeit As String
sSommerzeit = IIf(bSommerzeit, "J", "N")
lRc = WritePrivateProfileString("Position", "Left", Format$(Me.Left, "0"), "BMT.ini")
DoEvents
lRc = WritePrivateProfileString("Position", "Top", Format$(Me.Top, "0"), "BMT.ini")
DoEvents
lRc = WritePrivateProfileString("Time", "MinutesDiffToBiel", Format$(lngMinutesDiff, "0"), "BMT.ini")
lRc = WritePrivateProfileString("Time", "Sommerzeit", sSommerzeit, "BMT.ini")
End Sub

Private Sub lTime_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button > 1 Then
Unload Me
End If
End Sub

Private Sub lTime_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Me.Move Me.Left + X, Me.Top + Y
End If
End Sub

Private Sub Timer1_Timer()
Call ShowTime
End Sub

[/hl]