by Raghuraja. C (21 Submissions)
Category: Miscellaneous
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Thu 17th February 2005
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Simple Digital Clock - Will display top, Movable
API Declarations
'Open VB project
'Add this frmClock.frm to Project and Run
VBcoders
'
VERSION 5.00
Begin VB.Form frmClock
BorderStyle = 0 'None
Caption = "My Clock"
ClientHeight = 690
ClientLeft = 0
ClientTop = 0
ClientWidth = 3840
LinkTopic = "frmClock"
LockControls = -1 'True
ScaleHeight = 690
ScaleWidth = 3840
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.Timer Timer1
Interval = 100
Left = 0
Top = 900
End
Begin VB.Label lTime
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000002&
BorderStyle = 1 'Fixed Single
Caption = "myTime"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000009&
Height = 255
Left = -15
TabIndex = 0
Top = 0
Width = 3345
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, "DD-MMM-YYYY HH:MM:SS AM/PM (dddd)")
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, "0"), 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, "dd-mmm-yyyy dddd")
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
'====================================================================