• Home
 · 
• Miscellaneous
 · 
• Simple Digital Clock - Will display top, Movable

Simple Digital Clock - Will display top, Movable

Simple Digital Clock - Will display top, Movable

API Declarations


'Open VB project
'Add this frmClock.frm to Project and Run



Rate Simple Digital Clock - Will display top, Movable

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'
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
'====================================================================