VB6实现 Windows 桌面的简单透明时钟

可以拖动移动，透明窗口，记住位置和文字颜色。

单击 AM/PM 读出显示选项。

演示图：

实现代码：

Private Declare Function GetWindowLong Lib "user32" _
    Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
    Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, _
    ByVal nIndex As Long, _
    ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal crKey As Long, _
    ByVal bAlpha As Byte, _
    ByVal dwFlags As Long) As Long
    
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_LAYERED = &H80000
Private Const LWA_COLORKEY = &H1&
Private Const LWA_ALPHA = &H2&

Dim IsDragging As Boolean
Dim MousePosX As Integer
Dim MousePosY As Integer

Dim ConfigData(2) As Long
Private Sub Form_Load()
    'Set the Form transparent by color.
    BackColor =RGB(127, 127, 0) 'Non standard color.
    SetWindowLong hWnd, _
                  GWL_EXSTYLE, _
                  GetWindowLong(hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetLayeredWindowAttributes hWnd, BackColor, 0, LWA_COLORKEY
    ReadConfigFile (App.Path & "\Clock.cfg")
    Me.Left = ConfigData(0)
    Me.Top = ConfigData(1)
    Clock(0).ForeColor = ConfigData(2)
    Clock(1).ForeColor = ConfigData(2)
    Timer1_Timer
End Sub
Private Sub Form_Unload(Cancel As Integer)
  WriteConfigFile (App.Path & "\Clock.cfg")
  End
End Sub
Private Sub Clock_Click(Index As Integer)
  If Index = 1 Then
    ClockBG.Visible = True
    For i = 0 To 3
      Options(i).Visible = True
    Next
  End If
End Sub
Private Sub Clock_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
   If Button = 1 And Index = 0 Then
        IsDragging = True
        MousePosX = X
        MousePosY = Y
    End If
End Sub
Private Sub Clock_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If IsDragging Then
        Me.Left = Me.Left + (X - MousePosX)
        Me.Top = Me.Top + (Y - MousePosY)
        If Button <> 1 Then
            IsDragging = False
            ConfigData(0) = Me.Left
            ConfigData(1) = Me.Top
        End If
    End If
End Sub
Private Sub Options_Click(Index As Integer)
  Select Case Index
    Case 0
      Clock(0).ForeColor = vbRed
      Clock(1).ForeColor = vbRed
      ConfigData(2) = vbRed
    Case 1
      Clock(0).ForeColor = vbGreen
      Clock(1).ForeColor = vbGreen
      ConfigData(2) = vbGreen
    Case 2
      For i = 0 To 3
        ClockBG.Visible = False
        Options(i).Visible = False
      Next
    Case 3
      Unload Me
  End Select
End Sub
Private Sub ReadConfigFile(Filename As String)
On Error GoTo Handler
    Open Filename For Input As #1
    Input #1, ConfigData(0) 'Form Left
    Input #1, ConfigData(1) 'Form Top
    Input #1, ConfigData(2) 'Clock Forecolor
Handler:
    Close #1
End Sub
Private Sub WriteConfigFile(Filename As String)
On Error GoTo Handler
    Open Filename For Output As #1
    Print #1, ConfigData(0) 'Form Left
    Print #1, ConfigData(1) 'Form top
    Print #1, ConfigData(2) 'Clock Forecolor
Handler:
    Close #1
End Sub
Private Sub Timer1_Timer()
  Temp = Time
  Clock(0) = Format(Left(Temp, 8), "h:mm:ss")
  Clock(1) = Right(Temp, 2)
End Sub