form1.frm

桌面时钟小程序源码

VERSION 5.00
Begin VB.Form CoolTime 
   BackColor       =   &H0000FFFF&
   BorderStyle     =   0  'None
   Caption         =   "Form1"
   ClientHeight    =   555
   ClientLeft      =   10005
   ClientTop       =   0
   ClientWidth     =   1005
   BeginProperty Font 
      Name            =   "宋体"
      Size            =   10.5
      Charset         =   134
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "Form1.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   555
   ScaleWidth      =   1005
   ShowInTaskbar   =   0   'False
   Begin VB.Timer Timer1 
      Interval        =   1000
      Left            =   960
      Top             =   240
   End
   Begin VB.Label Label2 
      BackStyle       =   0  'Transparent
      Height          =   270
      Left            =   80
      TabIndex        =   1
      Top             =   30
      Width           =   975
   End
   Begin VB.Shape Shape2 
      Height          =   270
      Left            =   0
      Top             =   290
      Width           =   1005
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H80000006&
      Height          =   307
      Left            =   0
      Top             =   0
      Width           =   1005
   End
   Begin VB.Label Label1 
      BackColor       =   &H0000FFFF&
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   7.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   0
      TabIndex        =   0
      Top             =   327
      Width           =   960
   End
   Begin VB.Label Label3 
      BackColor       =   &H0000FFFF&
      Height          =   555
      Left            =   0
      TabIndex        =   2
      Top             =   0
      Width           =   1005
   End
End
Attribute VB_Name = "CoolTime"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Dim i As Long
Dim MainKeyHandle As Long
Dim m_wCurOptIdx As Integer


Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Sub Form_DblClick()
Form2.Show
End Sub

Private Sub Form_Load()

Dim aaaa
aaaa = SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, Flags)
CoolTime.Width = 1005
CoolTime.Height = 300
CoolTime.Top = 0
CoolTime.Left = 10005


Form2.Show

End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 1 Then
           Dim ReturnVal As Long
           x = ReleaseCapture()
           ReturnVal = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End If
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 2 Then
CoolTime.PopupMenu Form2.form1menu
End If
End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 1 Then
           Dim ReturnVal As Long
           x = ReleaseCapture()
           ReturnVal = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End If
End Sub

Private Sub Label1_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 2 Then
CoolTime.PopupMenu Form2.form1menu
End If
End Sub

Private Sub Label2_DblClick()
Form2.Show
End Sub

Private Sub Label2_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
    If Button = 1 Then
           Dim ReturnVal As Long
           x = ReleaseCapture()
           ReturnVal = SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0)
    End If
End Sub

Private Sub Label2_MouseUp(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = 2 Then
CoolTime.PopupMenu Form2.form1menu
End If
End Sub

Private Sub Timer1_Timer()
If Mid(Str(Time()), 2, 1) = "午" Then
Label2.Caption = Trim(Mid(Str(Time()), 4))
Else
Label2.Caption = Trim(Str(Time()))
End If
End Sub

Private Sub Timer2_Timer()
Dim aaaa
aaaa = SetWindowPos(Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, Flags)

End Sub